diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,8 +1,13 @@ # Revision history for Z-Data +## 0.1.3.0 -- 2020-09-19 + +* Add indexing funtion to `Z.Data.Vector` and `Z.Data.Text`. +* Add `peekMBA`, `pokeMBA` and `clearMBA` to `Z.Foreign`. + ## 0.1.2.0 -- 2020-09-19 -* Rename 'read/write/indexWord8ArrayAs' to 'read/write/indexWord8ArrayAs#'. -* Add 'read/write/indexWord8ArrayAs', 'read/write/indexPrimWord8ArrayAs'. +* Rename `read/write/indexWord8ArrayAs` to `read/write/indexWord8ArrayAs#`. +* Add `read/write/indexWord8ArrayAs`, `read/write/indexPrimWord8ArrayAs`. * Fix JSON encoding code in generic instance(constructor with single payload case). 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.2.0 +version: 0.1.3.0 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 @@ -3,6 +3,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DataKinds #-} {-| Module : Z.Data.Array.UnalignedAccess @@ -18,14 +21,15 @@ module Z.Data.Array.UnalignedAccess where +import Control.Monad.Primitive +import Data.Primitive.ByteArray +import Data.Primitive.PrimArray import GHC.Int import GHC.Prim import GHC.Types import GHC.Word import GHC.Float (stgFloatToWord32, stgWord32ToFloat, stgWord64ToDouble, stgDoubleToWord64) -import Control.Monad.Primitive -import Data.Primitive.ByteArray -import Data.Primitive.PrimArray +import Foreign.C.Types -- toggle these defs to test different implements #define USE_BSWAP @@ -789,6 +793,7 @@ -------------------------------------------------------------------------------- +-- | Char's instance use 31bit wide char prim-op. instance UnalignedAccess Char where {-# INLINE unalignedSize #-} unalignedSize = UnalignedSize 4 @@ -838,3 +843,32 @@ 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 diff --git a/Z/Data/Text.hs b/Z/Data/Text.hs --- a/Z/Data/Text.hs +++ b/Z/Data/Text.hs @@ -19,11 +19,13 @@ module Z.Data.Text ( -- * Text type - Text, getUTF8Bytes - , validate, validateMaybe + Text(..) + , validate + , InvalidUTF8Exception(..) + , validateMaybe + , index, indexMaybe, indexR, indexMaybeR -- * Basic creating , empty, singleton, copy - -- * Building text , replicate, cycleN -- * Conversion between list , pack, packN, packR, packRN @@ -41,8 +43,6 @@ , concat, concatMap -- ** Special folds , count, all, any - -- * Searching by equality - , elem, notElem -- * Slice manipulation , cons, snoc , uncons, unsnoc @@ -69,6 +69,8 @@ , intercalateElem , transpose -- * Search + -- ** searching by equality + , elem, notElem -- ** element-wise search , find, findR , filter, partition diff --git a/Z/Data/Text/Base.hs b/Z/Data/Text/Base.hs --- a/Z/Data/Text/Base.hs +++ b/Z/Data/Text/Base.hs @@ -27,11 +27,10 @@ , validate , InvalidUTF8Exception(..) , validateMaybe - , replicate - , cycleN - , indexMaybe, charByteIndex, indexMaybeR, charByteIndexR + , index, indexMaybe, charByteIndex, indexR, indexMaybeR, charByteIndexR -- * Basic creating , empty, singleton, copy + , replicate , cycleN -- * Conversion between list , pack, packN, packR, packRN , unpack, unpackR @@ -215,6 +214,14 @@ arr <- unsafeFreezePrimArray marr return $ Text (PrimVector arr 0 len) +-- | /O(n)/ Get the nth codepoint from 'Text', throw @IndexOutOfVectorRange n callStack@ +-- when out of bound. +index :: HasCallStack => Text -> Int -> Char +{-# INLINABLE index #-} +index t n = case t `indexMaybe` n of Nothing -> throw (V.IndexOutOfVectorRange n callStack) + Just x -> x + + -- | /O(n)/ Get the nth codepoint from 'Text'. indexMaybe :: Text -> Int -> Maybe Char {-# INLINABLE indexMaybe #-} @@ -243,6 +250,13 @@ | i >= end = i | j >= n = i | otherwise = let l' = decodeCharLen ba i in go (i+l') (j+1) + +-- | /O(n)/ Get the nth codepoint from 'Text' counting from the end, +-- throw @IndexOutOfVectorRange n callStack@ when out of bound. +indexR :: HasCallStack => Text -> Int -> Char +{-# INLINABLE indexR #-} +indexR t n = case t `indexMaybeR` n of Nothing -> throw (V.IndexOutOfVectorRange n callStack) + Just x -> x -- | /O(n)/ Get the nth codepoint from 'Text' counting from the end. indexMaybeR :: Text -> Int -> Maybe Char diff --git a/Z/Data/Text/Extra.hs b/Z/Data/Text/Extra.hs --- a/Z/Data/Text/Extra.hs +++ b/Z/Data/Text/Extra.hs @@ -30,8 +30,7 @@ , splitAt , takeWhile, takeWhileR, dropWhile, dropWhileR, dropAround , break, span - , breakR, spanR, breakOn - , breakOnAll, breakOnAllOverlapping + , breakR, spanR, breakOn, breakOnAll , group, groupBy , stripPrefix, stripSuffix , split, splitWith, splitOn @@ -305,14 +304,6 @@ {-# INLINE breakOnAll #-} breakOnAll (Text needle) (Text haystack@(V.PrimVector arr s l)) = List.map breaker (V.indices needle haystack False) - where - breaker i = (Text (V.PrimVector arr s (i-s)), Text (V.PrimVector arr i (s+l-i))) - --- | Overlapping version of 'breakOnAll'. -breakOnAllOverlapping :: Text -> Text -> [(Text, Text)] -{-# INLINE breakOnAllOverlapping #-} -breakOnAllOverlapping (Text needle) (Text haystack@(V.PrimVector arr s l)) = - List.map breaker (V.indicesOverlapping needle haystack False) where breaker i = (Text (V.PrimVector arr s (i-s)), Text (V.PrimVector arr i (s+l-i))) diff --git a/Z/Data/Text/UTF8Codec.hs b/Z/Data/Text/UTF8Codec.hs --- a/Z/Data/Text/UTF8Codec.hs +++ b/Z/Data/Text/UTF8Codec.hs @@ -167,6 +167,7 @@ w4# = indexWord8Array# ba# (idx# +# 3#) in (# chr4# w1# w2# w3# w4#, 4# #) + -- | Decode a codepoint's length in bytes -- -- This function assumed all bytes are UTF-8 encoded, and the index param point to the @@ -182,7 +183,7 @@ -- This function is marked as @NOINLINE@ to reduce code size, and stop messing up simplifier -- due to too much branches. decodeCharLen# :: ByteArray# -> Int# -> Int# -{-# INLINE decodeCharLen# #-} -- This branchy code make GHC impossible to fuse, DON'T inline +{-# INLINE decodeCharLen# #-} decodeCharLen# ba# idx# = case indexWord8Array# ba# idx# of w1# | isTrue# (w1# `leWord#` 0x7F##) -> 1# diff --git a/Z/Data/Vector.hs b/Z/Data/Vector.hs --- a/Z/Data/Vector.hs +++ b/Z/Data/Vector.hs @@ -78,11 +78,12 @@ module Z.Data.Vector ( -- * The Vec typeclass Vec(IArray) + , indexMaybe, index, indexM -- * Boxed and unboxed vector type , Vector , PrimVector -- ** Word8 vector - , Bytes, packASCII + , Bytes, packASCII, w2c, c2w -- * Basic creating , empty, singleton, copy -- * Conversion between list @@ -97,7 +98,7 @@ , foldr', ifoldr', foldr1', foldr1Maybe' -- ** Special folds , concat, concatMap - , maximumMaybe, minimumMaybe + , maximum, minimum, maximumMaybe, minimumMaybe , sum , count , product, product' @@ -111,8 +112,6 @@ , cycleN , unfoldr , unfoldrN - -- * Searching by equality - , elem, notElem, elemIndex -- * Slice manipulation , cons, snoc , uncons, unsnoc @@ -143,6 +142,8 @@ , scanl', scanl1' , scanr', scanr1' -- * Search + -- ** searching by equality + , elem, notElem, elemIndex -- ** element-wise search , find, findR , findIndices, elemIndices @@ -167,7 +168,11 @@ , vecW8, vecW16, vecW32, vecW64, vecWord , vecI8, vecI16, vecI32, vecI64, vecInt -- * Misc - , IPair(..) + , IPair(..), mapIPair' + , defaultInitSize + , chunkOverhead + , defaultChunkSize + , smallChunkSize , VectorException(..) , castVector ) where diff --git a/Z/Data/Vector/Base.hs b/Z/Data/Vector/Base.hs --- a/Z/Data/Vector/Base.hs +++ b/Z/Data/Vector/Base.hs @@ -45,8 +45,7 @@ , Vector(..) , PrimVector(..) -- ** Word8 vector - , Bytes, packASCII - , w2c, c2w + , Bytes, packASCII, w2c, c2w -- * Creating utilities , create, create', creating, creating', createN, createN2 , empty, singleton, copy @@ -62,8 +61,7 @@ , foldr', ifoldr', foldr1', foldr1Maybe' -- ** Special folds , concat, concatMap - , maximum, minimum - , maximumMaybe, minimumMaybe + , maximum, minimum, maximumMaybe, minimumMaybe , sum , count , product, product' diff --git a/Z/Foreign.hs b/Z/Foreign.hs --- a/Z/Foreign.hs +++ b/Z/Foreign.hs @@ -61,8 +61,8 @@ ( -- ** Unsafe FFI withPrimArrayUnsafe , withMutablePrimArrayUnsafe - , allocMutableByteArrayUnsafe , withPrimVectorUnsafe + , allocMutableByteArrayUnsafe , withPrimUnsafe , allocPrimUnsafe -- ** Safe FFI @@ -74,18 +74,25 @@ , allocPrimSafe -- ** Pointer helpers , BA#, MBA# + , clearMBA, peekMBA, pokeMBA , clearPtr , castPtr -- ** re-export + , module Data.Primitive.ByteArray , module Data.Primitive.Ptr + , module Z.Data.Array.UnalignedAccess ) where import Control.Monad.Primitive import Data.Primitive +import Data.Word import Data.Primitive.Ptr +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 -- | Type alias for 'ByteArray#'. @@ -114,6 +121,20 @@ -- 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 + let mba = (MutableByteArray mba#) + siz <- getSizeofMutableByteArray mba + setByteArray mba 0 siz (0 :: Word8) + -- | Pass primitive array to unsafe FFI as pointer. -- -- Enable 'UnliftedFFITypes' extension in your haskell code, use proper pointer type and @CSize/CSsize@ @@ -145,8 +166,28 @@ withMutablePrimArrayUnsafe mpa@(MutablePrimArray mba#) f = getSizeofMutablePrimArray mpa >>= f mba# -allocMutableByteArrayUnsafe :: Int -- ^ In bytes not element - -> (MBA# a -> IO b) -> IO b + +-- | 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: +-- +-- @ +-- allocMutableByteArrayUnsafe (#size c_struct) $ \ p -> +-- +-- 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) +-- ... +-- return (CStruct field1' field2') +-- @ +-- +-- 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 @@ -183,6 +224,7 @@ !a <- readPrimArray mpa 0 return (a, b) +-- | like 'withPrimUnsafe', but don't write initial value. allocPrimUnsafe :: (Prim a) => (MBA# a -> IO b) -> IO (a, b) {-# INLINE allocPrimUnsafe #-} allocPrimUnsafe f = do @@ -196,7 +238,7 @@ -- | Pass primitive array to safe FFI as pointer. -- -- Use proper pointer type and @CSize/CSsize@ to marshall @Ptr a@ and @Int@ arguments on C side. --- The memory pointed by 'Ptr a' will not moved. +-- The memory pointed by 'Ptr a' will not moved during call. After call returned, pointer is no longer valid. -- -- The second 'Int' arguement is the element size not the bytes size. -- @@ -216,7 +258,7 @@ -- | Pass mutable primitive array to unsafe FFI as pointer. -- --- The mutable version of 'withPrimArraySafe'. +-- 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 @@ -231,6 +273,9 @@ copyMutablePrimArray buf 0 marr 0 siz withMutablePrimArrayContents buf $ \ ptr -> f ptr siz +-- | 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 #-} @@ -241,7 +286,7 @@ -- | Pass 'PrimVector' to unsafe FFI as pointer -- -- The 'PrimVector' version of 'withPrimArraySafe'. The 'Ptr' is already pointed --- to the first element, thus no offset is provided. +-- to the first element, thus no offset is provided. After call returned, pointer is no longer valid. -- -- Don't pass a forever loop to this function, see . withPrimVectorSafe :: forall a b. Prim a => PrimVector a -> (Ptr a -> Int -> IO b) -> IO b @@ -269,6 +314,7 @@ !a <- readPrimArray buf 0 return (a, b) +-- | like 'withPrimSafe', but don't write initial value. allocPrimSafe :: forall a b. Prim a => (Ptr a -> IO b) -> IO (a, b) {-# INLINE allocPrimSafe #-} allocPrimSafe f = do