diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for Z-Data +## 0.1.4.2 -- 2020-10-02 + +* Remove `withMutablePrimArrayUnsafe/Safe` from `Z.Foreign`. +* Add `allocPrimArrayUnsafe/Safe`, `allocPrimVectorUnsafe/Safe`, `allocBytesUnsafe/Safe`, `fromPtr/fromPrimPtr` + to `Z.Foreign`. + ## 0.1.4.1 -- 2020-09-29 * Add `fromNullTerminated` to `Z.Foreign`(and `Z.Data.Vector.Base`). diff --git a/Z-Data.cabal b/Z-Data.cabal --- a/Z-Data.cabal +++ b/Z-Data.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: Z-Data -version: 0.1.4.1 +version: 0.1.4.2 synopsis: Array, vector and text description: This package provides array, slice and text operations license: BSD-3-Clause diff --git a/Z/Data/Builder/Numeric.hs b/Z/Data/Builder/Numeric.hs --- a/Z/Data/Builder/Numeric.hs +++ b/Z/Data/Builder/Numeric.hs @@ -6,6 +6,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedFFITypes #-} @@ -708,8 +709,8 @@ -- | Decimal encoding of a 'Double', note grisu only handles strictly positive finite numbers. grisu3 :: Double -> ([Int], Int) {-# INLINE grisu3 #-} -grisu3 d = unsafePerformIO $ - allocMutableByteArrayUnsafe GRISU3_DOUBLE_BUF_LEN $ \ pBuf -> do +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 @@ -732,8 +733,8 @@ -- | 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 = unsafePerformIO $ - allocMutableByteArrayUnsafe GRISU3_SINGLE_BUF_LEN $ \ pBuf -> do +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 diff --git a/Z/Data/JSON/Value.hs b/Z/Data/JSON/Value.hs --- a/Z/Data/JSON/Value.hs +++ b/Z/Data/JSON/Value.hs @@ -251,10 +251,8 @@ -- need escaping 1 -> unsafeDupablePerformIO (do let !len = V.length bs - !mpa <- newPrimArray len - !len' <- withMutablePrimArrayUnsafe mpa (\ mba# _ -> + (!pa, !len') <- allocPrimArrayUnsafe len (\ mba# -> withPrimVectorUnsafe bs (decode_json_string mba#)) - !pa <- unsafeFreezePrimArray mpa if len' >= 0 then pure (Just (T.Text (V.PrimVector pa 0 len'))) -- unescaping also validate utf8 else pure Nothing) diff --git a/Z/Foreign.hs b/Z/Foreign.hs --- a/Z/Foreign.hs +++ b/Z/Foreign.hs @@ -60,16 +60,20 @@ module Z.Foreign ( -- ** Unsafe FFI withPrimArrayUnsafe - , withMutablePrimArrayUnsafe + , allocPrimArrayUnsafe + , allocMutablePrimArrayUnsafe , withPrimVectorUnsafe - , allocMutableByteArrayUnsafe + , allocPrimVectorUnsafe + , allocBytesUnsafe , withPrimUnsafe , allocPrimUnsafe -- ** Safe FFI , withPrimArraySafe - , withMutablePrimArraySafe + , allocPrimArraySafe , allocMutablePrimArraySafe , withPrimVectorSafe + , allocPrimVectorSafe + , allocBytesSafe , withPrimSafe , allocPrimSafe , pinPrimArray @@ -79,7 +83,7 @@ , clearMBA , clearPtr , castPtr - , fromNullTerminated + , fromNullTerminated, fromPtr, fromPrimPtr -- ** re-export , module Data.Primitive.ByteArray , module Foreign.C.Types @@ -125,7 +129,9 @@ type MBA# a = MutableByteArray# RealWorld -- | Clear 'MBA#' with given length to zero. -clearMBA :: MBA# a -> Int -> IO () +clearMBA :: MBA# a + -> Int -- ^ in bytes + -> IO () clearMBA mba# len = do let mba = (MutableByteArray mba#) setByteArray mba 0 len (0 :: Word8) @@ -149,17 +155,16 @@ {-# INLINE withPrimArrayUnsafe #-} withPrimArrayUnsafe pa@(PrimArray ba#) f = f ba# (sizeofPrimArray pa) --- | Pass mutable primitive array to unsafe FFI as pointer. --- --- The mutable version of 'withPrimArrayUnsafe'. +-- | Allocate some bytes and pass to FFI as pointer, freeze result into a 'PrimArray'. -- -- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY. --- -withMutablePrimArrayUnsafe :: (Prim a) => MutablePrimArray RealWorld a - -> (MBA# a -> Int -> IO b) -> IO b -{-# INLINE withMutablePrimArrayUnsafe #-} -withMutablePrimArrayUnsafe mpa@(MutablePrimArray mba#) f = - getSizeofMutablePrimArray mpa >>= f mba# +allocPrimArrayUnsafe :: forall a b. Prim a => Int -> (MBA# a -> IO b) -> IO (PrimArray a, b) +{-# INLINE allocPrimArrayUnsafe #-} +allocPrimArrayUnsafe len f = do + (mpa@(MutablePrimArray mba#) :: MutablePrimArray RealWorld a) <- newPrimArray len + !r <- f mba# + !pa <- unsafeFreezePrimArray mpa + return (pa, r) -- | Allocate some bytes and pass to FFI as pointer. @@ -171,7 +176,7 @@ -- example usage with hsc2hs: -- -- @ --- allocMutableByteArrayUnsafe (#size c_struct) $ \ p -> do +-- allocMutablePrimArrayUnsafe @Word8 (#size c_struct) $ \ p -> do -- -- pokeMBA p (#offset c_struct c_field1) field1 -- pokeMBA p (#offset c_struct c_field2) field2 @@ -185,13 +190,37 @@ -- @ -- -- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY. -allocMutableByteArrayUnsafe :: Int -- ^ number of bytes - -> (MBA# a -> IO b) -> IO b -{-# INLINE allocMutableByteArrayUnsafe #-} -allocMutableByteArrayUnsafe len f = do - (MutableByteArray mba#) <- newByteArray len - f mba# +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) +-- | Allocate a prim array and pass to FFI as pointer, freeze result into a 'PrimVector'. +-- +-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY. +allocPrimVectorUnsafe :: forall a b. Prim a => Int -- ^ number of elements + -> (MBA# a -> IO b) -> IO (PrimVector a, b) +{-# INLINE allocPrimVectorUnsafe #-} +allocPrimVectorUnsafe len f = do + (mpa@(MutablePrimArray mba#) :: MutablePrimArray RealWorld a) <- newPrimArray len + !r <- f mba# + !pa <- unsafeFreezePrimArray mpa + let !v = PrimVector pa 0 len + return (v, r) + +-- | Allocate some bytes and pass to FFI as pointer, freeze result into a 'Bytes'. +-- +-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY. +allocBytesUnsafe :: Int -- ^ number of bytes + -> (MBA# a -> IO b) -> IO (Bytes, b) +{-# INLINE allocBytesUnsafe #-} +allocBytesUnsafe = allocPrimVectorUnsafe + + -- | Pass 'PrimVector' to unsafe FFI as pointer -- -- The 'PrimVector' version of 'withPrimArrayUnsafe'. @@ -224,6 +253,8 @@ return (a, b) -- | like 'withPrimUnsafe', but don't write initial value. +-- +-- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY. allocPrimUnsafe :: (Prim a) => (MBA# a -> IO b) -> IO (a, b) {-# INLINE allocPrimUnsafe #-} allocPrimUnsafe f = do @@ -254,23 +285,17 @@ copyPrimArray buf 0 arr 0 siz withMutablePrimArrayContents buf $ \ ptr -> f ptr siz - --- | Pass mutable primitive array to unsafe FFI as pointer. --- --- The mutable version of 'withPrimArraySafe'. After call returned, pointer is no longer valid. --- --- Don't pass a forever loop to this function, see . -withMutablePrimArraySafe :: (Prim a) => MutablePrimArray RealWorld a -> (Ptr a -> Int -> IO b) -> IO b -{-# INLINE withMutablePrimArraySafe #-} -withMutablePrimArraySafe marr f - | isMutablePrimArrayPinned marr = do - siz <- getSizeofMutablePrimArray marr - withMutablePrimArrayContents marr $ \ ptr -> f ptr siz - | otherwise = do - siz <- getSizeofMutablePrimArray marr - buf <- newPinnedPrimArray siz - copyMutablePrimArray buf 0 marr 0 siz - withMutablePrimArrayContents buf $ \ ptr -> f ptr siz +-- | Allocate some bytes and pass to FFI as pointer, freeze result into a 'PrimVector'. +allocPrimArraySafe :: forall a b . Prim a + => Int -- ^ in elements + -> (Ptr a -> IO b) + -> IO (PrimArray a, b) +{-# INLINE allocPrimArraySafe #-} +allocPrimArraySafe len f = do + mpa <- newAlignedPinnedPrimArray len + !r <- withMutablePrimArrayContents mpa f + !pa <- unsafeFreezePrimArray mpa + return (pa, r) -- | Allocate a primitive array and pass to FFI as pointer. -- @@ -322,6 +347,24 @@ !a <- readPrimArray buf 0 return (a, b) +-- | Allocate a prim array and pass to FFI as pointer, freeze result into a 'PrimVector'. +allocPrimVectorSafe :: forall a b . Prim a + => Int -- ^ in elements + -> (Ptr a -> IO b) -> IO (PrimVector a, b) +{-# INLINE allocPrimVectorSafe #-} +allocPrimVectorSafe len f = do + mpa <- newAlignedPinnedPrimArray len + !r <- withMutablePrimArrayContents mpa f + !pa <- unsafeFreezePrimArray mpa + let !v = PrimVector pa 0 len + return (v, r) + +-- | Allocate some bytes and pass to FFI as pointer, freeze result into a 'PrimVector'. +allocBytesSafe :: Int -- ^ in bytes + -> (Ptr Word8 -> IO b) -> IO (Bytes, b) +{-# INLINE allocBytesSafe #-} +allocBytesSafe = allocPrimVectorSafe + -- | Convert a 'PrimArray' to a pinned one(memory won't moved by GC) if necessary. pinPrimArray :: Prim a => PrimArray a -> IO (PrimArray a) {-# INLINE pinPrimArray #-} @@ -369,3 +412,29 @@ copyPtrToMutablePrimArray marr 0 (Ptr addr#) len arr <- unsafeFreezePrimArray marr return (PrimVector arr 0 len) + +-- | Copy some bytes from a pointer. +-- +-- There's no encoding guarantee, result could be any bytes sequence. +fromPtr :: Ptr a -> Int -- ^ in bytes + -> IO Bytes +{-# INLINE fromPtr #-} +fromPtr (Ptr addr#) len = do + marr <- newPrimArray len + copyPtrToMutablePrimArray marr 0 (Ptr addr#) len + arr <- unsafeFreezePrimArray marr + return (PrimVector arr 0 len) + +-- | Copy some bytes from a pointer. +-- +-- There's no encoding guarantee, result could be any bytes sequence. +fromPrimPtr :: forall a. Prim a + => Ptr a -> Int -- ^ in elements + -> IO (PrimVector a) +{-# INLINE fromPrimPtr #-} +fromPrimPtr (Ptr addr#) len = do + marr <- newPrimArray len + copyPtrToMutablePrimArray marr 0 (Ptr addr#) len + arr <- unsafeFreezePrimArray marr + return (PrimVector arr 0 len) +