Z-Data 0.1.4.2 → 0.1.5.0
raw patch · 17 files changed
+1601/−1548 lines, 17 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Z.Data.Array.UnalignedAccess: BE :: a -> BE a
- Z.Data.Array.UnalignedAccess: LE :: a -> LE a
- Z.Data.Array.UnalignedAccess: UnalignedSize :: Int -> UnalignedSize a
- Z.Data.Array.UnalignedAccess: [getBE] :: BE a -> a
- Z.Data.Array.UnalignedAccess: [getLE] :: LE a -> a
- Z.Data.Array.UnalignedAccess: [getUnalignedSize] :: UnalignedSize a -> Int
- Z.Data.Array.UnalignedAccess: class UnalignedAccess a
- Z.Data.Array.UnalignedAccess: indexBA :: UnalignedAccess a => ByteArray# -> Int -> a
- Z.Data.Array.UnalignedAccess: indexPrimWord8ArrayAs :: UnalignedAccess a => PrimArray Word8 -> Int -> a
- Z.Data.Array.UnalignedAccess: indexWord8ArrayAs :: UnalignedAccess a => ByteArray -> Int -> a
- Z.Data.Array.UnalignedAccess: indexWord8ArrayAs# :: UnalignedAccess a => ByteArray# -> Int# -> a
- Z.Data.Array.UnalignedAccess: instance GHC.Classes.Eq a => GHC.Classes.Eq (Z.Data.Array.UnalignedAccess.BE a)
- Z.Data.Array.UnalignedAccess: instance GHC.Classes.Eq a => GHC.Classes.Eq (Z.Data.Array.UnalignedAccess.LE a)
- Z.Data.Array.UnalignedAccess: instance GHC.Show.Show a => GHC.Show.Show (Z.Data.Array.UnalignedAccess.BE a)
- Z.Data.Array.UnalignedAccess: instance GHC.Show.Show a => GHC.Show.Show (Z.Data.Array.UnalignedAccess.LE a)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.BE GHC.Int.Int16)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.BE GHC.Int.Int32)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.BE GHC.Int.Int64)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.BE GHC.Types.Char)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.BE GHC.Types.Double)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.BE GHC.Types.Float)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.BE GHC.Types.Int)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.BE GHC.Types.Word)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.BE GHC.Word.Word16)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.BE GHC.Word.Word32)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.BE GHC.Word.Word64)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.LE GHC.Int.Int16)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.LE GHC.Int.Int32)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.LE GHC.Int.Int64)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.LE GHC.Types.Char)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.LE GHC.Types.Double)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.LE GHC.Types.Float)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.LE GHC.Types.Int)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.LE GHC.Types.Word)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.LE GHC.Word.Word16)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.LE GHC.Word.Word32)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess (Z.Data.Array.UnalignedAccess.LE GHC.Word.Word64)
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CBool
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CChar
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CClock
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CDouble
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CFloat
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CInt
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CIntMax
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CIntPtr
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CLLong
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CLong
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CPtrdiff
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CSChar
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CSUSeconds
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CShort
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CSigAtomic
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CSize
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CTime
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CUChar
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CUInt
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CUIntMax
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CUIntPtr
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CULLong
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CULong
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CUSeconds
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CUShort
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess Foreign.C.Types.CWchar
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Int.Int16
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Int.Int32
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Int.Int64
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Int.Int8
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Types.Char
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Types.Double
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Types.Float
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Types.Int
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Types.Word
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Word.Word16
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Word.Word32
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Word.Word64
- Z.Data.Array.UnalignedAccess: instance Z.Data.Array.UnalignedAccess.UnalignedAccess GHC.Word.Word8
- Z.Data.Array.UnalignedAccess: instance forall k (a :: k). GHC.Classes.Eq (Z.Data.Array.UnalignedAccess.UnalignedSize a)
- Z.Data.Array.UnalignedAccess: instance forall k (a :: k). GHC.Show.Show (Z.Data.Array.UnalignedAccess.UnalignedSize a)
- Z.Data.Array.UnalignedAccess: newtype BE a
- Z.Data.Array.UnalignedAccess: newtype LE a
- Z.Data.Array.UnalignedAccess: newtype UnalignedSize a
- Z.Data.Array.UnalignedAccess: peekMBA :: UnalignedAccess a => MutableByteArray# RealWorld -> Int -> IO a
- Z.Data.Array.UnalignedAccess: pokeMBA :: UnalignedAccess a => MutableByteArray# RealWorld -> Int -> a -> IO ()
- Z.Data.Array.UnalignedAccess: readPrimWord8ArrayAs :: (PrimMonad m, UnalignedAccess a) => MutablePrimArray (PrimState m) Word8 -> Int -> m a
- Z.Data.Array.UnalignedAccess: readWord8ArrayAs :: (PrimMonad m, UnalignedAccess a) => MutableByteArray (PrimState m) -> Int -> m a
- Z.Data.Array.UnalignedAccess: readWord8ArrayAs# :: UnalignedAccess a => MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
- Z.Data.Array.UnalignedAccess: unalignedSize :: UnalignedAccess a => UnalignedSize a
- Z.Data.Array.UnalignedAccess: writePrimWord8ArrayAs :: (PrimMonad m, UnalignedAccess a) => MutablePrimArray (PrimState m) Word8 -> Int -> a -> m ()
- Z.Data.Array.UnalignedAccess: writeWord8ArrayAs :: (PrimMonad m, UnalignedAccess a) => MutableByteArray (PrimState m) -> Int -> a -> m ()
- Z.Data.Array.UnalignedAccess: writeWord8ArrayAs# :: UnalignedAccess a => MutableByteArray# s -> Int# -> a -> State# s -> State# s
- Z.Data.CBytes: NullPointerException :: CallStack -> NullPointerException
- Z.Data.CBytes: create :: HasCallStack => Int -> (CString -> IO Int) -> IO CBytes
- Z.Data.CBytes: data NullPointerException
- Z.Data.CBytes: fromCString' :: HasCallStack => CString -> IO (Maybe CBytes)
- Z.Data.CBytes: instance GHC.Exception.Type.Exception Z.Data.CBytes.CBytesException
- Z.Data.CBytes: instance GHC.Exception.Type.Exception Z.Data.CBytes.NullPointerException
- Z.Data.CBytes: instance GHC.Show.Show Z.Data.CBytes.CBytesException
- Z.Data.CBytes: instance GHC.Show.Show Z.Data.CBytes.NullPointerException
- Z.Foreign: allocMutablePrimArraySafe :: Prim a => Int -> (Ptr a -> IO b) -> IO b
- Z.Foreign: allocMutablePrimArrayUnsafe :: forall a b. Prim a => Int -> (MBA# a -> IO b) -> IO (MutablePrimArray RealWorld a, b)
+ Z.Data.Array.Unaligned: BE :: a -> BE a
+ Z.Data.Array.Unaligned: LE :: a -> LE a
+ Z.Data.Array.Unaligned: [getBE] :: BE a -> a
+ Z.Data.Array.Unaligned: [getLE] :: LE a -> a
+ Z.Data.Array.Unaligned: class Unaligned a
+ Z.Data.Array.Unaligned: indexBA :: Unaligned a => ByteArray# -> Int -> a
+ Z.Data.Array.Unaligned: indexPrimWord8ArrayAs :: Unaligned a => PrimArray Word8 -> Int -> a
+ Z.Data.Array.Unaligned: indexWord8ArrayAs :: Unaligned a => ByteArray -> Int -> a
+ Z.Data.Array.Unaligned: indexWord8ArrayAs# :: Unaligned a => ByteArray# -> Int# -> a
+ Z.Data.Array.Unaligned: instance GHC.Classes.Eq a => GHC.Classes.Eq (Z.Data.Array.Unaligned.BE a)
+ Z.Data.Array.Unaligned: instance GHC.Classes.Eq a => GHC.Classes.Eq (Z.Data.Array.Unaligned.LE a)
+ Z.Data.Array.Unaligned: instance GHC.Show.Show a => GHC.Show.Show (Z.Data.Array.Unaligned.BE a)
+ Z.Data.Array.Unaligned: instance GHC.Show.Show a => GHC.Show.Show (Z.Data.Array.Unaligned.LE a)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.BE GHC.Int.Int16)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.BE GHC.Int.Int32)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.BE GHC.Int.Int64)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.BE GHC.Types.Char)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.BE GHC.Types.Double)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.BE GHC.Types.Float)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.BE GHC.Types.Int)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.BE GHC.Types.Word)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.BE GHC.Word.Word16)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.BE GHC.Word.Word32)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.BE GHC.Word.Word64)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.LE GHC.Int.Int16)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.LE GHC.Int.Int32)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.LE GHC.Int.Int64)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.LE GHC.Types.Char)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.LE GHC.Types.Double)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.LE GHC.Types.Float)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.LE GHC.Types.Int)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.LE GHC.Types.Word)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.LE GHC.Word.Word16)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.LE GHC.Word.Word32)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned (Z.Data.Array.Unaligned.LE GHC.Word.Word64)
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CBool
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CChar
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CClock
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CDouble
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CFloat
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CInt
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CIntMax
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CIntPtr
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CLLong
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CLong
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CPtrdiff
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CSChar
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CSUSeconds
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CShort
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CSigAtomic
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CSize
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CTime
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CUChar
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CUInt
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CUIntMax
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CUIntPtr
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CULLong
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CULong
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CUSeconds
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CUShort
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned Foreign.C.Types.CWchar
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Int.Int16
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Int.Int32
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Int.Int64
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Int.Int8
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Types.Char
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Types.Double
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Types.Float
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Types.Int
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Types.Word
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Word.Word16
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Word.Word32
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Word.Word64
+ Z.Data.Array.Unaligned: instance Z.Data.Array.Unaligned.Unaligned GHC.Word.Word8
+ Z.Data.Array.Unaligned: newtype BE a
+ Z.Data.Array.Unaligned: newtype LE a
+ Z.Data.Array.Unaligned: peekMBA :: Unaligned a => MutableByteArray# RealWorld -> Int -> IO a
+ Z.Data.Array.Unaligned: pokeMBA :: Unaligned a => MutableByteArray# RealWorld -> Int -> a -> IO ()
+ Z.Data.Array.Unaligned: readPrimWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutablePrimArray (PrimState m) Word8 -> Int -> m a
+ Z.Data.Array.Unaligned: readWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutableByteArray (PrimState m) -> Int -> m a
+ Z.Data.Array.Unaligned: readWord8ArrayAs# :: Unaligned a => MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
+ Z.Data.Array.Unaligned: unalignedSize :: Unaligned a => a -> Int
+ Z.Data.Array.Unaligned: writePrimWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutablePrimArray (PrimState m) Word8 -> Int -> a -> m ()
+ Z.Data.Array.Unaligned: writeWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutableByteArray (PrimState m) -> Int -> a -> m ()
+ Z.Data.Array.Unaligned: writeWord8ArrayAs# :: Unaligned a => MutableByteArray# s -> Int# -> a -> State# s -> State# s
+ Z.Data.CBytes: allocCBytesUnsafe :: HasCallStack => Int -> (MBA# Word8 -> IO a) -> IO (CBytes, a)
+ Z.Data.CBytes: instance Z.Data.Array.Unaligned.Unaligned Z.Data.CBytes.CBytes
+ Z.Data.CBytes: pattern CB :: PrimArray Word8 -> CBytes
+ Z.Data.CBytes: toPrimArray :: CBytes -> PrimArray Word8
+ Z.Data.CBytes: withCBytesUnsafe :: CBytes -> (BA# Word8 -> IO a) -> IO a
+ Z.Data.Text: EmptyText :: CallStack -> TextException
+ Z.Data.Text: head :: Text -> Char
+ Z.Data.Text: init :: Text -> Text
+ Z.Data.Text: last :: Text -> Char
+ Z.Data.Text: tail :: Text -> Text
+ Z.Data.Text.Base: EmptyText :: CallStack -> TextException
+ Z.Data.Text.Base: errorEmptyText :: HasCallStack => a
+ Z.Data.Text.Extra: head :: Text -> Char
+ Z.Data.Text.Extra: init :: Text -> Text
+ Z.Data.Text.Extra: last :: Text -> Char
+ Z.Data.Text.Extra: tail :: Text -> Text
+ Z.Data.Vector: head :: (Vec v a, HasCallStack) => v a -> a
+ Z.Data.Vector: init :: (Vec v a, HasCallStack) => v a -> v a
+ Z.Data.Vector: last :: (Vec v a, HasCallStack) => v a -> a
+ Z.Data.Vector: tail :: (Vec v a, HasCallStack) => v a -> v a
- Z.Data.Builder: encodePrim :: forall a. UnalignedAccess a => a -> Builder ()
+ Z.Data.Builder: encodePrim :: forall a. Unaligned a => a -> Builder ()
- Z.Data.Builder: encodePrimBE :: forall a. UnalignedAccess (BE a) => a -> Builder ()
+ Z.Data.Builder: encodePrimBE :: forall a. Unaligned (BE a) => a -> Builder ()
- Z.Data.Builder: encodePrimLE :: forall a. UnalignedAccess (LE a) => a -> Builder ()
+ Z.Data.Builder: encodePrimLE :: forall a. Unaligned (LE a) => a -> Builder ()
- Z.Data.Builder.Base: encodePrim :: forall a. UnalignedAccess a => a -> Builder ()
+ Z.Data.Builder.Base: encodePrim :: forall a. Unaligned a => a -> Builder ()
- Z.Data.Builder.Base: encodePrimBE :: forall a. UnalignedAccess (BE a) => a -> Builder ()
+ Z.Data.Builder.Base: encodePrimBE :: forall a. Unaligned (BE a) => a -> Builder ()
- Z.Data.Builder.Base: encodePrimLE :: forall a. UnalignedAccess (LE a) => a -> Builder ()
+ Z.Data.Builder.Base: encodePrimLE :: forall a. Unaligned (LE a) => a -> Builder ()
- Z.Data.CBytes: withCBytes :: CBytes -> (CString -> IO a) -> IO a
+ Z.Data.CBytes: withCBytes :: CBytes -> (Ptr Word8 -> IO a) -> IO a
- Z.Data.Parser: decodePrim :: forall a. UnalignedAccess a => Parser a
+ Z.Data.Parser: decodePrim :: forall a. Unaligned a => Parser a
- Z.Data.Parser: decodePrimBE :: forall a. UnalignedAccess (BE a) => Parser a
+ Z.Data.Parser: decodePrimBE :: forall a. Unaligned (BE a) => Parser a
- Z.Data.Parser: decodePrimLE :: forall a. UnalignedAccess (LE a) => Parser a
+ Z.Data.Parser: decodePrimLE :: forall a. Unaligned (LE a) => Parser a
- Z.Data.Parser.Base: decodePrim :: forall a. UnalignedAccess a => Parser a
+ Z.Data.Parser.Base: decodePrim :: forall a. Unaligned a => Parser a
- Z.Data.Parser.Base: decodePrimBE :: forall a. UnalignedAccess (BE a) => Parser a
+ Z.Data.Parser.Base: decodePrimBE :: forall a. Unaligned (BE a) => Parser a
- Z.Data.Parser.Base: decodePrimLE :: forall a. UnalignedAccess (LE a) => Parser a
+ Z.Data.Parser.Base: decodePrimLE :: forall a. Unaligned (LE a) => Parser a
Files
- ChangeLog.md +7/−0
- Z-Data.cabal +3/−3
- Z/Data/Array/Unaligned.hs +923/−0
- Z/Data/Array/UnalignedAccess.hs +0/−924
- Z/Data/Builder/Base.hs +5/−5
- Z/Data/Builder/Numeric.hs +26/−26
- Z/Data/CBytes.hs +249/−206
- Z/Data/Parser/Base.hs +7/−7
- Z/Data/Text.hs +1/−0
- Z/Data/Text/Base.hs +6/−1
- Z/Data/Text/Extra.hs +31/−2
- Z/Data/Vector.hs +1/−0
- Z/Data/Vector/Base.hs +2/−2
- Z/Foreign.hs +28/−77
- test/Z/Data/Array/UnalignedAccessSpec.hs +0/−294
- test/Z/Data/Array/UnalignedSpec.hs +294/−0
- test/Z/Data/CBytesSpec.hs +18/−1
ChangeLog.md view
@@ -1,5 +1,12 @@ # Revision history for Z-Data +## 0.1.5.0 -- 2020-10-02++* Rework `CBytes` type to use unpinned byte array, add `withCBytesUnsafe`, `allocCBytesUnsafe`.+* Export `head`, `tail`, `init`, `last` from `Z.IO.Vector`, `Z.IO.Text` (well, safety first).+* Change `unalignedSize` in `UnalignedAccess` class's type to take a instance type and return `Int`.+* Rename `UnalignedAccess` to `Unaligned`.+ ## 0.1.4.2 -- 2020-10-02 * Remove `withMutablePrimArrayUnsafe/Safe` from `Z.Foreign`.
Z-Data.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: Z-Data-version: 0.1.4.2+version: 0.1.5.0 synopsis: Array, vector and text description: This package provides array, slice and text operations license: BSD-3-Clause@@ -66,7 +66,7 @@ Z.Data.Array.Cast Z.Data.Array.Checked Z.Data.Array.QQ- Z.Data.Array.UnalignedAccess+ Z.Data.Array.Unaligned Z.Data.Array.UnliftedArray Z.Data.CBytes Z.Data.Vector@@ -183,7 +183,7 @@ Z.Data.JSON.ValueSpec Z.Data.Parser.BaseSpec Z.Data.Parser.NumericSpec- Z.Data.Array.UnalignedAccessSpec+ Z.Data.Array.UnalignedSpec Z.Data.Text.BaseSpec Z.Data.Text.BuilderSpec Z.Data.Text.ExtraSpec
+ Z/Data/Array/Unaligned.hs view
@@ -0,0 +1,923 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}++{-|+Module : Z.Data.Array.Unaligned+Description : unaligned access for primitive arrays+Copyright : (c) Dong Han, 2017-2019+License : BSD+Maintainer : winterland1989@gmail.com+Stability : experimental+Portability : non-portable++This module implements unaligned element access with ghc primitives (> 8.6), which can be used+as a simple binary encoding \/ decoding method.+-}++module Z.Data.Array.Unaligned where++import Control.Monad.Primitive+import Data.Primitive.ByteArray+import Data.Primitive.PrimArray+import GHC.Int+import GHC.Exts+import GHC.Word+import GHC.Float (stgFloatToWord32, stgWord32ToFloat, stgWord64ToDouble, stgDoubleToWord64)+import Foreign.C.Types++-- toggle these defs to test different implements+#define USE_BSWAP+-- #define USE_SHIFT++--------------------------------------------------------------------------------++-- | Primitive types which can be unaligned accessed+--+-- It can also be used as a lightweight method to peek\/poke value from\/to C structs+-- when you pass 'MutableByteArray#' to FFI as struct pointer, e.g.+--+-- @+-- -- | note the .hsc syntax+-- peekSocketAddrMBA :: HasCallStack => MBA## SocketAddr -> IO SocketAddr+-- peekSocketAddrMBA p = do+-- family <- peekMBA p (#offset struct sockaddr, sa_family)+-- case family :: CSaFamily of+-- (#const AF_INET) -> do+-- addr <- peekMBA p (#offset struct sockaddr_in, sin_addr)+-- port <- peekMBA p (#offset struct sockaddr_in, sin_port)+-- return (SocketAddrInet (PortNumber port) addr)+-- ....+-- @+--+class Unaligned a where+ {-# MINIMAL unalignedSize, indexWord8ArrayAs#, writeWord8ArrayAs#, readWord8ArrayAs# |+ unalignedSize, indexBA, peekMBA, pokeMBA #-}+ -- | byte size+ unalignedSize :: a -> Int++ -- | index element off byte array with offset in bytes(maybe unaligned)+ indexWord8ArrayAs# :: ByteArray# -> Int# -> a+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = indexBA ba# (I# i#)++ -- | read element from byte array with offset in bytes(maybe unaligned)+ readWord8ArrayAs# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s# =+ (unsafeCoerce# (peekMBA (unsafeCoerce# mba#) (I# i#) :: IO a)) s#++ -- | write element to byte array with offset in bytes(maybe unaligned)+ writeWord8ArrayAs# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# x s# =+ unsafeCoerce# (pokeMBA (unsafeCoerce# mba#) (I# i#) x) s#++ -- | IO version of 'writeWord8ArrayAs#' but more convenient to write manually.+ peekMBA :: MutableByteArray# RealWorld -> Int -> IO a+ {-# INLINE peekMBA #-}+ peekMBA mba# (I# i#) = primitive (readWord8ArrayAs# mba# i#)++ -- | IO version of 'readWord8ArrayAs#' but more convenient to write manually.+ pokeMBA :: MutableByteArray# RealWorld -> Int -> a -> IO ()+ {-# INLINE pokeMBA #-}+ pokeMBA mba# (I# i#) x = primitive_ (writeWord8ArrayAs# mba# i# x)++ -- | index element off byte array with offset in bytes(maybe unaligned)+ indexBA :: ByteArray# -> Int -> a+ {-# INLINE indexBA #-}+ indexBA ba# (I# i#) = indexWord8ArrayAs# ba# i#+++-- | Lifted version of 'writeWord8ArrayAs#'+writeWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutableByteArray (PrimState m) -> Int -> a -> m ()+{-# INLINE writeWord8ArrayAs #-}+writeWord8ArrayAs (MutableByteArray mba#) (I# i#) x = primitive_ (writeWord8ArrayAs# mba# i# x)++-- | Lifted version of 'readWord8ArrayAs#'+readWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutableByteArray (PrimState m) -> Int -> m a+{-# INLINE readWord8ArrayAs #-}+readWord8ArrayAs (MutableByteArray mba#) (I# i#) = primitive (readWord8ArrayAs# mba# i#)++-- | Lifted version of 'indexWord8ArrayAs#'+indexWord8ArrayAs :: Unaligned a => ByteArray -> Int -> a+{-# INLINE indexWord8ArrayAs #-}+indexWord8ArrayAs (ByteArray ba#) (I# i#) = indexWord8ArrayAs# ba# i#++-- | Lifted version of 'writeWord8ArrayAs#'+writePrimWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutablePrimArray (PrimState m) Word8 -> Int -> a -> m ()+{-# INLINE writePrimWord8ArrayAs #-}+writePrimWord8ArrayAs (MutablePrimArray mba#) (I# i#) x = primitive_ (writeWord8ArrayAs# mba# i# x)++-- | Lifted version of 'readWord8ArrayAs#'+readPrimWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutablePrimArray (PrimState m) Word8 -> Int -> m a+{-# INLINE readPrimWord8ArrayAs #-}+readPrimWord8ArrayAs (MutablePrimArray mba#) (I# i#) = primitive (readWord8ArrayAs# mba# i#)++-- | Lifted version of 'indexWord8ArrayAs#'+indexPrimWord8ArrayAs :: Unaligned a => PrimArray Word8 -> Int -> a+{-# INLINE indexPrimWord8ArrayAs #-}+indexPrimWord8ArrayAs (PrimArray ba#) (I# i#) = indexWord8ArrayAs# ba# i#++instance Unaligned Word8 where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 1+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (W8# x#) = writeWord8Array# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8Array# mba# i# s0 in (# s1, W8# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = W8# (indexWord8Array# ba# i#)++instance Unaligned Int8 where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 1+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (I8# x#) = writeInt8Array# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readInt8Array# mba# i# s0 in (# s1, I8# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = I8# (indexInt8Array# ba# i#)++-- | little endianess wrapper+--+newtype LE a = LE { getLE :: a } deriving (Show, Eq)++-- | big endianess wrapper+--+newtype BE a = BE { getBE :: a } deriving (Show, Eq)++#define USE_HOST_IMPL(END) \+ {-# INLINE writeWord8ArrayAs# #-}; \+ writeWord8ArrayAs# mba# i# (END x) = writeWord8ArrayAs# mba# i# x; \+ {-# INLINE readWord8ArrayAs# #-}; \+ readWord8ArrayAs# mba# i# s0 = \+ let !(# s1, x #) = readWord8ArrayAs# mba# i# s0 in (# s1, END x #); \+ {-# INLINE indexWord8ArrayAs# #-}; \+ indexWord8ArrayAs# ba# i# = END (indexWord8ArrayAs# ba# i#);++--------------------------------------------------------------------------------++instance Unaligned Word16 where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 2+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (W16# x#) = writeWord8ArrayAsWord16# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsWord16# mba# i# s0 in (# s1, W16# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = W16# (indexWord8ArrayAsWord16# ba# i#)++instance Unaligned (LE Word16) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 2+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (W16# x#)) s0# =+ let s1# = writeWord8Array# mba# i# x# s0#+ in writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 8#) s1#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, w1# #) = readWord8Array# mba# i# s0+ !(# s2, w2# #) = readWord8Array# mba# (i# +# 1#) s1+ in (# s2, LE (W16# (uncheckedShiftL# w2# 8# `or#` w1#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let w1# = indexWord8Array# ba# i#+ w2# = indexWord8Array# ba# (i# +# 1#)+ in LE (W16# (uncheckedShiftL# w2# 8# `or#` w1#))+#else+ USE_HOST_IMPL(LE)+#endif++instance Unaligned (BE Word16) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 2+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ USE_HOST_IMPL(BE)+#else+-- on X86 we use bswap+-- TODO: find out if arch64 support this+#if (defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)) && defined(USE_BSWAP)+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (W16# x#)) = writeWord8ArrayAsWord16# mba# i# (byteSwap16# x#)+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsWord16# mba# i# s0+ in (# s1, BE (W16# (byteSwap16# x#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = BE (W16# (byteSwap16# (indexWord8ArrayAsWord16# ba# i#)))+#else+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (W16# x#)) s0# =+ let s1# = writeWord8Array# mba# i# (uncheckedShiftRL# x# 8#) s0#+ in writeWord8Array# mba# (i# +# 1#) x# s1#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, w2# #) = readWord8Array# mba# i# s0+ !(# s2, w1# #) = readWord8Array# mba# (i# +# 1#) s1+ in (# s2, BE (W16# (uncheckedShiftL# w2# 8# `or#` w1#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let w2# = indexWord8Array# ba# i#+ w1# = indexWord8Array# ba# (i# +# 1#)+ in BE (W16# (uncheckedShiftL# w2# 8# `or#` w1#))+#endif+#endif++--------------------------------------------------------------------------------++instance Unaligned Word32 where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (W32# x#) = writeWord8ArrayAsWord32# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsWord32# mba# i# s0 in (# s1, W32# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = W32# (indexWord8ArrayAsWord32# ba# i#)+++instance Unaligned (LE Word32) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (W32# x#)) s0# =+ let s1# = writeWord8Array# mba# i# x# s0#+ s2# = writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 8#) s1#+ s3# = writeWord8Array# mba# (i# +# 2#) (uncheckedShiftRL# x# 16#) s2#+ in writeWord8Array# mba# (i# +# 3#) (uncheckedShiftRL# x# 24#) s3#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, w1# #) = readWord8Array# mba# i# s0+ !(# s2, w2# #) = readWord8Array# mba# (i# +# 1#) s1+ !(# s3, w3# #) = readWord8Array# mba# (i# +# 2#) s2+ !(# s4, w4# #) = readWord8Array# mba# (i# +# 3#) s3+ in (# s4, LE (W32# ((uncheckedShiftL# w4# 24#) `or#`+ (uncheckedShiftL# w3# 16#) `or#`+ (uncheckedShiftL# w2# 8#) `or#` w1#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let w1# = indexWord8Array# ba# i#+ w2# = indexWord8Array# ba# (i# +# 1#)+ w3# = indexWord8Array# ba# (i# +# 2#)+ w4# = indexWord8Array# ba# (i# +# 3#)+ in LE (W32# ((uncheckedShiftL# w4# 24#) `or#`+ (uncheckedShiftL# w3# 16#) `or#`+ (uncheckedShiftL# w2# 8#) `or#` w1#))+#else+ USE_HOST_IMPL(LE)+#endif++instance Unaligned (BE Word32) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ USE_HOST_IMPL(BE)+#else+-- on X86 we use bswap+-- TODO: find out if arch64 support this+#if (defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)) && defined(USE_BSWAP)+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (W32# x#)) = writeWord8ArrayAsWord32# mba# i# (byteSwap32# x#)+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsWord32# mba# i# s0+ in (# s1, BE (W32# (byteSwap32# x#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = BE (W32# (byteSwap32# (indexWord8ArrayAsWord32# ba# i#)))+#else+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (W32# x#)) s0# =+ let s1# = writeWord8Array# mba# i# (uncheckedShiftRL# x# 24#) s0#+ s2# = writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 16#) s1#+ s3# = writeWord8Array# mba# (i# +# 2#) (uncheckedShiftRL# x# 8#) s2#+ in writeWord8Array# mba# (i# +# 3#) x# s3#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, w4# #) = readWord8Array# mba# i# s0+ !(# s2, w3# #) = readWord8Array# mba# (i# +# 1#) s1+ !(# s3, w2# #) = readWord8Array# mba# (i# +# 2#) s2+ !(# s4, w1# #) = readWord8Array# mba# (i# +# 3#) s3+ in (# s4, BE (W32# ((uncheckedShiftL# w4# 24#) `or#`+ (uncheckedShiftL# w3# 16#) `or#`+ (uncheckedShiftL# w2# 8#) `or#` w1#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let w4# = indexWord8Array# ba# i#+ w3# = indexWord8Array# ba# (i# +# 1#)+ w2# = indexWord8Array# ba# (i# +# 2#)+ w1# = indexWord8Array# ba# (i# +# 3#)+ in BE (W32# ((uncheckedShiftL# w4# 24#) `or#`+ (uncheckedShiftL# w3# 16#) `or#`+ (uncheckedShiftL# w2# 8#) `or#` w1#))+#endif+#endif++--------------------------------------------------------------------------------++instance Unaligned Word64 where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (W64# x#) = writeWord8ArrayAsWord64# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsWord64# mba# i# s0 in (# s1, W64# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = W64# (indexWord8ArrayAsWord64# ba# i#)+++instance Unaligned (LE Word64) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (W64# x#)) s0# =+ let s1# = writeWord8Array# mba# i# x# s0#+ s2# = writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 8#) s1#+ s3# = writeWord8Array# mba# (i# +# 2#) (uncheckedShiftRL# x# 16#) s2#+ s4# = writeWord8Array# mba# (i# +# 3#) (uncheckedShiftRL# x# 24#) s3#+ s5# = writeWord8Array# mba# (i# +# 4#) (uncheckedShiftRL# x# 32#) s4#+ s6# = writeWord8Array# mba# (i# +# 5#) (uncheckedShiftRL# x# 40#) s5#+ s7# = writeWord8Array# mba# (i# +# 6#) (uncheckedShiftRL# x# 48#) s6#+ in writeWord8Array# mba# (i# +# 7#) (uncheckedShiftRL# x# 56#) s7#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, w1# #) = readWord8Array# mba# i# s0+ !(# s2, w2# #) = readWord8Array# mba# (i# +# 1#) s1+ !(# s3, w3# #) = readWord8Array# mba# (i# +# 2#) s2+ !(# s4, w4# #) = readWord8Array# mba# (i# +# 3#) s3+ !(# s5, w5# #) = readWord8Array# mba# (i# +# 4#) s4+ !(# s6, w6# #) = readWord8Array# mba# (i# +# 5#) s5+ !(# s7, w7# #) = readWord8Array# mba# (i# +# 6#) s6+ !(# s8, w8# #) = readWord8Array# mba# (i# +# 7#) s7+ in (# s8, LE (W64# ((uncheckedShiftL# w8# 56#) `or#`+ (uncheckedShiftL# w7# 48#) `or#`+ (uncheckedShiftL# w6# 40#) `or#`+ (uncheckedShiftL# w5# 32#) `or#`+ (uncheckedShiftL# w4# 24#) `or#`+ (uncheckedShiftL# w3# 16#) `or#`+ (uncheckedShiftL# w2# 8#) `or#` w1#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let w1# = indexWord8Array# ba# i#+ w2# = indexWord8Array# ba# (i# +# 1#)+ w3# = indexWord8Array# ba# (i# +# 2#)+ w4# = indexWord8Array# ba# (i# +# 3#)+ w5# = indexWord8Array# ba# (i# +# 4#)+ w6# = indexWord8Array# ba# (i# +# 5#)+ w7# = indexWord8Array# ba# (i# +# 6#)+ w8# = indexWord8Array# ba# (i# +# 7#)+ in LE (W64# ((uncheckedShiftL# w8# 56#) `or#`+ (uncheckedShiftL# w7# 48#) `or#`+ (uncheckedShiftL# w6# 40#) `or#`+ (uncheckedShiftL# w5# 32#) `or#`+ (uncheckedShiftL# w4# 24#) `or#`+ (uncheckedShiftL# w3# 16#) `or#`+ (uncheckedShiftL# w2# 8#) `or#` w1#))+#else+ USE_HOST_IMPL(LE)+#endif++instance Unaligned (BE Word64) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ USE_HOST_IMPL(BE)+#else+-- on X86 we use bswap+-- TODO: find out if arch64 support this+#if (defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)) && defined(USE_BSWAP)+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (W64# x#)) = writeWord8ArrayAsWord64# mba# i# (byteSwap64# x#)+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsWord64# mba# i# s0+ in (# s1, BE (W64# (byteSwap64# x#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = BE (W64# (byteSwap64# (indexWord8ArrayAsWord64# ba# i#)))+#else+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (W64# x#)) s0# =+ let s1# = writeWord8Array# mba# i# (uncheckedShiftRL# x# 56#) s0#+ s2# = writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 48#) s1#+ s3# = writeWord8Array# mba# (i# +# 2#) (uncheckedShiftRL# x# 40#) s2#+ s4# = writeWord8Array# mba# (i# +# 3#) (uncheckedShiftRL# x# 32#) s3#+ s5# = writeWord8Array# mba# (i# +# 4#) (uncheckedShiftRL# x# 24#) s4#+ s6# = writeWord8Array# mba# (i# +# 5#) (uncheckedShiftRL# x# 16#) s5#+ s7# = writeWord8Array# mba# (i# +# 6#) (uncheckedShiftRL# x# 8#) s6#+ in writeWord8Array# mba# (i# +# 7#) x# s7#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, w8# #) = readWord8Array# mba# i# s0+ !(# s2, w7# #) = readWord8Array# mba# (i# +# 1#) s1+ !(# s3, w6# #) = readWord8Array# mba# (i# +# 2#) s2+ !(# s4, w5# #) = readWord8Array# mba# (i# +# 3#) s3+ !(# s5, w4# #) = readWord8Array# mba# (i# +# 4#) s4+ !(# s6, w3# #) = readWord8Array# mba# (i# +# 5#) s5+ !(# s7, w2# #) = readWord8Array# mba# (i# +# 6#) s6+ !(# s8, w1# #) = readWord8Array# mba# (i# +# 7#) s7+ in (# s8, BE (W64# ((uncheckedShiftL# w8# 56#) `or#`+ (uncheckedShiftL# w7# 48#) `or#`+ (uncheckedShiftL# w6# 40#) `or#`+ (uncheckedShiftL# w5# 32#) `or#`+ (uncheckedShiftL# w4# 24#) `or#`+ (uncheckedShiftL# w3# 16#) `or#`+ (uncheckedShiftL# w2# 8#) `or#` w1#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let w8# = indexWord8Array# ba# i#+ w7# = indexWord8Array# ba# (i# +# 1#)+ w6# = indexWord8Array# ba# (i# +# 2#)+ w5# = indexWord8Array# ba# (i# +# 3#)+ w4# = indexWord8Array# ba# (i# +# 4#)+ w3# = indexWord8Array# ba# (i# +# 5#)+ w2# = indexWord8Array# ba# (i# +# 6#)+ w1# = indexWord8Array# ba# (i# +# 7#)+ in BE (W64# ((uncheckedShiftL# w8# 56#) `or#`+ (uncheckedShiftL# w7# 48#) `or#`+ (uncheckedShiftL# w6# 40#) `or#`+ (uncheckedShiftL# w5# 32#) `or#`+ (uncheckedShiftL# w4# 24#) `or#`+ (uncheckedShiftL# w3# 16#) `or#`+ (uncheckedShiftL# w2# 8#) `or#` w1#))+#endif+#endif++--------------------------------------------------------------------------------++instance Unaligned Word where+#if SIZEOF_HSWORD == 4+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+#else+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+#endif+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (W# x#) = writeWord8ArrayAsWord# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsWord# mba# i# s0 in (# s1, W# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = W# (indexWord8ArrayAsWord# ba# i#)++instance Unaligned (LE Word) where+#if SIZEOF_HSWORD == 4+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (W# x#)) = writeWord8ArrayAs# mba# i# (LE (W32# x#))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, LE (W32# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, LE (W# x#) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (LE (W32# x#)) -> LE (W# x#)+#else+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (W# x#)) = writeWord8ArrayAs# mba# i# (LE (W64# x#))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, LE (W64# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, LE (W# x#) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (LE (W64# x#)) -> LE (W# x#)+#endif++instance Unaligned (BE Word) where+#if SIZEOF_HSWORD == 4+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (W# x#)) = writeWord8ArrayAs# mba# i# (BE (W32# x#))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, BE (W32# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, BE (W# x#) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (BE (W32# x#)) -> BE (W# x#)+#else+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (W# x#)) = writeWord8ArrayAs# mba# i# (BE (W64# x#))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, BE (W64# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, BE (W# x#) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (BE (W64# x#)) -> BE (W# x#)+#endif++--------------------------------------------------------------------------------++instance Unaligned Int16 where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 2+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (I16# x#) = writeWord8ArrayAsInt16# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsInt16# mba# i# s0 in (# s1, I16# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = I16# (indexWord8ArrayAsInt16# ba# i#)++instance Unaligned (LE Int16) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 2+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (I16# x#)) =+ writeWord8ArrayAs# mba# i# (LE (W16# (int2Word# x#)))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, LE (W16# x#) #) = readWord8ArrayAs# mba# i# s0+ in (# s1, LE (I16# (narrow16Int# (word2Int# x#))) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let LE (W16# x#) = indexWord8ArrayAs# ba# i#+ in LE (I16# (narrow16Int# (word2Int# x#)))+#else+ USE_HOST_IMPL(LE)+#endif++instance Unaligned (BE Int16) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 2+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ USE_HOST_IMPL(BE)+#else+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (I16# x#)) =+ writeWord8ArrayAs# mba# i# (BE (W16# (int2Word# x#)))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, BE (W16# x#) #) = readWord8ArrayAs# mba# i# s0+ in (# s1, BE (I16# (narrow16Int# (word2Int# x#))) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let !(BE (W16# x#)) = indexWord8ArrayAs# ba# i#+ in BE (I16# (narrow16Int# (word2Int# x#)))+#endif++--------------------------------------------------------------------------------++instance Unaligned Int32 where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (I32# x#) = writeWord8ArrayAsInt32# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsInt32# mba# i# s0 in (# s1, I32# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = I32# (indexWord8ArrayAsInt32# ba# i#)++instance Unaligned (LE Int32) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (I32# x#)) =+ writeWord8ArrayAs# mba# i# (LE (W32# (int2Word# x#)))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, LE (W32# x#) #) = readWord8ArrayAs# mba# i# s0+ in (# s1, LE (I32# (narrow32Int# (word2Int# x#))) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let LE (W32# x#) = indexWord8ArrayAs# ba# i#+ in LE (I32# (narrow32Int# (word2Int# x#)))+#else+ USE_HOST_IMPL(LE)+#endif++instance Unaligned (BE Int32) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ USE_HOST_IMPL(BE)+#else+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (I32# x#)) =+ writeWord8ArrayAs# mba# i# (BE (W32# (int2Word# x#)))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, BE (W32# x#) #) = readWord8ArrayAs# mba# i# s0+ in (# s1, BE (I32# (narrow32Int# (word2Int# x#))) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let !(BE (W32# x#)) = indexWord8ArrayAs# ba# i#+ in BE (I32# (narrow32Int# (word2Int# x#)))+#endif++--------------------------------------------------------------------------------++instance Unaligned Int64 where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (I64# x#) = writeWord8ArrayAsInt64# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsInt64# mba# i# s0 in (# s1, I64# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = I64# (indexWord8ArrayAsInt64# ba# i#)++instance Unaligned (LE Int64) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (I64# x#)) =+ writeWord8ArrayAs# mba# i# (LE (W64# (int2Word# x#)))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, LE (W64# x#) #) = readWord8ArrayAs# mba# i# s0+ in (# s1, LE (I64# (word2Int# x#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let LE (W64# x#) = indexWord8ArrayAs# ba# i#+ in LE (I64# (word2Int# x#))+#else+ USE_HOST_IMPL(LE)+#endif++instance Unaligned (BE Int64) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ USE_HOST_IMPL(BE)+#else+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (I64# x#)) =+ writeWord8ArrayAs# mba# i# (BE (W64# (int2Word# x#)))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, BE (W64# x#) #) = readWord8ArrayAs# mba# i# s0+ in (# s1, BE (I64# (word2Int# x#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let !(BE (W64# x#)) = indexWord8ArrayAs# ba# i#+ in BE (I64# (word2Int# x#))+#endif++--------------------------------------------------------------------------------++instance Unaligned Int where+#if SIZEOF_HSWORD == 4+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+#else+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+#endif+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (I# x#) = writeWord8ArrayAsInt# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsInt# mba# i# s0 in (# s1, I# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = I# (indexWord8ArrayAsInt# ba# i#)++instance Unaligned (LE Int) where+#if SIZEOF_HSWORD == 4+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (I# x#)) = writeWord8ArrayAs# mba# i# (LE (I32# x#))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, LE (I32# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, LE (I# x#) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (LE (I32# x#)) -> LE (I# x#)+#else+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (I# x#)) = writeWord8ArrayAs# mba# i# (LE (I64# x#))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, LE (I64# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, LE (I# x#) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (LE (I64# x#)) -> LE (I# x#)+#endif++instance Unaligned (BE Int) where+#if SIZEOF_HSWORD == 4+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (I# x#)) = writeWord8ArrayAs# mba# i# (BE (I32# x#))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, BE (I32# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, BE (I# x#) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (BE (I32# x#)) -> BE (I# x#)+#else+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (I# x#)) = writeWord8ArrayAs# mba# i# (BE (I64# x#))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, BE (I64# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, BE (I# x#) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (BE (I64# x#)) -> BE (I# x#)+#endif++--------------------------------------------------------------------------------++instance Unaligned Float where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (F# x#) = writeWord8ArrayAsFloat# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsFloat# mba# i# s0 in (# s1, F# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = F# (indexWord8ArrayAsFloat# ba# i#)++instance Unaligned (LE Float) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (F# x#)) =+ writeWord8ArrayAs# mba# i# (LE (W32# (stgFloatToWord32 x#)))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, LE (W32# x#) #) = readWord8ArrayAs# mba# i# s0+ in (# s1, LE (F# (stgWord32ToFloat x#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let LE (W32# x#) = indexWord8ArrayAs# ba# i#+ in LE (F# (stgWord32ToFloat x#))+#else+ USE_HOST_IMPL(LE)+#endif++instance Unaligned (BE Float) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ USE_HOST_IMPL(BE)+#else+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (F# x#)) =+ writeWord8ArrayAs# mba# i# (BE (W32# (stgFloatToWord32 x#)))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, BE (W32# x#) #) = readWord8ArrayAs# mba# i# s0+ in (# s1, BE (F# (stgWord32ToFloat x#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let !(BE (W32# x#)) = indexWord8ArrayAs# ba# i#+ in BE (F# (stgWord32ToFloat x#))+#endif++--------------------------------------------------------------------------------++instance Unaligned Double where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (D# x#) = writeWord8ArrayAsDouble# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsDouble# mba# i# s0 in (# s1, D# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = D# (indexWord8ArrayAsDouble# ba# i#)++instance Unaligned (LE Double) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 8+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (D# x#)) =+ writeWord8ArrayAs# mba# i# (LE (W64# (stgDoubleToWord64 x#)))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, LE (W64# x#) #) = readWord8ArrayAs# mba# i# s0+ in (# s1, LE (D# (stgWord64ToDouble x#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let LE (W64# x#) = indexWord8ArrayAs# ba# i#+ in LE (D# (stgWord64ToDouble x#))+#else+ USE_HOST_IMPL(LE)+#endif++instance Unaligned (BE Double) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ USE_HOST_IMPL(BE)+#else+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (D# x#)) =+ writeWord8ArrayAs# mba# i# (BE (W64# (stgDoubleToWord64 x#)))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, BE (W64# x#) #) = readWord8ArrayAs# mba# i# s0+ in (# s1, BE (D# (stgWord64ToDouble x#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let !(BE (W64# x#)) = indexWord8ArrayAs# ba# i#+ in BE (D# (stgWord64ToDouble x#))+#endif++--------------------------------------------------------------------------------++-- | Char's instance use 31bit wide char prim-op.+instance Unaligned Char where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (C# x#) = writeWord8ArrayAsWideChar# mba# i# x#+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, x# #) = readWord8ArrayAsWideChar# mba# i# s0 in (# s1, C# x# #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# = C# (indexWord8ArrayAsWideChar# ba# i#)++instance Unaligned (LE Char) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (LE (C# x#)) =+ writeWord8ArrayAs# mba# i# (LE (I32# (ord# x#)))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, LE (I32# x#) #) = readWord8ArrayAs# mba# i# s0+ in (# s1, LE (C# (chr# x#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let LE (I32# x#) = indexWord8ArrayAs# ba# i#+ in LE (C# (chr# x#))+#else+ USE_HOST_IMPL(LE)+#endif++instance Unaligned (BE Char) where+ {-# INLINE unalignedSize #-}+ unalignedSize _ = 4+#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)+ USE_HOST_IMPL(BE)+#else+ {-# INLINE writeWord8ArrayAs# #-}+ writeWord8ArrayAs# mba# i# (BE (C# x#)) =+ writeWord8ArrayAs# mba# i# (BE (I32# (ord# x#)))+ {-# INLINE readWord8ArrayAs# #-}+ readWord8ArrayAs# mba# i# s0 =+ let !(# s1, BE (I32# x#) #) = readWord8ArrayAs# mba# i# s0+ in (# s1, BE (C# (chr# x#)) #)+ {-# INLINE indexWord8ArrayAs# #-}+ indexWord8ArrayAs# ba# i# =+ let !(BE (I32# x#)) = indexWord8ArrayAs# ba# i#+ in BE (C# (chr# x#))+#endif++--------------------------------------------------------------------------------++-- Prim instances for newtypes in Foreign.C.Types+deriving instance Unaligned CChar+deriving instance Unaligned CSChar+deriving instance Unaligned CUChar+deriving instance Unaligned CShort+deriving instance Unaligned CUShort+deriving instance Unaligned CInt+deriving instance Unaligned CUInt+deriving instance Unaligned CLong+deriving instance Unaligned CULong+deriving instance Unaligned CPtrdiff+deriving instance Unaligned CSize+deriving instance Unaligned CWchar+deriving instance Unaligned CSigAtomic+deriving instance Unaligned CLLong+deriving instance Unaligned CULLong+deriving instance Unaligned CBool+deriving instance Unaligned CIntPtr+deriving instance Unaligned CUIntPtr+deriving instance Unaligned CIntMax+deriving instance Unaligned CUIntMax+deriving instance Unaligned CClock+deriving instance Unaligned CTime+deriving instance Unaligned CUSeconds+deriving instance Unaligned CSUSeconds+deriving instance Unaligned CFloat+deriving instance Unaligned CDouble
− Z/Data/Array/UnalignedAccess.hs
@@ -1,924 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}--{-|-Module : Z.Data.Array.UnalignedAccess-Description : unaligned access for primitive arrays-Copyright : (c) Dong Han, 2017-2019-License : BSD-Maintainer : winterland1989@gmail.com-Stability : experimental-Portability : non-portable--This module implements unaligned element access with ghc primitives (> 8.6).--}--module Z.Data.Array.UnalignedAccess where--import Control.Monad.Primitive-import Data.Primitive.ByteArray-import Data.Primitive.PrimArray-import GHC.Int-import GHC.Exts-import GHC.Word-import GHC.Float (stgFloatToWord32, stgWord32ToFloat, stgWord64ToDouble, stgDoubleToWord64)-import Foreign.C.Types---- toggle these defs to test different implements-#define USE_BSWAP--- #define USE_SHIFT------------------------------------------------------------------------------------newtype UnalignedSize a = UnalignedSize { getUnalignedSize :: Int } deriving (Show, Eq)---- | Primitive types which can be unaligned accessed------ It can also be used as a lightweight method to peek\/poke value from\/to C structs--- when you pass 'MutableByteArray#' to FFI as struct pointer, e.g.------ @--- -- | note the .hsc syntax--- peekSocketAddrMBA :: HasCallStack => MBA## SocketAddr -> IO SocketAddr--- peekSocketAddrMBA p = do--- family <- peekMBA p (#offset struct sockaddr, sa_family)--- case family :: CSaFamily of--- (#const AF_INET) -> do--- addr <- peekMBA p (#offset struct sockaddr_in, sin_addr)--- port <- peekMBA p (#offset struct sockaddr_in, sin_port)--- return (SocketAddrInet (PortNumber port) addr)--- ....--- @----class UnalignedAccess a where- {-# MINIMAL unalignedSize, indexWord8ArrayAs#, writeWord8ArrayAs#, readWord8ArrayAs# |- unalignedSize, indexBA, peekMBA, pokeMBA #-}- -- | byte size- unalignedSize :: UnalignedSize a-- -- | index element off byte array with offset in bytes(maybe unaligned)- indexWord8ArrayAs# :: ByteArray# -> Int# -> a- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = indexBA ba# (I# i#)-- -- | read element from byte array with offset in bytes(maybe unaligned)- readWord8ArrayAs# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s# =- (unsafeCoerce# (peekMBA (unsafeCoerce# mba#) (I# i#) :: IO a)) s#-- -- | write element to byte array with offset in bytes(maybe unaligned)- writeWord8ArrayAs# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# x s# =- unsafeCoerce# (pokeMBA (unsafeCoerce# mba#) (I# i#) x) s#-- -- | IO version of 'writeWord8ArrayAs#' but more convenient to write manually.- peekMBA :: MutableByteArray# RealWorld -> Int -> IO a- {-# INLINE peekMBA #-}- peekMBA mba# (I# i#) = primitive (readWord8ArrayAs# mba# i#)-- -- | IO version of 'readWord8ArrayAs#' but more convenient to write manually.- pokeMBA :: MutableByteArray# RealWorld -> Int -> a -> IO ()- {-# INLINE pokeMBA #-}- pokeMBA mba# (I# i#) x = primitive_ (writeWord8ArrayAs# mba# i# x)-- -- | index element off byte array with offset in bytes(maybe unaligned)- indexBA :: ByteArray# -> Int -> a- {-# INLINE indexBA #-}- indexBA ba# (I# i#) = indexWord8ArrayAs# ba# i#----- | Lifted version of 'writeWord8ArrayAs#'-writeWord8ArrayAs :: (PrimMonad m, UnalignedAccess a) => MutableByteArray (PrimState m) -> Int -> a -> m ()-{-# INLINE writeWord8ArrayAs #-}-writeWord8ArrayAs (MutableByteArray mba#) (I# i#) x = primitive_ (writeWord8ArrayAs# mba# i# x)---- | Lifted version of 'readWord8ArrayAs#'-readWord8ArrayAs :: (PrimMonad m, UnalignedAccess a) => MutableByteArray (PrimState m) -> Int -> m a-{-# INLINE readWord8ArrayAs #-}-readWord8ArrayAs (MutableByteArray mba#) (I# i#) = primitive (readWord8ArrayAs# mba# i#)---- | Lifted version of 'indexWord8ArrayAs#'-indexWord8ArrayAs :: UnalignedAccess a => ByteArray -> Int -> a-{-# INLINE indexWord8ArrayAs #-}-indexWord8ArrayAs (ByteArray ba#) (I# i#) = indexWord8ArrayAs# ba# i#---- | Lifted version of 'writeWord8ArrayAs#'-writePrimWord8ArrayAs :: (PrimMonad m, UnalignedAccess a) => MutablePrimArray (PrimState m) Word8 -> Int -> a -> m ()-{-# INLINE writePrimWord8ArrayAs #-}-writePrimWord8ArrayAs (MutablePrimArray mba#) (I# i#) x = primitive_ (writeWord8ArrayAs# mba# i# x)---- | Lifted version of 'readWord8ArrayAs#'-readPrimWord8ArrayAs :: (PrimMonad m, UnalignedAccess a) => MutablePrimArray (PrimState m) Word8 -> Int -> m a-{-# INLINE readPrimWord8ArrayAs #-}-readPrimWord8ArrayAs (MutablePrimArray mba#) (I# i#) = primitive (readWord8ArrayAs# mba# i#)---- | Lifted version of 'indexWord8ArrayAs#'-indexPrimWord8ArrayAs :: UnalignedAccess a => PrimArray Word8 -> Int -> a-{-# INLINE indexPrimWord8ArrayAs #-}-indexPrimWord8ArrayAs (PrimArray ba#) (I# i#) = indexWord8ArrayAs# ba# i#--instance UnalignedAccess Word8 where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 1- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (W8# x#) = writeWord8Array# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8Array# mba# i# s0 in (# s1, W8# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = W8# (indexWord8Array# ba# i#)--instance UnalignedAccess Int8 where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 1- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (I8# x#) = writeInt8Array# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readInt8Array# mba# i# s0 in (# s1, I8# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = I8# (indexInt8Array# ba# i#)---- | little endianess wrapper----newtype LE a = LE { getLE :: a } deriving (Show, Eq)---- | big endianess wrapper----newtype BE a = BE { getBE :: a } deriving (Show, Eq)--#define USE_HOST_IMPL(END) \- {-# INLINE writeWord8ArrayAs# #-}; \- writeWord8ArrayAs# mba# i# (END x) = writeWord8ArrayAs# mba# i# x; \- {-# INLINE readWord8ArrayAs# #-}; \- readWord8ArrayAs# mba# i# s0 = \- let !(# s1, x #) = readWord8ArrayAs# mba# i# s0 in (# s1, END x #); \- {-# INLINE indexWord8ArrayAs# #-}; \- indexWord8ArrayAs# ba# i# = END (indexWord8ArrayAs# ba# i#);------------------------------------------------------------------------------------instance UnalignedAccess Word16 where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 2- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (W16# x#) = writeWord8ArrayAsWord16# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsWord16# mba# i# s0 in (# s1, W16# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = W16# (indexWord8ArrayAsWord16# ba# i#)--instance UnalignedAccess (LE Word16) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 2-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (W16# x#)) s0# =- let s1# = writeWord8Array# mba# i# x# s0#- in writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 8#) s1#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, w1# #) = readWord8Array# mba# i# s0- !(# s2, w2# #) = readWord8Array# mba# (i# +# 1#) s1- in (# s2, LE (W16# (uncheckedShiftL# w2# 8# `or#` w1#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let w1# = indexWord8Array# ba# i#- w2# = indexWord8Array# ba# (i# +# 1#)- in LE (W16# (uncheckedShiftL# w2# 8# `or#` w1#))-#else- USE_HOST_IMPL(LE)-#endif--instance UnalignedAccess (BE Word16) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 2-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- USE_HOST_IMPL(BE)-#else--- on X86 we use bswap--- TODO: find out if arch64 support this-#if (defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)) && defined(USE_BSWAP)- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (W16# x#)) = writeWord8ArrayAsWord16# mba# i# (byteSwap16# x#)- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsWord16# mba# i# s0- in (# s1, BE (W16# (byteSwap16# x#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = BE (W16# (byteSwap16# (indexWord8ArrayAsWord16# ba# i#)))-#else- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (W16# x#)) s0# =- let s1# = writeWord8Array# mba# i# (uncheckedShiftRL# x# 8#) s0#- in writeWord8Array# mba# (i# +# 1#) x# s1#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, w2# #) = readWord8Array# mba# i# s0- !(# s2, w1# #) = readWord8Array# mba# (i# +# 1#) s1- in (# s2, BE (W16# (uncheckedShiftL# w2# 8# `or#` w1#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let w2# = indexWord8Array# ba# i#- w1# = indexWord8Array# ba# (i# +# 1#)- in BE (W16# (uncheckedShiftL# w2# 8# `or#` w1#))-#endif-#endif------------------------------------------------------------------------------------instance UnalignedAccess Word32 where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (W32# x#) = writeWord8ArrayAsWord32# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsWord32# mba# i# s0 in (# s1, W32# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = W32# (indexWord8ArrayAsWord32# ba# i#)---instance UnalignedAccess (LE Word32) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (W32# x#)) s0# =- let s1# = writeWord8Array# mba# i# x# s0#- s2# = writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 8#) s1#- s3# = writeWord8Array# mba# (i# +# 2#) (uncheckedShiftRL# x# 16#) s2#- in writeWord8Array# mba# (i# +# 3#) (uncheckedShiftRL# x# 24#) s3#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, w1# #) = readWord8Array# mba# i# s0- !(# s2, w2# #) = readWord8Array# mba# (i# +# 1#) s1- !(# s3, w3# #) = readWord8Array# mba# (i# +# 2#) s2- !(# s4, w4# #) = readWord8Array# mba# (i# +# 3#) s3- in (# s4, LE (W32# ((uncheckedShiftL# w4# 24#) `or#`- (uncheckedShiftL# w3# 16#) `or#`- (uncheckedShiftL# w2# 8#) `or#` w1#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let w1# = indexWord8Array# ba# i#- w2# = indexWord8Array# ba# (i# +# 1#)- w3# = indexWord8Array# ba# (i# +# 2#)- w4# = indexWord8Array# ba# (i# +# 3#)- in LE (W32# ((uncheckedShiftL# w4# 24#) `or#`- (uncheckedShiftL# w3# 16#) `or#`- (uncheckedShiftL# w2# 8#) `or#` w1#))-#else- USE_HOST_IMPL(LE)-#endif--instance UnalignedAccess (BE Word32) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- USE_HOST_IMPL(BE)-#else--- on X86 we use bswap--- TODO: find out if arch64 support this-#if (defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)) && defined(USE_BSWAP)- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (W32# x#)) = writeWord8ArrayAsWord32# mba# i# (byteSwap32# x#)- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsWord32# mba# i# s0- in (# s1, BE (W32# (byteSwap32# x#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = BE (W32# (byteSwap32# (indexWord8ArrayAsWord32# ba# i#)))-#else- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (W32# x#)) s0# =- let s1# = writeWord8Array# mba# i# (uncheckedShiftRL# x# 24#) s0#- s2# = writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 16#) s1#- s3# = writeWord8Array# mba# (i# +# 2#) (uncheckedShiftRL# x# 8#) s2#- in writeWord8Array# mba# (i# +# 3#) x# s3#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, w4# #) = readWord8Array# mba# i# s0- !(# s2, w3# #) = readWord8Array# mba# (i# +# 1#) s1- !(# s3, w2# #) = readWord8Array# mba# (i# +# 2#) s2- !(# s4, w1# #) = readWord8Array# mba# (i# +# 3#) s3- in (# s4, BE (W32# ((uncheckedShiftL# w4# 24#) `or#`- (uncheckedShiftL# w3# 16#) `or#`- (uncheckedShiftL# w2# 8#) `or#` w1#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let w4# = indexWord8Array# ba# i#- w3# = indexWord8Array# ba# (i# +# 1#)- w2# = indexWord8Array# ba# (i# +# 2#)- w1# = indexWord8Array# ba# (i# +# 3#)- in BE (W32# ((uncheckedShiftL# w4# 24#) `or#`- (uncheckedShiftL# w3# 16#) `or#`- (uncheckedShiftL# w2# 8#) `or#` w1#))-#endif-#endif------------------------------------------------------------------------------------instance UnalignedAccess Word64 where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (W64# x#) = writeWord8ArrayAsWord64# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsWord64# mba# i# s0 in (# s1, W64# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = W64# (indexWord8ArrayAsWord64# ba# i#)---instance UnalignedAccess (LE Word64) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (W64# x#)) s0# =- let s1# = writeWord8Array# mba# i# x# s0#- s2# = writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 8#) s1#- s3# = writeWord8Array# mba# (i# +# 2#) (uncheckedShiftRL# x# 16#) s2#- s4# = writeWord8Array# mba# (i# +# 3#) (uncheckedShiftRL# x# 24#) s3#- s5# = writeWord8Array# mba# (i# +# 4#) (uncheckedShiftRL# x# 32#) s4#- s6# = writeWord8Array# mba# (i# +# 5#) (uncheckedShiftRL# x# 40#) s5#- s7# = writeWord8Array# mba# (i# +# 6#) (uncheckedShiftRL# x# 48#) s6#- in writeWord8Array# mba# (i# +# 7#) (uncheckedShiftRL# x# 56#) s7#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, w1# #) = readWord8Array# mba# i# s0- !(# s2, w2# #) = readWord8Array# mba# (i# +# 1#) s1- !(# s3, w3# #) = readWord8Array# mba# (i# +# 2#) s2- !(# s4, w4# #) = readWord8Array# mba# (i# +# 3#) s3- !(# s5, w5# #) = readWord8Array# mba# (i# +# 4#) s4- !(# s6, w6# #) = readWord8Array# mba# (i# +# 5#) s5- !(# s7, w7# #) = readWord8Array# mba# (i# +# 6#) s6- !(# s8, w8# #) = readWord8Array# mba# (i# +# 7#) s7- in (# s8, LE (W64# ((uncheckedShiftL# w8# 56#) `or#`- (uncheckedShiftL# w7# 48#) `or#`- (uncheckedShiftL# w6# 40#) `or#`- (uncheckedShiftL# w5# 32#) `or#`- (uncheckedShiftL# w4# 24#) `or#`- (uncheckedShiftL# w3# 16#) `or#`- (uncheckedShiftL# w2# 8#) `or#` w1#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let w1# = indexWord8Array# ba# i#- w2# = indexWord8Array# ba# (i# +# 1#)- w3# = indexWord8Array# ba# (i# +# 2#)- w4# = indexWord8Array# ba# (i# +# 3#)- w5# = indexWord8Array# ba# (i# +# 4#)- w6# = indexWord8Array# ba# (i# +# 5#)- w7# = indexWord8Array# ba# (i# +# 6#)- w8# = indexWord8Array# ba# (i# +# 7#)- in LE (W64# ((uncheckedShiftL# w8# 56#) `or#`- (uncheckedShiftL# w7# 48#) `or#`- (uncheckedShiftL# w6# 40#) `or#`- (uncheckedShiftL# w5# 32#) `or#`- (uncheckedShiftL# w4# 24#) `or#`- (uncheckedShiftL# w3# 16#) `or#`- (uncheckedShiftL# w2# 8#) `or#` w1#))-#else- USE_HOST_IMPL(LE)-#endif--instance UnalignedAccess (BE Word64) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- USE_HOST_IMPL(BE)-#else--- on X86 we use bswap--- TODO: find out if arch64 support this-#if (defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)) && defined(USE_BSWAP)- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (W64# x#)) = writeWord8ArrayAsWord64# mba# i# (byteSwap64# x#)- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsWord64# mba# i# s0- in (# s1, BE (W64# (byteSwap64# x#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = BE (W64# (byteSwap64# (indexWord8ArrayAsWord64# ba# i#)))-#else- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (W64# x#)) s0# =- let s1# = writeWord8Array# mba# i# (uncheckedShiftRL# x# 56#) s0#- s2# = writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 48#) s1#- s3# = writeWord8Array# mba# (i# +# 2#) (uncheckedShiftRL# x# 40#) s2#- s4# = writeWord8Array# mba# (i# +# 3#) (uncheckedShiftRL# x# 32#) s3#- s5# = writeWord8Array# mba# (i# +# 4#) (uncheckedShiftRL# x# 24#) s4#- s6# = writeWord8Array# mba# (i# +# 5#) (uncheckedShiftRL# x# 16#) s5#- s7# = writeWord8Array# mba# (i# +# 6#) (uncheckedShiftRL# x# 8#) s6#- in writeWord8Array# mba# (i# +# 7#) x# s7#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, w8# #) = readWord8Array# mba# i# s0- !(# s2, w7# #) = readWord8Array# mba# (i# +# 1#) s1- !(# s3, w6# #) = readWord8Array# mba# (i# +# 2#) s2- !(# s4, w5# #) = readWord8Array# mba# (i# +# 3#) s3- !(# s5, w4# #) = readWord8Array# mba# (i# +# 4#) s4- !(# s6, w3# #) = readWord8Array# mba# (i# +# 5#) s5- !(# s7, w2# #) = readWord8Array# mba# (i# +# 6#) s6- !(# s8, w1# #) = readWord8Array# mba# (i# +# 7#) s7- in (# s8, BE (W64# ((uncheckedShiftL# w8# 56#) `or#`- (uncheckedShiftL# w7# 48#) `or#`- (uncheckedShiftL# w6# 40#) `or#`- (uncheckedShiftL# w5# 32#) `or#`- (uncheckedShiftL# w4# 24#) `or#`- (uncheckedShiftL# w3# 16#) `or#`- (uncheckedShiftL# w2# 8#) `or#` w1#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let w8# = indexWord8Array# ba# i#- w7# = indexWord8Array# ba# (i# +# 1#)- w6# = indexWord8Array# ba# (i# +# 2#)- w5# = indexWord8Array# ba# (i# +# 3#)- w4# = indexWord8Array# ba# (i# +# 4#)- w3# = indexWord8Array# ba# (i# +# 5#)- w2# = indexWord8Array# ba# (i# +# 6#)- w1# = indexWord8Array# ba# (i# +# 7#)- in BE (W64# ((uncheckedShiftL# w8# 56#) `or#`- (uncheckedShiftL# w7# 48#) `or#`- (uncheckedShiftL# w6# 40#) `or#`- (uncheckedShiftL# w5# 32#) `or#`- (uncheckedShiftL# w4# 24#) `or#`- (uncheckedShiftL# w3# 16#) `or#`- (uncheckedShiftL# w2# 8#) `or#` w1#))-#endif-#endif------------------------------------------------------------------------------------instance UnalignedAccess Word where-#if SIZEOF_HSWORD == 4- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4-#else- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8-#endif- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (W# x#) = writeWord8ArrayAsWord# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsWord# mba# i# s0 in (# s1, W# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = W# (indexWord8ArrayAsWord# ba# i#)--instance UnalignedAccess (LE Word) where-#if SIZEOF_HSWORD == 4- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (W# x#)) = writeWord8ArrayAs# mba# i# (LE (W32# x#))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, LE (W32# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, LE (W# x#) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (LE (W32# x#)) -> LE (W# x#)-#else- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (W# x#)) = writeWord8ArrayAs# mba# i# (LE (W64# x#))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, LE (W64# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, LE (W# x#) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (LE (W64# x#)) -> LE (W# x#)-#endif--instance UnalignedAccess (BE Word) where-#if SIZEOF_HSWORD == 4- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (W# x#)) = writeWord8ArrayAs# mba# i# (BE (W32# x#))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, BE (W32# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, BE (W# x#) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (BE (W32# x#)) -> BE (W# x#)-#else- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (W# x#)) = writeWord8ArrayAs# mba# i# (BE (W64# x#))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, BE (W64# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, BE (W# x#) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (BE (W64# x#)) -> BE (W# x#)-#endif------------------------------------------------------------------------------------instance UnalignedAccess Int16 where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 2- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (I16# x#) = writeWord8ArrayAsInt16# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsInt16# mba# i# s0 in (# s1, I16# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = I16# (indexWord8ArrayAsInt16# ba# i#)--instance UnalignedAccess (LE Int16) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 2-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (I16# x#)) =- writeWord8ArrayAs# mba# i# (LE (W16# (int2Word# x#)))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, LE (W16# x#) #) = readWord8ArrayAs# mba# i# s0- in (# s1, LE (I16# (narrow16Int# (word2Int# x#))) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let LE (W16# x#) = indexWord8ArrayAs# ba# i#- in LE (I16# (narrow16Int# (word2Int# x#)))-#else- USE_HOST_IMPL(LE)-#endif--instance UnalignedAccess (BE Int16) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 2-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- USE_HOST_IMPL(BE)-#else- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (I16# x#)) =- writeWord8ArrayAs# mba# i# (BE (W16# (int2Word# x#)))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, BE (W16# x#) #) = readWord8ArrayAs# mba# i# s0- in (# s1, BE (I16# (narrow16Int# (word2Int# x#))) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let !(BE (W16# x#)) = indexWord8ArrayAs# ba# i#- in BE (I16# (narrow16Int# (word2Int# x#)))-#endif------------------------------------------------------------------------------------instance UnalignedAccess Int32 where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (I32# x#) = writeWord8ArrayAsInt32# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsInt32# mba# i# s0 in (# s1, I32# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = I32# (indexWord8ArrayAsInt32# ba# i#)--instance UnalignedAccess (LE Int32) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (I32# x#)) =- writeWord8ArrayAs# mba# i# (LE (W32# (int2Word# x#)))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, LE (W32# x#) #) = readWord8ArrayAs# mba# i# s0- in (# s1, LE (I32# (narrow32Int# (word2Int# x#))) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let LE (W32# x#) = indexWord8ArrayAs# ba# i#- in LE (I32# (narrow32Int# (word2Int# x#)))-#else- USE_HOST_IMPL(LE)-#endif--instance UnalignedAccess (BE Int32) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- USE_HOST_IMPL(BE)-#else- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (I32# x#)) =- writeWord8ArrayAs# mba# i# (BE (W32# (int2Word# x#)))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, BE (W32# x#) #) = readWord8ArrayAs# mba# i# s0- in (# s1, BE (I32# (narrow32Int# (word2Int# x#))) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let !(BE (W32# x#)) = indexWord8ArrayAs# ba# i#- in BE (I32# (narrow32Int# (word2Int# x#)))-#endif------------------------------------------------------------------------------------instance UnalignedAccess Int64 where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (I64# x#) = writeWord8ArrayAsInt64# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsInt64# mba# i# s0 in (# s1, I64# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = I64# (indexWord8ArrayAsInt64# ba# i#)--instance UnalignedAccess (LE Int64) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (I64# x#)) =- writeWord8ArrayAs# mba# i# (LE (W64# (int2Word# x#)))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, LE (W64# x#) #) = readWord8ArrayAs# mba# i# s0- in (# s1, LE (I64# (word2Int# x#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let LE (W64# x#) = indexWord8ArrayAs# ba# i#- in LE (I64# (word2Int# x#))-#else- USE_HOST_IMPL(LE)-#endif--instance UnalignedAccess (BE Int64) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- USE_HOST_IMPL(BE)-#else- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (I64# x#)) =- writeWord8ArrayAs# mba# i# (BE (W64# (int2Word# x#)))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, BE (W64# x#) #) = readWord8ArrayAs# mba# i# s0- in (# s1, BE (I64# (word2Int# x#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let !(BE (W64# x#)) = indexWord8ArrayAs# ba# i#- in BE (I64# (word2Int# x#))-#endif------------------------------------------------------------------------------------instance UnalignedAccess Int where-#if SIZEOF_HSWORD == 4- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4-#else- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8-#endif- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (I# x#) = writeWord8ArrayAsInt# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsInt# mba# i# s0 in (# s1, I# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = I# (indexWord8ArrayAsInt# ba# i#)--instance UnalignedAccess (LE Int) where-#if SIZEOF_HSWORD == 4- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (I# x#)) = writeWord8ArrayAs# mba# i# (LE (I32# x#))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, LE (I32# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, LE (I# x#) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (LE (I32# x#)) -> LE (I# x#)-#else- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (I# x#)) = writeWord8ArrayAs# mba# i# (LE (I64# x#))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, LE (I64# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, LE (I# x#) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (LE (I64# x#)) -> LE (I# x#)-#endif--instance UnalignedAccess (BE Int) where-#if SIZEOF_HSWORD == 4- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (I# x#)) = writeWord8ArrayAs# mba# i# (BE (I32# x#))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, BE (I32# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, BE (I# x#) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (BE (I32# x#)) -> BE (I# x#)-#else- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (I# x#)) = writeWord8ArrayAs# mba# i# (BE (I64# x#))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, BE (I64# x#) #) = readWord8ArrayAs# mba# i# s0 in (# s1, BE (I# x#) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (BE (I64# x#)) -> BE (I# x#)-#endif------------------------------------------------------------------------------------instance UnalignedAccess Float where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (F# x#) = writeWord8ArrayAsFloat# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsFloat# mba# i# s0 in (# s1, F# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = F# (indexWord8ArrayAsFloat# ba# i#)--instance UnalignedAccess (LE Float) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (F# x#)) =- writeWord8ArrayAs# mba# i# (LE (W32# (stgFloatToWord32 x#)))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, LE (W32# x#) #) = readWord8ArrayAs# mba# i# s0- in (# s1, LE (F# (stgWord32ToFloat x#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let LE (W32# x#) = indexWord8ArrayAs# ba# i#- in LE (F# (stgWord32ToFloat x#))-#else- USE_HOST_IMPL(LE)-#endif--instance UnalignedAccess (BE Float) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- USE_HOST_IMPL(BE)-#else- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (F# x#)) =- writeWord8ArrayAs# mba# i# (BE (W32# (stgFloatToWord32 x#)))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, BE (W32# x#) #) = readWord8ArrayAs# mba# i# s0- in (# s1, BE (F# (stgWord32ToFloat x#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let !(BE (W32# x#)) = indexWord8ArrayAs# ba# i#- in BE (F# (stgWord32ToFloat x#))-#endif------------------------------------------------------------------------------------instance UnalignedAccess Double where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (D# x#) = writeWord8ArrayAsDouble# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsDouble# mba# i# s0 in (# s1, D# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = D# (indexWord8ArrayAsDouble# ba# i#)--instance UnalignedAccess (LE Double) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 8-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (D# x#)) =- writeWord8ArrayAs# mba# i# (LE (W64# (stgDoubleToWord64 x#)))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, LE (W64# x#) #) = readWord8ArrayAs# mba# i# s0- in (# s1, LE (D# (stgWord64ToDouble x#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let LE (W64# x#) = indexWord8ArrayAs# ba# i#- in LE (D# (stgWord64ToDouble x#))-#else- USE_HOST_IMPL(LE)-#endif--instance UnalignedAccess (BE Double) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- USE_HOST_IMPL(BE)-#else- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (D# x#)) =- writeWord8ArrayAs# mba# i# (BE (W64# (stgDoubleToWord64 x#)))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, BE (W64# x#) #) = readWord8ArrayAs# mba# i# s0- in (# s1, BE (D# (stgWord64ToDouble x#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let !(BE (W64# x#)) = indexWord8ArrayAs# ba# i#- in BE (D# (stgWord64ToDouble x#))-#endif-------------------------------------------------------------------------------------- | Char's instance use 31bit wide char prim-op.-instance UnalignedAccess Char where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (C# x#) = writeWord8ArrayAsWideChar# mba# i# x#- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, x# #) = readWord8ArrayAsWideChar# mba# i# s0 in (# s1, C# x# #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# = C# (indexWord8ArrayAsWideChar# ba# i#)--instance UnalignedAccess (LE Char) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (LE (C# x#)) =- writeWord8ArrayAs# mba# i# (LE (I32# (ord# x#)))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, LE (I32# x#) #) = readWord8ArrayAs# mba# i# s0- in (# s1, LE (C# (chr# x#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let LE (I32# x#) = indexWord8ArrayAs# ba# i#- in LE (C# (chr# x#))-#else- USE_HOST_IMPL(LE)-#endif--instance UnalignedAccess (BE Char) where- {-# INLINE unalignedSize #-}- unalignedSize = UnalignedSize 4-#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)- USE_HOST_IMPL(BE)-#else- {-# INLINE writeWord8ArrayAs# #-}- writeWord8ArrayAs# mba# i# (BE (C# x#)) =- writeWord8ArrayAs# mba# i# (BE (I32# (ord# x#)))- {-# INLINE readWord8ArrayAs# #-}- readWord8ArrayAs# mba# i# s0 =- let !(# s1, BE (I32# x#) #) = readWord8ArrayAs# mba# i# s0- in (# s1, BE (C# (chr# x#)) #)- {-# INLINE indexWord8ArrayAs# #-}- indexWord8ArrayAs# ba# i# =- let !(BE (I32# x#)) = indexWord8ArrayAs# ba# i#- in BE (C# (chr# x#))-#endif-------------------------------------------------------------------------------------- Prim instances for newtypes in Foreign.C.Types-deriving instance UnalignedAccess CChar-deriving instance UnalignedAccess CSChar-deriving instance UnalignedAccess CUChar-deriving instance UnalignedAccess CShort-deriving instance UnalignedAccess CUShort-deriving instance UnalignedAccess CInt-deriving instance UnalignedAccess CUInt-deriving instance UnalignedAccess CLong-deriving instance UnalignedAccess CULong-deriving instance UnalignedAccess CPtrdiff-deriving instance UnalignedAccess CSize-deriving instance UnalignedAccess CWchar-deriving instance UnalignedAccess CSigAtomic-deriving instance UnalignedAccess CLLong-deriving instance UnalignedAccess CULLong-deriving instance UnalignedAccess CBool-deriving instance UnalignedAccess CIntPtr-deriving instance UnalignedAccess CUIntPtr-deriving instance UnalignedAccess CIntMax-deriving instance UnalignedAccess CUIntMax-deriving instance UnalignedAccess CClock-deriving instance UnalignedAccess CTime-deriving instance UnalignedAccess CUSeconds-deriving instance UnalignedAccess CSUSeconds-deriving instance UnalignedAccess CFloat-deriving instance UnalignedAccess CDouble
Z/Data/Builder/Base.hs view
@@ -82,7 +82,7 @@ import GHC.CString (unpackCString#, unpackCStringUtf8#) import GHC.Exts import qualified Z.Data.Array as A-import Z.Data.Array.UnalignedAccess+import Z.Data.Array.Unaligned import qualified Z.Data.Text.Base as T import qualified Z.Data.Text.UTF8Codec as T import qualified Z.Data.Vector.Base as V@@ -378,7 +378,7 @@ f buf offset >> k () (Buffer buf (offset+n))) -- | write primitive types in host byte order.-encodePrim :: forall a. UnalignedAccess a => a -> Builder ()+encodePrim :: forall a. Unaligned a => a -> Builder () {-# INLINE encodePrim #-} {-# SPECIALIZE INLINE encodePrim :: Word -> Builder () #-} {-# SPECIALIZE INLINE encodePrim :: Word64 -> Builder () #-}@@ -396,10 +396,10 @@ writePrimWord8ArrayAs mpa i x k () (Buffer mpa (i + n))) where- n = (getUnalignedSize (unalignedSize :: UnalignedSize a))+ n = unalignedSize (undefined :: a) -- | write primitive types with little endianess.-encodePrimLE :: forall a. UnalignedAccess (LE a) => a -> Builder ()+encodePrimLE :: forall a. Unaligned (LE a) => a -> Builder () {-# INLINE encodePrimLE #-} {-# SPECIALIZE INLINE encodePrimLE :: Word -> Builder () #-} {-# SPECIALIZE INLINE encodePrimLE :: Word64 -> Builder () #-}@@ -412,7 +412,7 @@ encodePrimLE = encodePrim . LE -- | write primitive types with big endianess.-encodePrimBE :: forall a. UnalignedAccess (BE a) => a -> Builder ()+encodePrimBE :: forall a. Unaligned (BE a) => a -> Builder () {-# INLINE encodePrimBE #-} {-# SPECIALIZE INLINE encodePrimBE :: Word -> Builder () #-} {-# SPECIALIZE INLINE encodePrimBE :: Word64 -> Builder () #-}
Z/Data/Builder/Numeric.hs view
@@ -709,19 +709,19 @@ -- | Decimal encoding of a 'Double', note grisu only handles strictly positive finite numbers. grisu3 :: Double -> ([Int], Int) {-# INLINE grisu3 #-}-grisu3 d = snd . unsafePerformIO $- allocMutablePrimArrayUnsafe @Word8 GRISU3_DOUBLE_BUF_LEN $ \ pBuf -> do- (len, (e, success)) <- allocPrimUnsafe $ \ pLen ->- allocPrimUnsafe $ \ pE ->- c_grisu3 (realToFrac d) pBuf pLen pE- if success == 0 -- grisu3 fail- then pure (floatToDigits 10 d)- else do- buf <- forM [0..len-1] $ \ i -> do- w8 <- readByteArray (MutableByteArray pBuf) i :: IO Word8- pure $! fromIntegral w8- let !e' = e + len- pure (buf, e')+grisu3 d = unsafePerformIO $ do+ (MutableByteArray pBuf) <- newByteArray GRISU3_DOUBLE_BUF_LEN+ (len, (e, success)) <- allocPrimUnsafe $ \ pLen ->+ allocPrimUnsafe $ \ pE ->+ c_grisu3 (realToFrac d) pBuf pLen pE+ if success == 0 -- grisu3 fail+ then pure (floatToDigits 10 d)+ else do+ buf <- forM [0..len-1] $ \ i -> do+ w8 <- readByteArray (MutableByteArray pBuf) i :: IO Word8+ pure $! fromIntegral w8+ let !e' = e + len+ pure (buf, e') foreign import ccall unsafe "static grisu3_sp" c_grisu3_sp :: Float@@ -733,19 +733,19 @@ -- | Decimal encoding of a 'Float', note grisu3_sp only handles strictly positive finite numbers. grisu3_sp :: Float -> ([Int], Int) {-# INLINE grisu3_sp #-}-grisu3_sp d = snd . unsafePerformIO $- allocMutablePrimArrayUnsafe @Word8 GRISU3_SINGLE_BUF_LEN $ \ pBuf -> do- (len, (e, success)) <- allocPrimUnsafe $ \ pLen ->- allocPrimUnsafe $ \ pE ->- c_grisu3_sp (realToFrac d) pBuf pLen pE- if success == 0 -- grisu3 fail- then pure (floatToDigits 10 d)- else do- buf <- forM [0..len-1] $ \ i -> do- w8 <- readByteArray (MutableByteArray pBuf) i :: IO Word8- pure $! fromIntegral w8- let !e' = e + len- pure (buf, e')+grisu3_sp d = unsafePerformIO $ do+ (MutableByteArray pBuf) <- newByteArray GRISU3_SINGLE_BUF_LEN+ (len, (e, success)) <- allocPrimUnsafe $ \ pLen ->+ allocPrimUnsafe $ \ pE ->+ c_grisu3_sp (realToFrac d) pBuf pLen pE+ if success == 0 -- grisu3 fail+ then pure (floatToDigits 10 d)+ else do+ buf <- forM [0..len-1] $ \ i -> do+ w8 <- readByteArray (MutableByteArray pBuf) i :: IO Word8+ pure $! fromIntegral w8+ let !e' = e + len+ pure (buf, e') --------------------------------------------------------------------------------
Z/Data/CBytes.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PatternSynonyms #-} {-| Module : Z.Data.CBytes Description : Null-ternimated byte string.@@ -13,47 +15,24 @@ Stability : experimental Portability : non-portable -This module provide 'CBytes' with some useful instances \/ functions, A 'CBytes' is a-wrapper for immutable null-terminated string.-The main design target of this type is to ease the bridging of C FFI APIs, since most-of the unix APIs use null-terminated string. On windows you're encouraged to use a-compatibility layer like 'WideCharToMultiByte/MultiByteToWideChar' and keep the same-interface, e.g. libuv do this when deal with file paths.--We neither guarantee to store length info, nor support O(1) slice for 'CBytes':-This will defeat the purpose of null-terminated string which is to save memory,-We do save the length if it's created on GHC heap though. If you need advance editing,-convert a 'CBytes' to 'V.Bytes' with 'toBytes' and use vector combinators.-Use 'fromBytes' to convert it back.--It can be used with @OverloadedString@, literal encoding is UTF-8 with some modifications:-@\NUL@ char is encoded to 'C0 80', and '\xD800' ~ '\xDFFF' is encoded as a three bytes-normal utf-8 codepoint. This is also how ghc compile string literal into binaries,-thus we can use rewrite-rules to construct 'CBytes' value in O(1) without wasting runtime heap.--Note most of the unix API is not unicode awared though, you may find a `scandir` call-return a filename which is not proper encoded in any unicode encoding at all.-But still, UTF-8 is recommanded to be used everywhere, and we use UTF-8 assumption in-various places, such as displaying 'CBytes' and literals encoding above.+-- This module provide 'CBytes' with some useful instances \/ tools for retrieving, storing or processing+-- short byte sequences, such as file path, environment variables, etc. -} module Z.Data.CBytes- ( CBytes- , create+ ( CBytes(CB)+ , toPrimArray , pack , unpack , null , length , empty, append, concat, intercalate, intercalateElem , toBytes, fromBytes, toText, toTextMaybe, fromText- , fromCString, fromCString', fromCStringN- , withCBytes, allocCBytes- -- helpers re-export- , V.w2c, V.c2w- -- * exception- , NullPointerException(..)+ , fromCString, fromCStringN+ , withCBytesUnsafe, withCBytes, allocCBytesUnsafe, allocCBytes -- re-export , CString+ , V.c2w, V.w2c ) where import Control.DeepSeq@@ -65,12 +44,11 @@ import Data.Foldable (foldlM) import Data.Hashable (Hashable(..)) import qualified Data.List as List-import Data.String (IsString (..)) import Data.Typeable import Data.Primitive.PrimArray import Data.Word-import Foreign.C-import Foreign.Storable (peekElemOff)+import Foreign.C.String+import GHC.Exts import GHC.CString import GHC.Ptr import GHC.Stack@@ -86,84 +64,75 @@ unlines, unzip, writeFile, zip, zipWith) import Z.Data.Array+import Z.Data.Array.Unaligned import qualified Z.Data.Text as T-import Z.Data.Text.UTF8Codec (encodeCharModifiedUTF8)+import Z.Data.Text.UTF8Codec (encodeCharModifiedUTF8, decodeChar) import qualified Z.Data.Vector.Base as V+import Z.Foreign import System.IO.Unsafe (unsafeDupablePerformIO) --- | A efficient wrapper for immutable null-terminated string which can be+-- | A efficient wrapper for short immutable null-terminated byte sequences which can be -- automatically freed by ghc garbage collector. ---data CBytes- = CBytesOnHeap {-# UNPACK #-} !(PrimArray Word8) -- ^ On heap pinned 'PrimArray'- -- there's an invariance that this array's- -- length is always shrinked to contain content- -- and \NUL terminator- | CBytesLiteral {-# UNPACK #-} !CString -- ^ String literals with static address---- | Create a 'CBytes' with IO action.+-- The main use case of this type is to ease the bridging of C FFI APIs, since most+-- of the unix APIs use null-terminated string. On windows you're encouraged to use a+-- compatibility layer like 'WideCharToMultiByte/MultiByteToWideChar' and keep the same+-- interface, e.g. libuv do this when deal with file paths. --+-- 'CBytes' don't support O(1) slicing, it's not suitable to use it to store large byte+-- chunk, If you need advance editing, convert 'CBytes' to \/ from 'PrimArray' with 'CB',+-- or 'V.Bytes' with 'toBytes\/fromBytes' if you need O(1) slicing, then use vector combinators. ----- User only have to do content initialization and return the content length,--- 'create' takes the responsibility to add the @\NUL@ ternimator. If the--- initialize function write @\NUL@ terminator(most FFI functions for example),--- you should use 'allocCBytes'.+-- When textual represatation is needed(conver to 'String', 'T.Text', 'Show' instance, etc.),+-- we assume 'CBytes' using UTF-8 encodings, 'CBytes' can be used with @OverloadedString@,+-- literal encoding is UTF-8 with some modifications: @\NUL@ is encoded to 'C0 80',+-- and '\xD800' ~ '\xDFFF' is encoded as a three bytes normal utf-8 codepoint. ----- If (<=0) capacity is provided, a 'nullPtr' is passed to initialize function and--- 'empty' will be returned. other than that, if length returned is larger than (capacity-1),--- a 'NULLTerminatorNotFound' will be thrown.-create :: HasCallStack- => Int -- ^ capacity n, including the @\NUL@ terminator- -> (CString -> IO Int) -- ^ initialize function- -- write the pointer, return the length (<= n-1)- -> IO CBytes-{-# INLINE create #-}-create n fill | n <= 0 = fill nullPtr >> return empty- | otherwise = do- mba <- newPinnedPrimArray n :: IO (MutablePrimArray RealWorld Word8)- l <- withMutablePrimArrayContents mba (fill . castPtr)- when (l+1>n) (throwIO (NULLTerminatorNotFound callStack))- writePrimArray mba l 0 -- the @\NUL@ ternimator- shrinkMutablePrimArray mba (l+1)- CBytesOnHeap <$> unsafeFreezePrimArray mba+-- Note most of the unix API is not unicode awared though, you may find a `scandir` call+-- return a filename which is not proper encoded in any unicode encoding at all.+-- But still, UTF-8 is recommanded to be used when text represatation is needed.+-- --+data CBytes = CBytes+ {+ -- | Convert to 'PrimArray',+ --+ -- there's an invariance that this array never contains @\NUL@+ toPrimArray :: {-# UNPACK #-} !(PrimArray Word8)+ } --- | All exception can be throw by using 'CBytes'.-data CBytesException = NULLTerminatorNotFound CallStack- deriving (Show, Typeable)-instance Exception CBytesException+-- | Use this pattern to match or construct 'CBytes', result will be trimmed down to first byte before @\NUL@ byte if there's any.+pattern CB :: PrimArray Word8 -> CBytes+pattern CB arr <- CBytes arr where+ CB arr = fromPrimArray arr +fromPrimArray :: PrimArray Word8 -> CBytes+{-# INLINE fromPrimArray #-}+fromPrimArray arr = runST (+ case V.elemIndex 0 arr of+ Just i -> do+ mpa <- newPrimArray i+ copyPrimArray mpa 0 arr 0 i+ pa <- unsafeFreezePrimArray mpa+ return (CBytes pa)+ _ -> return (CBytes arr))+ instance Show CBytes where- show = unpack+ showsPrec p t = showsPrec p (unpack t) instance Read CBytes where readsPrec p s = [(pack x, r) | (x, r) <- readsPrec p s] instance NFData CBytes where {-# INLINE rnf #-}- rnf (CBytesOnHeap _) = ()- rnf (CBytesLiteral _) = ()+ rnf (CBytes _) = () instance Eq CBytes where {-# INLINE (==) #-}- cbyteA == cbyteB = unsafeDupablePerformIO $- withCBytes cbyteA $ \ pA ->- withCBytes cbyteB $ \ pB ->- if pA == pB- then return True- else do- r <- c_strcmp pA pB- return (r == 0)+ CBytes ba == CBytes bb = ba == bb instance Ord CBytes where {-# INLINE compare #-}- cbyteA `compare` cbyteB = unsafeDupablePerformIO $- withCBytes cbyteA $ \ pA ->- withCBytes cbyteB $ \ pB ->- if pA == pB- then return EQ- else do- r <- c_strcmp pA pB- return (r `compare` 0)+ CBytes ba `compare` CBytes bb = ba `compare` bb instance Semigroup CBytes where (<>) = append@@ -177,36 +146,60 @@ mconcat = concat instance Hashable CBytes where- hashWithSalt salt (CBytesOnHeap pa@(PrimArray ba#)) = unsafeDupablePerformIO $ do- V.c_fnv_hash_ba ba# 0 (sizeofPrimArray pa - 1) salt- hashWithSalt salt (CBytesLiteral p@(Ptr addr#)) = unsafeDupablePerformIO $ do- len <- c_strlen p- V.c_fnv_hash_addr addr# (fromIntegral len) salt+ hashWithSalt salt (CBytes pa@(PrimArray ba#)) = unsafeDupablePerformIO $ do+ V.c_fnv_hash_ba ba# 0 (sizeofPrimArray pa) salt +-- | This instance peek bytes until @\NUL@(or input chunk ends), poke bytes with an extra \NUL terminator.+instance Unaligned CBytes where+ {-# INLINE unalignedSize #-}+ unalignedSize (CBytes arr) = sizeofPrimArray arr + 1+ {-# INLINE peekMBA #-}+ peekMBA mba# i = do+ b <- getSizeofMutableByteArray (MutableByteArray mba#)+ let rest = b-i+ l <- c_memchr mba# i 0 rest+ let l' = if l == -1 then rest else l+ mpa <- newPrimArray l'+ copyMutablePrimArray mpa 0 (MutablePrimArray mba#) i l'+ pa <- unsafeFreezePrimArray mpa+ return (CBytes pa)++ {-# INLINE pokeMBA #-}+ pokeMBA mba# i (CBytes pa) = do+ let l = sizeofPrimArray pa+ copyPrimArray (MutablePrimArray mba# :: MutablePrimArray RealWorld Word8) i pa 0 l+ writePrimArray (MutablePrimArray mba# :: MutablePrimArray RealWorld Word8) (i+l) 0++ {-# INLINE indexBA #-}+ indexBA ba# i = runST (do+ let b = sizeofByteArray (ByteArray ba#)+ rest = b-i+ l = V.c_memchr ba# i 0 rest+ l' = if l == -1 then rest else l+ mpa <- newPrimArray l'+ copyPrimArray mpa 0 (PrimArray ba#) i l'+ pa <- unsafeFreezePrimArray mpa+ return (CBytes pa))+ append :: CBytes -> CBytes -> CBytes {-# INLINABLE append #-}-append strA strB+append strA@(CBytes pa) strB@(CBytes pb) | lenA == 0 = strB | lenB == 0 = strA | otherwise = unsafeDupablePerformIO $ do- mpa <- newPinnedPrimArray (lenA+lenB+1)- withCBytes strA $ \ pa ->- withCBytes strB $ \ pb -> do- copyPtrToMutablePrimArray mpa 0 (castPtr pa) lenA- copyPtrToMutablePrimArray mpa lenA (castPtr pb) lenB- writePrimArray mpa (lenA + lenB) 0 -- the \NUL terminator- pa' <- unsafeFreezePrimArray mpa- return (CBytesOnHeap pa')+ mpa <- newPrimArray (lenA+lenB)+ copyPrimArray mpa 0 pa 0 lenA+ copyPrimArray mpa lenA pb 0 lenB+ pa' <- unsafeFreezePrimArray mpa+ return (CBytes pa') where lenA = length strA lenB = length strB --- | 'empty' 'CBytes'------ Passing 'empty' to C FFI is equivalent to passing a @NULL@ pointer.+-- | An empty 'CBytes' empty :: CBytes {-# NOINLINE empty #-}-empty = CBytesLiteral (Ptr "\0"#)+empty = CBytes (V.empty) concat :: [CBytes] -> CBytes {-# INLINABLE concat #-}@@ -214,10 +207,9 @@ (0, _) -> empty (1, _) -> let Just b = List.find (not . null) bss in b -- there must be a not empty CBytes (_, l) -> runST $ do- buf <- newPinnedPrimArray (l+1)+ buf <- newPrimArray l copy bss 0 buf- writePrimArray buf l 0 -- the \NUL terminator- CBytesOnHeap <$> unsafeFreezePrimArray buf+ CBytes <$> unsafeFreezePrimArray buf where -- pre scan to decide if we really need to copy and calculate total length -- we don't accumulate another result list, since it's rare to got empty@@ -230,13 +222,9 @@ copy :: [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s () copy [] !_ !_ = return ()- copy (b:bs) !i !mba = do+ copy (b@(CBytes ba):bs) !i !mba = do let l = length b- when (l /= 0) (case b of- CBytesOnHeap ba ->- copyPrimArray mba i ba 0 l- CBytesLiteral p ->- copyPtrToMutablePrimArray mba i (castPtr p) l)+ when (l /= 0) (copyPrimArray mba i ba 0 l) copy bs (i+l) mba -- | /O(n)/ The 'intercalate' function takes a 'CBytes' and a list of@@ -249,31 +237,28 @@ {-# INLINE intercalate #-} intercalate s = concat . List.intersperse s - -- | /O(n)/ An efficient way to join 'CByte' s with a byte. --+-- Intercalate bytes list with @\NUL@ will effectively leave the first bytes in the list. intercalateElem :: Word8 -> [CBytes] -> CBytes {-# INLINABLE intercalateElem #-}+intercalateElem 0 [] = empty+intercalateElem 0 (bs:_) = bs intercalateElem w8 bss = case len bss 0 of 0 -> empty l -> runST $ do- buf <- newPinnedPrimArray (l+1)+ buf <- newPrimArray l copy bss 0 buf- writePrimArray buf l 0 -- the \NUL terminator- CBytesOnHeap <$> unsafeFreezePrimArray buf+ CBytes <$> unsafeFreezePrimArray buf where len [] !acc = acc len [b] !acc = length b + acc len (b:bs) !acc = len bs (acc + length b + 1) copy :: [CBytes] -> Int -> MutablePrimArray s Word8 -> ST s () -- bss must not be empty, which is checked by len above- copy (b:bs) !i !mba = do+ copy (b@(CBytes ba):bs) !i !mba = do let l = length b- when (l /= 0) (case b of- CBytesOnHeap ba ->- copyPrimArray mba i ba 0 l- CBytesLiteral p ->- copyPtrToMutablePrimArray mba i (castPtr p) l)+ when (l /= 0) (copyPrimArray mba i ba 0 l) case bs of [] -> return () -- last one _ -> do@@ -287,32 +272,41 @@ {-# RULES "CBytes pack/unpackCString#" forall addr# .- pack (unpackCString# addr#) = CBytesLiteral (Ptr addr#)+ pack (unpackCString# addr#) = packAddr addr# #-} {-# RULES "CBytes pack/unpackCStringUtf8#" forall addr# .- pack (unpackCStringUtf8# addr#) = CBytesLiteral (Ptr addr#)+ pack (unpackCStringUtf8# addr#) = packAddr addr# #-} --- | Pack a 'String' into null-terminated 'CBytes'.+packAddr :: Addr# -> CBytes+packAddr addr0# = go addr0#+ where+ len = (fromIntegral . unsafeDupablePerformIO $ V.c_strlen addr0#)+ go addr# = runST $ do+ marr <- newPrimArray len+ copyPtrToMutablePrimArray marr 0 (Ptr addr#) len+ arr <- unsafeFreezePrimArray marr+ return (CBytes arr)++-- | Pack a 'String' into 'CBytes'. -- -- @\NUL@ is encoded as two bytes @C0 80@ , '\xD800' ~ '\xDFFF' is encoded as a three bytes normal UTF-8 codepoint. pack :: String -> CBytes {-# INLINE CONLIKE [1] pack #-} pack s = runST $ do- mba <- newPinnedPrimArray V.defaultInitSize+ mba <- newPrimArray V.defaultInitSize (SP2 i mba') <- foldlM go (SP2 0 mba) s- writePrimArray mba' i 0 -- the \NUL terminator- shrinkMutablePrimArray mba' (i+1)+ shrinkMutablePrimArray mba' i ba <- unsafeFreezePrimArray mba'- return (CBytesOnHeap ba)+ return (CBytes ba) where -- It's critical that this function get specialized and unboxed -- Keep an eye on its core! go :: SP2 s -> Char -> ST s (SP2 s) go (SP2 i mba) !c = do siz <- getSizeofMutablePrimArray mba- if i < siz - 4 -- we need at least 5 bytes for safety due to extra '\0' byte+ if i < siz - 3 -- we need at least 4 bytes for safety then do i' <- encodeCharModifiedUTF8 mba i c return (SP2 i' mba)@@ -325,47 +319,74 @@ data SP2 s = SP2 {-# UNPACK #-}!Int {-# UNPACK #-}!(MutablePrimArray s Word8) +-- | /O(n)/ Convert cbytes to a char list using UTF8 encoding assumption.+--+-- This function is much tolerant than 'toText', it simply decoding codepoints using UTF8 'decodeChar'+-- without checking errors such as overlong or invalid range.+--+-- Unpacking is done lazily. i.e. we will retain reference to the array until all element are consumed.+--+-- This function is a /good producer/ in the sense of build/foldr fusion. unpack :: CBytes -> String-{-# INLINABLE unpack #-}--- TODO: rewrite with our own decoder-unpack cbytes = unsafeDupablePerformIO . withCBytes cbytes $ \ (Ptr addr#) ->- return (unpackCStringUtf8# addr#)+{-# INLINE [1] unpack #-}+unpack (CBytes arr) = go 0+ where+ !end = sizeofPrimArray arr+ go !idx+ | idx >= end = []+ | otherwise = let (# c, i #) = decodeChar arr idx in c : go (idx + i) +unpackFB :: CBytes -> (Char -> a -> a) -> a -> a+{-# INLINE [0] unpackFB #-}+unpackFB (CBytes arr) k z = go 0+ where+ !end = sizeofPrimArray arr+ go !idx+ | idx >= end = z+ | otherwise = let (# c, i #) = decodeChar arr idx in c `k` go (idx + i)++{-# RULES+"unpack" [~1] forall t . unpack t = build (\ k z -> unpackFB t k z)+"unpackFB" [1] forall t . unpackFB t (:) [] = unpack t+ #-}+ -------------------------------------------------------------------------------- +-- | Return 'True' if 'CBytes' is empty.+-- null :: CBytes -> Bool {-# INLINE null #-}-null (CBytesOnHeap pa) = indexPrimArray pa 0 == 0-null (CBytesLiteral p) = unsafeDupablePerformIO (peekElemOff p 0) == 0+null (CBytes pa) = sizeofPrimArray pa == 0 +-- | Return the BTYE length of 'CBytes'.+-- length :: CBytes -> Int {-# INLINE length #-}-length (CBytesOnHeap pa) = sizeofPrimArray pa - 1-length (CBytesLiteral p) = fromIntegral $ unsafeDupablePerformIO (c_strlen p)+length (CBytes pa) = sizeofPrimArray pa --- | /O(1)/, (/O(n)/ in case of literal), convert to 'V.Bytes', which can be--- processed by vector combinators.------ NOTE: the @\NUL@ ternimator is not included.+-- | /O(1)/, convert to 'V.Bytes', which can be processed by vector combinators. toBytes :: CBytes -> V.Bytes {-# INLINABLE toBytes #-}-toBytes cbytes@(CBytesOnHeap pa) = V.PrimVector pa 0 l- where l = length cbytes-toBytes cbytes@(CBytesLiteral p) = V.create (l+1) (\ mpa -> do- copyPtrToMutablePrimArray mpa 0 (castPtr p) l- writePrimArray mpa l 0) -- the \NUL terminator- where l = length cbytes+toBytes (CBytes arr) = V.PrimVector arr 0 (sizeofPrimArray arr) --- | /O(n)/, convert from 'V.Bytes', allocate pinned memory and--- add the @\NUL@ ternimator+-- | /O(n)/, convert from 'V.Bytes'+--+-- Result will be trimmed down to first byte before @\NUL@ byte if there's any. fromBytes :: V.Bytes -> CBytes {-# INLINABLE fromBytes #-}-fromBytes (V.Vec arr s l) = runST (do- mpa <- newPinnedPrimArray (l+1)- copyPrimArray mpa 0 arr s l- writePrimArray mpa l 0 -- the \NUL terminator- pa <- unsafeFreezePrimArray mpa- return (CBytesOnHeap pa))+fromBytes v@(V.PrimVector arr s l) = runST (do+ case V.elemIndex 0 v of+ Just i -> do+ mpa <- newPrimArray i+ copyPrimArray mpa 0 arr s i+ pa <- unsafeFreezePrimArray mpa+ return (CBytes pa)+ _ | s == 0 && sizeofPrimArray arr == l -> return (CBytes arr)+ | otherwise -> do+ mpa <- newPrimArray l+ copyPrimArray mpa 0 arr s l+ pa <- unsafeFreezePrimArray mpa+ return (CBytes pa)) -- | /O(n)/, convert to 'T.Text' using UTF8 encoding assumption. --@@ -381,15 +402,15 @@ {-# INLINABLE toTextMaybe #-} toTextMaybe = T.validateMaybe . toBytes --- | /O(n)/, convert from 'T.Text', allocate pinned memory and--- add the @\NUL@ ternimator+-- | /O(n)/, convert from 'T.Text',+--+-- Result will be trimmed down to first byte before @\NUL@ byte if there's any. fromText :: T.Text -> CBytes {-# INLINABLE fromText #-} fromText = fromBytes . T.getUTF8Bytes -------------------------------------------------------------------------------- - -- | Copy a 'CString' type into a 'CBytes', return 'empty' if the pointer is NULL. -- -- After copying you're free to free the 'CString' 's memory.@@ -399,79 +420,101 @@ if cstring == nullPtr then return empty else do- len <- fromIntegral <$> c_strlen cstring- mpa <- newPinnedPrimArray (len+1)+ len <- fromIntegral <$> c_strlen_ptr cstring+ mpa <- newPrimArray len copyPtrToMutablePrimArray mpa 0 (castPtr cstring) len- writePrimArray mpa len 0 -- the \NUL terminator pa <- unsafeFreezePrimArray mpa- return (CBytesOnHeap pa)---- | Same with 'fromCString', but throw 'NullPointerException' when meet a null pointer.----fromCString' :: HasCallStack => CString -> IO (Maybe CBytes)-{-# INLINABLE fromCString' #-}-fromCString' cstring =- if cstring == nullPtr- then throwIO (NullPointerException callStack)- else do- len <- fromIntegral <$> c_strlen cstring- mpa <- newPinnedPrimArray (len+1)- copyPtrToMutablePrimArray mpa 0 (castPtr cstring) len- writePrimArray mpa len 0 -- the \NUL terminator- pa <- unsafeFreezePrimArray mpa- return (Just (CBytesOnHeap pa))+ return (CBytes pa) --- | Same with 'fromCString', but only take N bytes (and append a null byte as terminator).+-- | Same with 'fromCString', but only take at most N bytes. --+-- Result will be trimmed down to first byte before @\NUL@ byte if there's any. fromCStringN :: CString -> Int -> IO CBytes {-# INLINABLE fromCStringN #-}-fromCStringN cstring len = do- if cstring == nullPtr || len == 0+fromCStringN cstring len0 = do+ if cstring == nullPtr || len0 == 0 then return empty else do- mpa <- newPinnedPrimArray (len+1)+ len1 <- fromIntegral <$> c_strlen_ptr cstring+ let len = min len0 len1+ mpa <- newPrimArray len copyPtrToMutablePrimArray mpa 0 (castPtr cstring) len- writePrimArray mpa len 0 -- the \NUL terminator pa <- unsafeFreezePrimArray mpa- return (CBytesOnHeap pa)+ return (CBytes pa) -data NullPointerException = NullPointerException CallStack deriving (Show, Typeable)-instance Exception NullPointerException+-- | Pass 'CBytes' to foreign function as a @const char*@.+--+-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.+withCBytesUnsafe :: CBytes -> (BA# Word8 -> IO a) -> IO a+{-# INLINABLE withCBytesUnsafe #-}+withCBytesUnsafe (CBytes pa) f = do+ let l = sizeofPrimArray pa+ mpa <- newPrimArray (l+1)+ copyPrimArray mpa 0 pa 0 l+ writePrimArray mpa l 0+ pa' <- unsafeFreezePrimArray mpa+ withPrimArrayUnsafe pa' (\ p _ -> f p) -- | Pass 'CBytes' to foreign function as a @const char*@. -- -- Don't pass a forever loop to this function, see <https://ghc.haskell.org/trac/ghc/ticket/14346 #14346>.-withCBytes :: CBytes -> (CString -> IO a) -> IO a+withCBytes :: CBytes -> (Ptr Word8 -> IO a) -> IO a {-# INLINABLE withCBytes #-}-withCBytes (CBytesOnHeap pa) f = withPrimArrayContents pa (f . castPtr)-withCBytes (CBytesLiteral ptr) f = f ptr+withCBytes (CBytes pa) f = do+ let l = sizeofPrimArray pa+ mpa <- newPinnedPrimArray (l+1)+ copyPrimArray mpa 0 pa 0 l+ writePrimArray mpa l 0+ pa' <- unsafeFreezePrimArray mpa+ withPrimArraySafe pa' (\ p _ -> f p) -- | Create a 'CBytes' with IO action. --+-- If (<=0) capacity is provided, a pointer pointing to @\NUL@ is passed to initialize function+-- and 'empty' will be returned. This behavior is different from 'allocCBytes', which may cause+-- trouble for some FFI functions.+--+-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.+allocCBytesUnsafe :: HasCallStack+ => Int -- ^ capacity n(include the @\NUL@ terminator)+ -> (MBA# Word8 -> IO a) -- ^ initialization function,+ -> IO (CBytes, a)+{-# INLINABLE allocCBytesUnsafe #-}+allocCBytesUnsafe n fill | n <= 0 = withPrimUnsafe (0::Word8) fill >>=+ \ (_, b) -> return (empty, b)+ | otherwise = do+ mba@(MutablePrimArray mba#) <- newPrimArray n :: IO (MutablePrimArray RealWorld Word8)+ a <- fill mba#+ l <- fromIntegral <$> (c_memchr mba# 0 0 n)+ shrinkMutablePrimArray mba (if l == -1 then n else l)+ bs <- unsafeFreezePrimArray mba+ return (CBytes bs, a)+++-- | Create a 'CBytes' with IO action.+-- -- If (<=0) capacity is provided, a 'nullPtr' is passed to initialize function and -- 'empty' will be returned. Other than that, User have to make sure a @\NUL@ ternimated--- string will be written, otherwise a 'NULLTerminatorNotFound' will be thrown.+-- string will be written. allocCBytes :: HasCallStack- => Int -- ^ capacity n, including the @\NUL@ terminator- -> (CString -> IO a) -- ^ initialization function,- -> IO (CBytes, a)+ => Int -- ^ capacity n(include the @\NUL@ terminator)+ -> (CString -> IO a) -- ^ initialization function,+ -> IO (CBytes, a) {-# INLINABLE allocCBytes #-} allocCBytes n fill | n <= 0 = fill nullPtr >>= \ a -> return (empty, a) | otherwise = do- mba <- newPinnedPrimArray n :: IO (MutablePrimArray RealWorld Word8)+ mba@(MutablePrimArray mba#) <- newPinnedPrimArray n :: IO (MutablePrimArray RealWorld Word8) a <- withMutablePrimArrayContents mba (fill . castPtr)- l <- fromIntegral <$> withMutablePrimArrayContents mba (c_strlen . castPtr)- when (l+1>n) (throwIO (NULLTerminatorNotFound callStack))- shrinkMutablePrimArray mba (l+1)+ l <- fromIntegral <$> (c_memchr mba# 0 0 n)+ shrinkMutablePrimArray mba (if l == -1 then n else l) bs <- unsafeFreezePrimArray mba- return (CBytesOnHeap bs, a)+ return (CBytes bs, a) -------------------------------------------------------------------------------- -c_strcmp :: CString -> CString -> IO CInt-{-# INLINE c_strcmp #-}-c_strcmp (Ptr a#) (Ptr b#) = V.c_strcmp a# b#+c_strlen_ptr :: CString -> IO CSize+{-# INLINE c_strlen_ptr #-}+c_strlen_ptr (Ptr a#) = V.c_strlen a# -c_strlen :: CString -> IO CSize-{-# INLINE c_strlen #-}-c_strlen (Ptr a#) = V.c_strlen a#+-- HsInt hs_memchr(uint8_t *a, HsInt aoff, uint8_t b, HsInt n);+foreign import ccall unsafe "hs_memchr" c_memchr :: MBA# Word8 -> Int -> Word8 -> Int -> IO Int
Z/Data/Parser/Base.hs view
@@ -52,7 +52,7 @@ import Data.Word import GHC.Types import Prelude hiding (take, takeWhile)-import Z.Data.Array.UnalignedAccess+import Z.Data.Array.Unaligned import qualified Z.Data.Text.Base as T import qualified Z.Data.Vector.Base as V import qualified Z.Data.Vector.Extra as V@@ -279,7 +279,7 @@ then Partial (\ inp' -> k (V.null inp') inp') else k False inp -decodePrim :: forall a. (UnalignedAccess a) => Parser a+decodePrim :: forall a. (Unaligned a) => Parser a {-# INLINE decodePrim #-} {-# SPECIALIZE INLINE decodePrim :: Parser Word #-} {-# SPECIALIZE INLINE decodePrim :: Parser Word64 #-}@@ -297,9 +297,9 @@ let !r = indexPrimWord8ArrayAs ba i in k r (V.PrimVector ba (i+n) (len-n))) where- n = getUnalignedSize (unalignedSize :: UnalignedSize a)+ n = unalignedSize (undefined :: a) -decodePrimLE :: forall a. (UnalignedAccess (LE a)) => Parser a+decodePrimLE :: forall a. (Unaligned (LE a)) => Parser a {-# INLINE decodePrimLE #-} {-# SPECIALIZE INLINE decodePrimLE :: Parser Word #-} {-# SPECIALIZE INLINE decodePrimLE :: Parser Word64 #-}@@ -315,9 +315,9 @@ let !r = indexPrimWord8ArrayAs ba i in k (getLE r) (V.PrimVector ba (i+n) (len-n))) where- n = getUnalignedSize (unalignedSize :: UnalignedSize (LE a))+ n = unalignedSize (undefined :: (LE a)) -decodePrimBE :: forall a. (UnalignedAccess (BE a)) => Parser a+decodePrimBE :: forall a. (Unaligned (BE a)) => Parser a {-# INLINE decodePrimBE #-} {-# SPECIALIZE INLINE decodePrimBE :: Parser Word #-} {-# SPECIALIZE INLINE decodePrimBE :: Parser Word64 #-}@@ -333,7 +333,7 @@ let !r = indexPrimWord8ArrayAs ba i in k (getBE r) (V.PrimVector ba (i+n) (len-n))) where- n = getUnalignedSize (unalignedSize :: UnalignedSize (BE a))+ n = unalignedSize (undefined :: (BE a)) -- | A stateful scanner. The predicate consumes and transforms a -- state argument, and each transformed state is passed to successive
Z/Data/Text.hs view
@@ -51,6 +51,7 @@ , uncons, unsnoc , headMaybe, tailMayEmpty , lastMaybe, initMayEmpty+ , head, tail, last, init , inits, tails , take, drop, takeR, dropR , slice
Z/Data/Text/Base.hs view
@@ -26,7 +26,6 @@ -- * Building text , validate, validateASCII , validateMaybe, validateASCIIMaybe- , TextException(..) , index, indexMaybe, charByteIndex, indexR, indexMaybeR, charByteIndexR -- * Basic creating , empty, singleton, copy@@ -115,6 +114,7 @@ , CategoryIsdigit , CategoryIsxdigit) -- * Misc+ , TextException(..), errorEmptyText , c_utf8_validate_ba , c_utf8_validate_addr , c_ascii_validate_ba@@ -323,8 +323,13 @@ data TextException = InvalidUTF8Exception CallStack | InvalidASCIIException CallStack | IndexOutOfTextRange Int CallStack -- ^ first payload is invalid char index+ | EmptyText CallStack deriving (Show, Typeable) instance Exception TextException++errorEmptyText :: HasCallStack => a+{-# INLINE errorEmptyText #-}+errorEmptyText = throw (EmptyText callStack) --------------------------------------------------------------------------------
Z/Data/Text/Extra.hs view
@@ -22,8 +22,8 @@ -- * Slice manipulation cons, snoc , uncons, unsnoc- , headMaybe, tailMayEmpty- , lastMaybe, initMayEmpty+ , headMaybe, tailMayEmpty, lastMaybe, initMayEmpty+ , head, tail, last, init , inits, tails , take, drop, takeR, dropR , slice@@ -63,6 +63,7 @@ foldl, foldl1, foldr, foldr1, maximum, minimum, product, sum, all, any, replicate, traverse,+ head, tail, init, last, take, drop, splitAt, takeWhile, dropWhile, break, span, reverse,@@ -107,6 +108,34 @@ | otherwise = let (# c, i #) = decodeCharReverse ba (s + l - 1) in Just (Text (V.PrimVector ba s (l-i)), c)++-- | /O(1)/ Extract the first char of a text.+--+-- Throw 'EmptyText' if text is empty.+head :: Text -> Char+{-# INLINABLE head #-}+head t = case uncons t of { Just (c, _) -> c; _ -> errorEmptyText }++-- | /O(1)/ Extract the chars after the head of a text.+--+-- Throw 'EmptyText' if text is empty.+tail :: Text -> Text+{-# INLINABLE tail #-}+tail t = case uncons t of { Nothing -> errorEmptyText; Just (_, t') -> t' }++-- | /O(1)/ Extract the last char of a text.+--+-- Throw 'EmptyText' if text is empty.+last :: Text -> Char+{-# INLINABLE last #-}+last t = case unsnoc t of { Just (_, c) -> c; _ -> errorEmptyText }++-- | /O(1)/ Extract the chars before of the last one.+--+-- Throw 'EmptyText' if text is empty.+init :: Text -> Text+{-# INLINABLE init #-}+init t = case unsnoc t of { Just (t', _) -> t'; _ -> errorEmptyText } -- | /O(1)/ Extract the first char of a text. headMaybe :: Text -> Maybe Char
Z/Data/Vector.hs view
@@ -117,6 +117,7 @@ , uncons, unsnoc , headMaybe, tailMayEmpty , lastMaybe, initMayEmpty+ , head, tail, last, init , inits, tails , take, drop, takeR, dropR , slice
Z/Data/Vector/Base.hs view
@@ -1315,11 +1315,11 @@ instance Exception VectorException errorEmptyVector :: HasCallStack => a-{-# NOINLINE errorEmptyVector #-}+{-# INLINE errorEmptyVector #-} errorEmptyVector = throw (EmptyVector callStack) errorOutRange :: HasCallStack => Int -> a-{-# NOINLINE errorOutRange #-}+{-# INLINE errorOutRange #-} errorOutRange i = throw (IndexOutOfVectorRange i callStack) -- | Cast between vectors
Z/Foreign.hs view
@@ -61,7 +61,6 @@ ( -- ** Unsafe FFI withPrimArrayUnsafe , allocPrimArrayUnsafe- , allocMutablePrimArrayUnsafe , withPrimVectorUnsafe , allocPrimVectorUnsafe , allocBytesUnsafe@@ -70,7 +69,6 @@ -- ** Safe FFI , withPrimArraySafe , allocPrimArraySafe- , allocMutablePrimArraySafe , withPrimVectorSafe , allocPrimVectorSafe , allocBytesSafe@@ -86,9 +84,10 @@ , fromNullTerminated, fromPtr, fromPrimPtr -- ** re-export , module Data.Primitive.ByteArray+ , module Data.Primitive.PrimArray , module Foreign.C.Types , module Data.Primitive.Ptr- , module Z.Data.Array.UnalignedAccess+ , module Z.Data.Array.Unaligned ) where import Control.Monad.Primitive@@ -96,36 +95,36 @@ import Data.Word import Data.Primitive.Ptr import Data.Primitive.ByteArray+import Data.Primitive.PrimArray import Foreign.C.Types import GHC.Ptr import Z.Data.Array-import Z.Data.Array.UnalignedAccess+import Z.Data.Array.Unaligned import Z.Data.Vector.Base -- | Type alias for 'ByteArray#'. ----- Since we can't newtype an unlifted type yet, type alias is the best we can get--- to describe a 'ByteArray#' which we are going to pass across FFI. At C side you--- should use a proper const pointer type.+-- Describe a 'ByteArray#' which we are going to pass across FFI. Use this type with @UnliftedFFITypes@+-- extension, At C side you should use a proper const pointer type. -- -- Don't cast 'BA#' to 'Addr#' since the heap object offset is hard-coded in code generator: -- <https://github.com/ghc/ghc/blob/master/compiler/codeGen/StgCmmForeign.hs#L520> ----- USE THIS TYPE WITH UNSAFE FFI CALL ONLY.--- A 'ByteArray#' COULD BE MOVED BY GC DURING SAFE FFI CALL.+-- In haskell side we use type system to distinguish immutable / mutable arrays, but in C side we can't.+-- So it's users' responsibility to make sure the array content is not mutated (a const pointer type may help).+--+-- USE THIS TYPE WITH UNSAFE FFI CALL ONLY. A 'ByteArray#' COULD BE MOVED BY GC DURING SAFE FFI CALL. type BA# a = ByteArray# -- | Type alias for 'MutableByteArray#' 'RealWorld'. ----- Since we can't newtype an unlifted type yet, type alias is the best we can get--- to describe a 'MutableByteArray#' which we are going to pass across FFI. At C side you--- should use a proper pointer type.+-- Describe a 'MutableByteArray#' which we are going to pass across FFI. Use this type with @UnliftedFFITypes@+-- extension, At C side you should use a proper pointer type. -- -- Don't cast 'MBA#' to 'Addr#' since the heap object offset is hard-coded in code generator:--- <https://github.com/ghc/ghc/blob/master/compiler/codeGen/StgCmmForeign.hs#L520>+-- <https://github.com/ghc/ghc/blob/master/compiler/GHC/StgToCmm/Foreign.hs#L542 Note [Unlifted boxed arguments to foreign calls]> ----- USE THIS TYPE WITH UNSAFE FFI CALL ONLY.--- A 'MutableByteArray#' COULD BE MOVED BY GC DURING SAFE FFI CALL.+-- USE THIS TYPE WITH UNSAFE FFI CALL ONLY. A 'MutableByteArray#' COULD BE MOVED BY GC DURING SAFE FFI CALL. type MBA# a = MutableByteArray# RealWorld -- | Clear 'MBA#' with given length to zero.@@ -143,14 +142,7 @@ -- -- The second 'Int' arguement is the element size not the bytes size. ----- Don't cast 'ByteArray#' to 'Addr#' since the heap object offset is hard-coded in code generator:--- <https://github.com/ghc/ghc/blob/master/compiler/codeGen/StgCmmForeign.hs#L520>------ In haskell side we use type system to distinguish immutable / mutable arrays, but in C side we can't.--- So it's users' responsibility to make sure the array content is not mutated (a const pointer type may help).--- -- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.--- withPrimArrayUnsafe :: (Prim a) => PrimArray a -> (BA# a -> Int -> IO b) -> IO b {-# INLINE withPrimArrayUnsafe #-} withPrimArrayUnsafe pa@(PrimArray ba#) f = f ba# (sizeofPrimArray pa)@@ -166,38 +158,19 @@ !pa <- unsafeFreezePrimArray mpa return (pa, r) ---- | Allocate some bytes and pass to FFI as pointer.------ This function allocate some unpinned bytes and pass to FFI as MBA#, you should prefer--- use this function (together with 'UalignedAccess') if no safe FFI is needed, since--- this unpinned byte array can be easily collected.------ example usage with hsc2hs:------ @--- allocMutablePrimArrayUnsafe @Word8 (#size c_struct) $ \ p -> do------ pokeMBA p (#offset c_struct c_field1) field1--- pokeMBA p (#offset c_struct c_field2) field2+-- | Pass 'PrimVector' to unsafe FFI as pointer ----- c_ffi p ....+-- The 'PrimVector' version of 'withPrimArrayUnsafe'. ----- field1' <- peekMBA p (#offset c_struct c_field1)--- field2' <- peekMBA p (#offset c_struct c_field2)--- ...--- return (CStruct field1' field2')--- @+-- The second 'Int' arguement is the first element offset, the third 'Int' argument is the+-- element length. -- -- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.-allocMutablePrimArrayUnsafe :: forall a b . Prim a- => Int -- ^ number of elements- -> (MBA# a -> IO b) -> IO (MutablePrimArray RealWorld a, b)-{-# INLINE allocMutablePrimArrayUnsafe #-}-allocMutablePrimArrayUnsafe len f = do- mba@(MutablePrimArray mba# :: MutablePrimArray RealWorld a) <- newPrimArray len- r <- f mba#- return (mba, r)+--+withPrimVectorUnsafe :: (Prim a)+ => PrimVector a -> (BA# a -> Int -> Int -> IO b) -> IO b+{-# INLINE withPrimVectorUnsafe #-}+withPrimVectorUnsafe (PrimVector arr s l) f = withPrimArrayUnsafe arr $ \ ba# _ -> f ba# s l -- | Allocate a prim array and pass to FFI as pointer, freeze result into a 'PrimVector'. --@@ -221,21 +194,7 @@ allocBytesUnsafe = allocPrimVectorUnsafe --- | Pass 'PrimVector' to unsafe FFI as pointer------ The 'PrimVector' version of 'withPrimArrayUnsafe'.------ The second 'Int' arguement is the first element offset, the third 'Int' argument is the--- element length.------ USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.----withPrimVectorUnsafe :: (Prim a)- => PrimVector a -> (BA# a -> Int -> Int -> IO b) -> IO b-{-# INLINE withPrimVectorUnsafe #-}-withPrimVectorUnsafe (PrimVector arr s l) f = withPrimArrayUnsafe arr $ \ ba# _ -> f ba# s l - -- | Create an one element primitive array and use it as a pointer to the primitive element. -- -- Return the element and the computation result.@@ -285,7 +244,7 @@ copyPrimArray buf 0 arr 0 siz withMutablePrimArrayContents buf $ \ ptr -> f ptr siz --- | Allocate some bytes and pass to FFI as pointer, freeze result into a 'PrimVector'.+-- | Allocate a prim array and pass to FFI as pointer, freeze result into a 'PrimVector'. allocPrimArraySafe :: forall a b . Prim a => Int -- ^ in elements -> (Ptr a -> IO b)@@ -297,16 +256,6 @@ !pa <- unsafeFreezePrimArray mpa return (pa, r) --- | Allocate a primitive array and pass to FFI as pointer.------ After call returned, pointer is no longer valid.-allocMutablePrimArraySafe :: (Prim a) => Int -- ^ in number of elements not bytes- -> (Ptr a -> IO b) -> IO b-{-# INLINE allocMutablePrimArraySafe #-}-allocMutablePrimArraySafe siz f = do- buf <- newPinnedPrimArray siz- withMutablePrimArrayContents buf f- -- | Pass 'PrimVector' to safe FFI as pointer -- -- The 'PrimVector' version of 'withPrimArraySafe'. The 'Ptr' is already pointed@@ -401,9 +350,11 @@ {-# INLINE clearPtr #-} clearPtr dest nbytes = memset dest 0 (fromIntegral nbytes) --- | Copy some bytes from a null terminated pointer(without copy the null terminator).+-- | Copy some bytes from a null terminated pointer(without copying the null terminator). ----- There's no encoding guarantee, result could be any bytes sequence.+-- You should consider using 'Z.Data.CBytes' type for storing NULL terminated bytes first,+-- This method is provided if you really need to read 'Bytes', there's no encoding guarantee,+-- result could be any bytes sequence. fromNullTerminated :: Ptr a -> IO Bytes {-# INLINE fromNullTerminated #-} fromNullTerminated (Ptr addr#) = do
− test/Z/Data/Array/UnalignedAccessSpec.hs
@@ -1,294 +0,0 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Z.Data.Array.UnalignedAccessSpec where--import qualified Data.List as L-import Data.Int-import GHC.Float-import Data.Word-import Z.Data.Array.UnalignedAccess-import Control.Monad.Primitive-import Data.Primitive.ByteArray-import Test.QuickCheck-import Test.QuickCheck.Function-import Test.QuickCheck.Property-import Test.Hspec-import Test.Hspec.QuickCheck--spec :: Spec-spec = describe "unaligned acess" . modifyMaxSuccess (*10) . modifyMaxSize (*10) $ do- prop "roundtrip Word8" $ \ (w::Word8) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# w)- w' <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let w'' = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip Word16" $ \ (w::Word16) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# w)- w' <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let w'' = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip Word32" $ \ (w::Word32) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# w)- w' <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let w'' = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip Word64" $ \ (w::Word64) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# w)- w' <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let w'' = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip Word" $ \ (w::Word) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# w)- w' <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let w'' = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip LE Word16" $ \ (w::Word16) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (LE w))- (LE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (LE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip LE Word32" $ \ (w::Word32) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (LE w))- (LE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (LE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip LE Word64" $ \ (w::Word64) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (LE w))- (LE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (LE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip LE Word" $ \ (w::Word) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (LE w))- (LE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (LE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip BE Word16" $ \ (w::Word16) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (BE w))- (BE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (BE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip BE Word32" $ \ (w::Word32) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (BE w))- (BE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (BE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip BE Word64" $ \ (w::Word64) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (BE w))- (BE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (BE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip BE Word" $ \ (w::Word) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (BE w))- (BE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (BE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')------------------------------------------------------------------------------------ prop "roundtrip Int16" $ \ (w::Int16) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# w)- w' <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let w'' = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip LE Int16" $ \ (w::Int16) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (LE w))- (LE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (LE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip BE Int16" $ \ (w::Int16) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (BE w))- (BE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (BE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip Int32" $ \ (w::Int32) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# w)- w' <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let w'' = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip LE Int32" $ \ (w::Int32) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (LE w))- (LE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (LE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip BE Int32" $ \ (w::Int32) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (BE w))- (BE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (BE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip Int64" $ \ (w::Int64) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# w)- w' <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let w'' = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip LE Int64" $ \ (w::Int64) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (LE w))- (LE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (LE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip BE Int64" $ \ (w::Int64) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (BE w))- (BE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (BE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip Int" $ \ (w::Int) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# w)- w' <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let w'' = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip LE Int" $ \ (w::Int) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (LE w))- (LE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (LE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip BE Int" $ \ (w::Int) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (BE w))- (BE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (BE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip Float" $ \ (w::Float) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# w)- w' <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let w'' = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip LE Float" $ \ (w::Float) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (LE w))- (LE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (LE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip BE Float" $ \ (w::Float) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (BE w))- (BE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (BE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip Double" $ \ (w::Double) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# w)- w' <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let w'' = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip LE Double" $ \ (w::Double) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (LE w))- (LE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (LE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip BE Double" $ \ (w::Double) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (BE w))- (BE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (BE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip Char" $ \ (w::Char) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# w)- w' <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let w'' = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip LE Char" $ \ (w::Char) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (LE w))- (LE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (LE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')-- prop "roundtrip BE Char" $ \ (w::Char) -> ioProperty $ do- mba@(MutableByteArray mba#) <- newByteArray 128- primitive_ (writeWord8ArrayAs# mba# 7# (BE w))- (BE w') <- primitive (readWord8ArrayAs# mba# 7#)- (ByteArray ba#) <- unsafeFreezeByteArray mba- let (BE w'') = indexWord8ArrayAs# ba# 7#- return $ (w === w') .&&. (w === w'')
+ test/Z/Data/Array/UnalignedSpec.hs view
@@ -0,0 +1,294 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Z.Data.Array.UnalignedSpec where++import qualified Data.List as L+import Data.Int+import GHC.Float+import Data.Word+import Z.Data.Array.Unaligned+import Control.Monad.Primitive+import Data.Primitive.ByteArray+import Test.QuickCheck+import Test.QuickCheck.Function+import Test.QuickCheck.Property+import Test.Hspec+import Test.Hspec.QuickCheck++spec :: Spec+spec = describe "unaligned acess" . modifyMaxSuccess (*10) . modifyMaxSize (*10) $ do+ prop "roundtrip Word8" $ \ (w::Word8) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# w)+ w' <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let w'' = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip Word16" $ \ (w::Word16) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# w)+ w' <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let w'' = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip Word32" $ \ (w::Word32) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# w)+ w' <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let w'' = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip Word64" $ \ (w::Word64) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# w)+ w' <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let w'' = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip Word" $ \ (w::Word) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# w)+ w' <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let w'' = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip LE Word16" $ \ (w::Word16) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (LE w))+ (LE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (LE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip LE Word32" $ \ (w::Word32) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (LE w))+ (LE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (LE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip LE Word64" $ \ (w::Word64) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (LE w))+ (LE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (LE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip LE Word" $ \ (w::Word) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (LE w))+ (LE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (LE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip BE Word16" $ \ (w::Word16) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (BE w))+ (BE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (BE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip BE Word32" $ \ (w::Word32) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (BE w))+ (BE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (BE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip BE Word64" $ \ (w::Word64) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (BE w))+ (BE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (BE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip BE Word" $ \ (w::Word) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (BE w))+ (BE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (BE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++--------------------------------------------------------------------------------++ prop "roundtrip Int16" $ \ (w::Int16) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# w)+ w' <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let w'' = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip LE Int16" $ \ (w::Int16) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (LE w))+ (LE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (LE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip BE Int16" $ \ (w::Int16) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (BE w))+ (BE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (BE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip Int32" $ \ (w::Int32) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# w)+ w' <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let w'' = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip LE Int32" $ \ (w::Int32) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (LE w))+ (LE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (LE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip BE Int32" $ \ (w::Int32) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (BE w))+ (BE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (BE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip Int64" $ \ (w::Int64) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# w)+ w' <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let w'' = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip LE Int64" $ \ (w::Int64) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (LE w))+ (LE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (LE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip BE Int64" $ \ (w::Int64) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (BE w))+ (BE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (BE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip Int" $ \ (w::Int) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# w)+ w' <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let w'' = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip LE Int" $ \ (w::Int) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (LE w))+ (LE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (LE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip BE Int" $ \ (w::Int) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (BE w))+ (BE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (BE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip Float" $ \ (w::Float) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# w)+ w' <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let w'' = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip LE Float" $ \ (w::Float) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (LE w))+ (LE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (LE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip BE Float" $ \ (w::Float) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (BE w))+ (BE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (BE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip Double" $ \ (w::Double) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# w)+ w' <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let w'' = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip LE Double" $ \ (w::Double) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (LE w))+ (LE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (LE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip BE Double" $ \ (w::Double) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (BE w))+ (BE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (BE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip Char" $ \ (w::Char) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# w)+ w' <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let w'' = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip LE Char" $ \ (w::Char) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (LE w))+ (LE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (LE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')++ prop "roundtrip BE Char" $ \ (w::Char) -> ioProperty $ do+ mba@(MutableByteArray mba#) <- newByteArray 128+ primitive_ (writeWord8ArrayAs# mba# 7# (BE w))+ (BE w') <- primitive (readWord8ArrayAs# mba# 7#)+ (ByteArray ba#) <- unsafeFreezeByteArray mba+ let (BE w'') = indexWord8ArrayAs# ba# 7#+ return $ (w === w') .&&. (w === w'')
test/Z/Data/CBytesSpec.hs view
@@ -5,10 +5,11 @@ module Z.Data.CBytesSpec where import qualified Data.List as List+import qualified GHC.Exts as List import Data.Word import Data.Hashable (hashWithSalt, hash) import qualified Z.Data.CBytes as CB-import Z.Foreign (fromNullTerminated)+import Z.Foreign import qualified Z.Data.Vector.Base as V import System.IO.Unsafe import Test.QuickCheck@@ -38,8 +39,14 @@ describe "CBytes IsString instance property" $ do prop "ASCII string" $ "hello world" === CB.fromText "hello world"+ prop "ASCII string" $+ "hello world" === CB.fromBytes "hello world"+ prop "ASCII string" $+ CB.toBytes "\NUL" === (V.pack [0xC0, 0x80]) prop "UTF8 string" $ "你好世界" === CB.fromText "你好世界"+ prop "UTF8 string" $+ "\NUL" === CB.pack ['\NUL'] describe "CBytes length == List.length" $ do prop "CBytes length === List.length" $ \ (ASCIIString xs) ->@@ -50,7 +57,17 @@ prop "CBytes eq === List.eq" $ \ xs ys -> (CB.pack xs `CB.append` CB.pack ys) === CB.pack (xs ++ ys) + describe "CBytes concat == List.concat" $ do+ prop "CBytes eq === List.eq" $ \ xss ->+ (CB.concat (map CB.pack xss)) === CB.pack (List.concat xss)++ describe "withCBytes fromCString == id" $ do+ prop "withCBytes fromCString == id" $ \ xs ->+ (unsafeDupablePerformIO $ CB.withCBytes (CB.pack xs) (CB.fromCString . castPtr))+ === CB.pack xs+ describe "withCBytes fromNullTerminated == toBytes" $ do prop "CBytes eq === List.eq" $ \ xs -> CB.toBytes (CB.pack xs) === (unsafeDupablePerformIO $ CB.withCBytes (CB.pack xs) fromNullTerminated)+