diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,11 @@ # Revision history for Z-Data -## 0.1.3.0 -- 2020-09-19 +## 0.1.3.1 -- 2020-09-24 + +* Change `clearMBA` 's type to match `clearPtr`. +* Move `peekMBA`, `pokeMBA` to `UnalignedAccess` class. + +## 0.1.3.0 -- 2020-09-20 * Add indexing funtion to `Z.Data.Vector` and `Z.Data.Text`. * Add `peekMBA`, `pokeMBA` and `clearMBA` to `Z.Foreign`. diff --git a/Z-Data.cabal b/Z-Data.cabal --- a/Z-Data.cabal +++ b/Z-Data.cabal @@ -1,5 +1,5 @@ name: Z-Data -version: 0.1.3.0 +version: 0.1.3.1 synopsis: Array, vector and text description: This package provides array, slice and text operations license: BSD3 diff --git a/Z/Data/Array/UnalignedAccess.hs b/Z/Data/Array/UnalignedAccess.hs --- a/Z/Data/Array/UnalignedAccess.hs +++ b/Z/Data/Array/UnalignedAccess.hs @@ -5,6 +5,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} {-| @@ -41,11 +42,60 @@ -- | 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 - writeWord8ArrayAs# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s - readWord8ArrayAs# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, 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 () diff --git a/Z/Foreign.hs b/Z/Foreign.hs --- a/Z/Foreign.hs +++ b/Z/Foreign.hs @@ -74,7 +74,7 @@ , allocPrimSafe -- ** Pointer helpers , BA#, MBA# - , clearMBA, peekMBA, pokeMBA + , clearMBA , clearPtr , castPtr -- ** re-export @@ -90,7 +90,6 @@ import Data.Primitive.ByteArray import Foreign.C.Types import GHC.Ptr -import GHC.Prim import Z.Data.Array import Z.Data.Array.UnalignedAccess import Z.Data.Vector.Base @@ -121,19 +120,11 @@ -- A 'MutableByteArray#' COULD BE MOVED BY GC DURING SAFE FFI CALL. type MBA# a = MutableByteArray# RealWorld --- | Read field from 'MBA#' with offset. -peekMBA :: (UnalignedAccess x) => MBA# a -> Int -> IO x -peekMBA mba# = readWord8ArrayAs (MutableByteArray mba#) - --- | Write field to 'MBA#' ith offst. -pokeMBA :: (UnalignedAccess x) => MBA# a -> Int -> x -> IO() -pokeMBA mba# = writeWord8ArrayAs (MutableByteArray mba#) - -clearMBA :: MBA# a -> IO () -clearMBA mba# = do +-- | Clear 'MBA#' with given length to zero. +clearMBA :: MBA# a -> Int -> IO () +clearMBA mba# len = do let mba = (MutableByteArray mba#) - siz <- getSizeofMutableByteArray mba - setByteArray mba 0 siz (0 :: Word8) + setByteArray mba 0 len (0 :: Word8) -- | Pass primitive array to unsafe FFI as pointer. -- @@ -169,24 +160,28 @@ -- | Allocate some bytes and pass to FFI as pointer. -- --- This function allocate some unpinned bytes and pass to FFI as MBA#, example usage with hsc2hs: +-- 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: +-- -- @ --- allocMutableByteArrayUnsafe (#size c_struct) $ \ p -> +-- allocMutableByteArrayUnsafe (#size c_struct) $ \ p -> do -- --- pokeMBA# p (#offset c_struct c_field1) field1 --- pokeMBA# p (#offset c_struct c_field2) field2 +-- pokeMBA p (#offset c_struct c_field1) field1 +-- pokeMBA p (#offset c_struct c_field2) field2 -- -- c_ffi p .... -- --- field1' <- peekMBA# p (#offset c_struct c_field1) --- field2' <- peekMBA# p (#offset c_struct c_field2) +-- field1' <- peekMBA p (#offset c_struct c_field1) +-- field2' <- peekMBA p (#offset c_struct c_field2) -- ... -- return (CStruct field1' field2') -- @ -- -- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY. -allocMutableByteArrayUnsafe :: Int -- ^ number of bytes +allocMutableByteArrayUnsafe :: Int -- ^ number of bytes -> (MBA# a -> IO b) -> IO b {-# INLINE allocMutableByteArrayUnsafe #-} allocMutableByteArrayUnsafe len f = do