Z-Data 1.1.0.0 → 1.2.0.0
raw patch · 11 files changed
+105/−53 lines, 11 filesnew-uploaderPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Z.Foreign: type BA# a = ByteArray#
- Z.Foreign: type BAArray# a = ArrayArray#
- Z.Foreign: type MBA# a = MutableByteArray# RealWorld
+ Z.Data.Builder.Numeric: quotRem10 :: Word -> (Word, Word)
+ Z.Data.JSON: instance Z.Data.JSON.Base.JSON Data.UUID.Types.Internal.UUID
+ Z.Foreign: BA# :: ByteArray# -> BA# a
+ Z.Foreign: BAArray# :: ArrayArray# -> BAArray# a
+ Z.Foreign: MBA# :: MutableByteArray# RealWorld -> MBA# a
+ Z.Foreign: newtype BA# a
+ Z.Foreign: newtype BAArray# a
+ Z.Foreign: newtype MBA# a
- Z.Foreign: allocBytesUnsafe :: Int -> (MBA# a -> IO b) -> IO (Bytes, b)
+ Z.Foreign: allocBytesUnsafe :: Int -> (MBA# Word8 -> IO b) -> IO (Bytes, b)
Files
- Z-Data.cabal +1/−1
- Z/Data/Builder/Numeric.hs +22/−8
- Z/Data/Builder/UUID.hs +2/−2
- Z/Data/CBytes.hs +11/−10
- Z/Data/JSON.hs +11/−0
- Z/Data/Parser/UUID.hs +1/−1
- Z/Data/Text/Regex.hs +6/−4
- Z/Data/Vector/Base64.hs +1/−1
- Z/Data/Vector/Hex.hs +2/−2
- Z/Foreign.hs +47/−23
- Z/Foreign/CPtr.hs +1/−1
Z-Data.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: Z-Data-version: 1.1.0.0+version: 1.2.0.0 synopsis: Array, vector and text description: This package provides array, slice and text operations license: BSD-3-Clause
Z/Data/Builder/Numeric.hs view
@@ -37,6 +37,7 @@ , i2wDec, i2wHex, i2wHexUpper , countDigits , c_intWith, hs_intWith+ , quotRem10 ) where import Control.Monad@@ -62,7 +63,8 @@ -------------------------------------------------------------------------------- -foreign import ccall unsafe "dtoa.h" c_int_dec :: Word64 -> Int -> Int -> Word8 -> MBA# Word8 -> Int -> IO Int+foreign import ccall unsafe "dtoa.h"+ c_int_dec :: Word64 -> Int -> Int -> Word8 -> MBA# Word8 -> Int -> IO Int -- | Integral formatting options. --@@ -142,8 +144,8 @@ ensureN (max 21 width) (\ (MutablePrimArray mba#) i -> if x < 0 then let !x' = (fromIntegral (complement x) :: Word64) + 1- in (c_int_dec x' (-1) width pad mba# i)- else c_int_dec (fromIntegral x) (if posSign then 1 else 0) width pad mba# i)+ in (c_int_dec x' (-1) width pad (MBA# mba#) i)+ else c_int_dec (fromIntegral x) (if posSign then 1 else 0) width pad (MBA# mba#) i) where pad = case padding of NoPadding -> 0 RightSpacePadding -> 1@@ -629,7 +631,7 @@ then ([0], 0) else case c of #ifdef INTEGER_GMP- (S# i#) -> goI (I# i#) 0 []+ (S# i#) -> goI (W# (int2Word# i#)) 0 [] #endif _ -> go c 0 [] where@@ -642,11 +644,23 @@ go i !n ds = case i `quotRemInteger` 10 of (# q, r #) -> let !d = fromIntegral r in go q (n+1) (d:ds) #ifdef INTEGER_GMP- goI :: Int -> Int -> [Int] -> ([Int], Int)+ goI :: Word -> Int -> [Int] -> ([Int], Int) goI 0 !n ds = let !ne = n + e in (ds, ne)- goI i !n ds = case i `quotRem` 10 of (q, !r) -> goI q (n+1) (r:ds)+ goI i !n ds = case quotRem10 i of (q, r) -> let !d = fromIntegral r in goI q (n+1) (d:ds) #endif +-- | A faster `quotRem` by 10.+quotRem10 :: Word -> (Word, Word)+{-# INLINE quotRem10 #-}+quotRem10 (W# w#) =+ let w'# = dquot10# w#+ in (W# w'#, W# (w# `minusWord#` (w'# `timesWord#` 10##)))+ where+ dquot10# :: Word# -> Word#+ dquot10# w =+ let !(# rdx, _ #) = w `timesWord2#` 0xCCCCCCCCCCCCCCCD##+ in rdx `uncheckedShiftRL#` 3#+ -- | Worker function to do formatting. doFmt :: FFormat -> Maybe Int -- ^ Number of decimal places to render.@@ -751,7 +765,7 @@ (MutableByteArray pBuf) <- newByteArray GRISU3_DOUBLE_BUF_LEN (len, (e, success)) <- allocPrimUnsafe $ \ pLen -> allocPrimUnsafe $ \ pE ->- c_grisu3 (realToFrac d) pBuf pLen pE+ c_grisu3 (realToFrac d) (MBA# pBuf) pLen pE if success == 0 -- grisu3 fail then pure (floatToDigits 10 d) else do@@ -775,7 +789,7 @@ (MutableByteArray pBuf) <- newByteArray GRISU3_SINGLE_BUF_LEN (len, (e, success)) <- allocPrimUnsafe $ \ pLen -> allocPrimUnsafe $ \ pE ->- c_grisu3_sp (realToFrac d) pBuf pLen pE+ c_grisu3_sp (realToFrac d) (MBA# pBuf) pLen pE if success == 0 -- grisu3 fail then pure (floatToDigits 10 d) else do
Z/Data/Builder/UUID.hs view
@@ -43,7 +43,7 @@ B.hex w5 B.hex w6 --- | Write texutal UUID bytes, e.g. @550e8400-e29b-41d4-a716-446655440000@+-- | Write texutal UUID bytes in UPPERCASE, e.g. @550E8400-E29B-41D4-A716-446655440000@ uuidUpper :: UUID -> B.Builder () {-# INLINABLE uuidUpper #-} uuidUpper (UUID wh wl) = do@@ -65,7 +65,7 @@ B.hexUpper w6 --- | Encode binary UUID(two 64-bits word in big-endian), as described in <http://tools.ietf.org/html/rfc4122 RFC 4122>. +-- | Encode binary UUID(two 64-bits word in big-endian), as described in <https://datatracker.ietf.org/doc/html/rfc4122 RFC 4122>. encodeUUID :: UUID -> B.Builder () {-# INLINABLE encodeUUID #-} encodeUUID (UUID wh wl) = do
Z/Data/CBytes.hs view
@@ -192,10 +192,10 @@ -- | Poke 'CBytes' until a \\NUL terminator(or to the end of the array if there's none). peekMBACBytes :: MBA# Word8 -> Int -> IO CBytes {-# INLINE peekMBACBytes #-}-peekMBACBytes mba# i = do+peekMBACBytes mba@(MBA# mba#) i = do b <- getSizeofMutableByteArray (MutableByteArray mba#) let rest = b-i- l <- c_memchr mba# i 0 rest+ l <- c_memchr mba i 0 rest let l' = if l == -1 then rest else l mpa <- newPrimArray (l'+1) copyMutablePrimArray mpa 0 (MutablePrimArray mba#) i l'@@ -207,14 +207,14 @@ -- | Poke 'CBytes' with \\NUL terminator. pokeMBACBytes :: MBA# Word8 -> Int -> CBytes -> IO () {-# INLINE pokeMBACBytes #-}-pokeMBACBytes mba# i (CBytes pa) = do+pokeMBACBytes (MBA# mba#) i (CBytes pa) = do let l = sizeofPrimArray pa copyPrimArray (MutablePrimArray mba# :: MutablePrimArray RealWorld Word8) i pa 0 l -- | Index a 'CBytes' until a \\NUL terminator(or to the end of the array if there's none). indexBACBytes :: BA# Word8 -> Int -> CBytes {-# INLINE indexBACBytes #-}-indexBACBytes ba# i = runST (do+indexBACBytes (BA# ba#) i = runST (do let b = sizeofByteArray (ByteArray ba#) rest = b-i l = V.c_memchr ba# i 0 rest@@ -611,9 +611,9 @@ \ (_, 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)- let l' = if l == -1 then (n-1) else l+ a <- fill (MBA# mba#)+ l <- fromIntegral <$> c_memchr (MBA# mba#) 0 0 n+ let l' = if l == -1 then n-1 else l shrinkMutablePrimArray mba (l'+1) writePrimArray mba l' 0 bs <- unsafeFreezePrimArray mba@@ -634,8 +634,8 @@ | otherwise = do mba@(MutablePrimArray mba#) <- newPinnedPrimArray n :: IO (MutablePrimArray RealWorld Word8) a <- withMutablePrimArrayContents mba (fill . castPtr)- l <- fromIntegral <$> (c_memchr mba# 0 0 n)- let l' = if l == -1 then (n-1) else l+ l <- fromIntegral <$> c_memchr (MBA# mba#) 0 0 n+ let l' = if l == -1 then n-1 else l shrinkMutablePrimArray mba (l'+1) writePrimArray mba l' 0 bs <- unsafeFreezePrimArray mba@@ -658,4 +658,5 @@ c_strlen_ptr (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+foreign import ccall unsafe "hs_memchr"+ c_memchr :: MBA# Word8 -> Int -> Word8 -> Int -> IO Int
Z/Data/JSON.hs view
@@ -72,6 +72,7 @@ import Z.Data.JSON.Base import qualified Z.Data.Parser as P import qualified Z.Data.Text as T+import Data.UUID.Types (UUID) -- $use --@@ -391,6 +392,16 @@ encodeJSON Saturday = "\"Saturday\"" encodeJSON Sunday = "\"Sunday\"" +instance JSON UUID where+ {-# INLINE fromValue #-}+ fromValue = withText "UUID" $ \ t ->+ case P.parse' (P.uuid <* P.endOfInput) (T.getUTF8Bytes t) of+ Left err -> fail' $ "could not parse UUID: " <> T.toText err+ Right r -> return r+ {-# INLINE toValue #-}+ toValue = String . B.unsafeBuildText . B.quotes . B.uuid+ {-# INLINE encodeJSON #-}+ encodeJSON = B.quotes . B.uuid --------------------------------------------------------------------------------
Z/Data/Parser/UUID.hs view
@@ -39,7 +39,7 @@ pure (UUID w1 w2) --- | Decode binary UUID(two 64-bits word in big-endian), as described in <http://tools.ietf.org/html/rfc4122 RFC 4122>. +-- | Decode binary UUID(two 64-bits word in big-endian), as described in <https://datatracker.ietf.org/doc/html/rfc4122 RFC 4122>. decodeUUID :: P.Parser UUID {-# INLINABLE decodeUUID #-} decodeUUID = UUID <$> P.decodeWord64BE <*> P.decodeWord64BE
Z/Data/Text/Regex.hs view
@@ -115,7 +115,9 @@ {-# NOINLINE regex #-} regex t = unsafePerformIO $ do (cp, r) <- newCPtrUnsafe (\ mba# ->- (withPrimVectorUnsafe (T.getUTF8Bytes t) (hs_re2_compile_pattern_default mba#)))+ withPrimVectorUnsafe+ (T.getUTF8Bytes t)+ (hs_re2_compile_pattern_default (MBA# mba#))) p_hs_re2_delete_pattern when (r == nullPtr) (throwIO (InvalidRegexPattern t callStack))@@ -130,8 +132,8 @@ {-# NOINLINE regexOpts #-} regexOpts RegexOpts{..} t = unsafePerformIO $ do (cp, r) <- newCPtrUnsafe ( \ mba# ->- (withPrimVectorUnsafe (T.getUTF8Bytes t) $ \ p o l ->- hs_re2_compile_pattern mba# p o l+ withPrimVectorUnsafe (T.getUTF8Bytes t) $ \ p o l ->+ hs_re2_compile_pattern (MBA# mba#) p o l (fromBool posix_syntax ) (fromBool longest_match ) max_mem@@ -142,7 +144,7 @@ (fromBool case_sensitive) (fromBool perl_classes ) (fromBool word_boundary )- (fromBool one_line )))+ (fromBool one_line )) p_hs_re2_delete_pattern when (r == nullPtr) (throwIO (InvalidRegexPattern t callStack))
Z/Data/Vector/Base64.hs view
@@ -54,7 +54,7 @@ base64EncodeBuilder (V.PrimVector arr s l) = B.writeN (base64EncodeLength l) (\ (MutablePrimArray mba#) i -> do withPrimArrayUnsafe arr $ \ parr _ ->- hs_base64_encode mba# i parr s l)+ hs_base64_encode (MBA# mba#) i parr s l) -- | Text version of 'base64Encode'. base64EncodeText :: V.Bytes -> T.Text
Z/Data/Vector/Hex.hs view
@@ -82,8 +82,8 @@ B.writeN (l `unsafeShiftL` 1) (\ (MutablePrimArray mba#) i -> do withPrimArrayUnsafe arr $ \ parr _ -> if upper- then hs_hex_encode_upper mba# i parr s l- else hs_hex_encode mba# i parr s l)+ then hs_hex_encode_upper (MBA# mba#) i parr s l+ else hs_hex_encode (MBA# mba#) i parr s l) -- | Text version of 'hexEncode'. hexEncodeText :: Bool -- ^ uppercase?
Z/Foreign.hs view
@@ -1,3 +1,6 @@+#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE UnliftedNewtypes #-}+#endif {-| Module : Z.Foreign Description : Use PrimArray \/ PrimVector with FFI@@ -76,7 +79,11 @@ , pinPrimArray , pinPrimVector -- ** Pointer helpers- , BA#, MBA#, BAArray#+#if __GLASGOW_HASKELL__ >= 810+ , BA# (..), MBA# (..), BAArray# (..)+#else+ , BA#, pattern BA#, MBA#, pattern MBA#, BAArray#, pattern BAArray#+#endif , clearMBA , clearPtr , castPtr@@ -100,26 +107,28 @@ , hs_delete_std_string ) where -import Control.Exception (bracket)+import Control.Exception (bracket) import Control.Monad import Control.Monad.Primitive+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.ByteString.Short.Internal (ShortByteString (..),+ fromShort, toShort)+import qualified Data.ByteString.Unsafe as B+import qualified Data.List as List import Data.Primitive-import Data.Word-import qualified Data.List as List-import Data.Primitive.Ptr import Data.Primitive.ByteArray import Data.Primitive.PrimArray+import Data.Primitive.Ptr+import Data.Word import Foreign.C.Types-import GHC.Ptr import GHC.Exts-import Z.Data.Array.Base (withMutablePrimArrayContents, withPrimArrayContents)+import GHC.Ptr+import Z.Data.Array.Base (withMutablePrimArrayContents,+ withPrimArrayContents) import Z.Data.Array.Unaligned import Z.Data.Array.UnliftedArray import Z.Data.Vector.Base-import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as B-import Data.ByteString.Short.Internal (ShortByteString(..), fromShort, toShort) -- | Type alias for 'ByteArray#'. --@@ -133,7 +142,13 @@ -- 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.+#if __GLASGOW_HASKELL__ >= 810+newtype BA# a = BA# ByteArray#+#else type BA# a = ByteArray#+pattern BA# :: ByteArray# -> BA# a+pattern BA# ba = ba+#endif -- | Type alias for 'MutableByteArray#' 'RealWorld'. --@@ -144,7 +159,13 @@ -- <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.+#if __GLASGOW_HASKELL__ >= 810+newtype MBA# a = MBA# (MutableByteArray# RealWorld)+#else type MBA# a = MutableByteArray# RealWorld+pattern MBA# :: MutableByteArray# RealWorld -> MBA# a+pattern MBA# mba = mba+#endif -- | Type alias for 'ArrayArray#'. --@@ -177,17 +198,21 @@ -- -- by the type system in this example since ArrayArray is untyped. -- foreign import ccall unsafe "sum_first" sumFirst :: BAArray# Int -> Int -> IO CInt -- @---+#if __GLASGOW_HASKELL__ >= 810+newtype BAArray# a = BAArray# ArrayArray#+#else type BAArray# a = ArrayArray#+pattern BAArray# :: ArrayArray# -> BAArray# a+pattern BAArray# baa = baa+#endif -- | Clear 'MBA#' with given length to zero. clearMBA :: MBA# a -> Int -- ^ in bytes -> IO () {-# INLINE clearMBA #-}-clearMBA mba# len = do- let mba = (MutableByteArray mba#)- setByteArray mba 0 len (0 :: Word8)+clearMBA (MBA# mba#) len =+ setByteArray (MutableByteArray mba#) 0 len (0 :: Word8) -- | Pass primitive array to unsafe FFI as pointer. --@@ -199,7 +224,7 @@ -- 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)+withPrimArrayUnsafe pa@(PrimArray ba#) f = f (BA# ba#) (sizeofPrimArray pa) -- | Pass primitive array list to unsafe FFI as @StgArrBytes**@. --@@ -217,7 +242,7 @@ mla <- unsafeNewUnliftedArray l foldM_ (\ !i pa -> writeUnliftedArray mla i pa >> return (i+1)) 0 pas (UnliftedArray la#) <- unsafeFreezeUnliftedArray mla- f la# l+ f (BAArray# la#) l -- | Allocate some bytes and pass to FFI as pointer, freeze result into a 'PrimArray'. --@@ -226,7 +251,7 @@ {-# INLINE allocPrimArrayUnsafe #-} allocPrimArrayUnsafe len f = do (mpa@(MutablePrimArray mba#) :: MutablePrimArray RealWorld a) <- newPrimArray len- !r <- f mba#+ !r <- f (MBA# mba#) !pa <- unsafeFreezePrimArray mpa return (pa, r) @@ -252,7 +277,7 @@ {-# INLINE allocPrimVectorUnsafe #-} allocPrimVectorUnsafe len f = do (mpa@(MutablePrimArray mba#) :: MutablePrimArray RealWorld a) <- newPrimArray len- !r <- f mba#+ !r <- f (MBA# mba#) !pa <- unsafeFreezePrimArray mpa let !v = PrimVector pa 0 len return (v, r)@@ -261,11 +286,10 @@ -- -- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY. allocBytesUnsafe :: Int -- ^ number of bytes- -> (MBA# a -> IO b) -> IO (Bytes, b)+ -> (MBA# Word8 -> IO b) -> IO (Bytes, b) {-# INLINE allocBytesUnsafe #-} allocBytesUnsafe = allocPrimVectorUnsafe - -- | Create an one element primitive array and use it as a pointer to the primitive element. -- -- Return the element and the computation result.@@ -278,7 +302,7 @@ withPrimUnsafe v f = do mpa@(MutablePrimArray mba#) <- newPrimArray 1 -- All heap objects are WORD aligned writePrimArray mpa 0 v- !b <- f mba# -- so no need to do extra alignment+ !b <- f (MBA# mba#) -- so no need to do extra alignment !a <- readPrimArray mpa 0 return (a, b) @@ -289,7 +313,7 @@ {-# INLINE allocPrimUnsafe #-} allocPrimUnsafe f = do mpa@(MutablePrimArray mba#) <- newPrimArray 1 -- All heap objects are WORD aligned- !b <- f mba# -- so no need to do extra alignment+ !b <- f (MBA# mba#) -- so no need to do extra alignment !a <- readPrimArray mpa 0 return (a, b)
Z/Foreign/CPtr.hs view
@@ -139,7 +139,7 @@ foldM_ (\ !i (CPtr pa) -> writePrimArray mpa i (indexPrimArray pa 0) >> return (i+1)) 0 cptrs (PrimArray ba#) <- unsafeFreezePrimArray mpa- r <- f ba# len+ r <- f (BA# ba#) len primitive_ (touch# cptrs) return r where len = length cptrs