diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Revision history for Z-Data +## 0.1.8.0 -- 2020-10-23 + +* Rename `ascii` to `vecASCII` in `Z.Data.Vector.QQ` to match array QQ. +* Add `FoldCase` instance to `Text`. +* Add `hex'`, `hex_`, `uint_`, `int_`, `integer` to `Z.Data.Parser`, change `hex`, `uint`, `int` to fail in case of overflow. +* Add `takeN` to `Z.Data.Parser`. +* Rename `withCBytesListSafe` to `withCBytesList` to match rest of the module. + ## 0.1.7.2 -- 2020-10-17 * Add `withPrimArrayListUnsafe`, `withPrimArrayListSafe`, `withCBytesUnsafe`, `withCBytesListSafe`. 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.7.2 +version: 0.1.8.0 synopsis: Array, vector and text description: This package provides array, slice and text operations license: BSD-3-Clause diff --git a/Z/Data/Array/Unaligned.hs b/Z/Data/Array/Unaligned.hs --- a/Z/Data/Array/Unaligned.hs +++ b/Z/Data/Array/Unaligned.hs @@ -50,11 +50,19 @@ -- @ -- class Unaligned a where - {-# MINIMAL unalignedSize, indexWord8ArrayAs#, writeWord8ArrayAs#, readWord8ArrayAs# | - unalignedSize, indexBA, peekMBA, pokeMBA #-} + {-# MINIMAL (unalignedSize# | unalignedSize), + (indexWord8ArrayAs# | indexBA), + (writeWord8ArrayAs# | peekMBA), + (readWord8ArrayAs# | pokeMBA) #-} -- | byte size unalignedSize :: a -> Int + {-# INLINE unalignedSize #-} + unalignedSize a = I# (unalignedSize# a) + unalignedSize# :: a -> Int# + {-# INLINE unalignedSize# #-} + unalignedSize# a = case unalignedSize a of I# siz_a# -> siz_a# + -- | index element off byte array with offset in bytes(maybe unaligned) indexWord8ArrayAs# :: ByteArray# -> Int# -> a {-# INLINE indexWord8ArrayAs# #-} @@ -895,6 +903,46 @@ in BE (C# (chr# x#)) #endif +{- not really useful +instance (Unaligned a, Unaligned b) => Unaligned (a, b) where + {-# INLINE unalignedSize #-} + unalignedSize (a, b) = unalignedSize a + unalignedSize b + {-# INLINE writeWord8ArrayAs# #-} + writeWord8ArrayAs# mba# i# (a, b) s0 = + let s1 = writeWord8ArrayAs# mba# i# a s0 + in writeWord8ArrayAs# mba# (i# +# unalignedSize# a) b s1 + {-# INLINE readWord8ArrayAs# #-} + readWord8ArrayAs# mba# i# s0 = + let !(# s1, a #) = readWord8ArrayAs# mba# i# s0 + !(# s2, b #) = readWord8ArrayAs# mba# (i# +# unalignedSize# a) s1 + in (# s2, (a, b) #) + {-# INLINE indexWord8ArrayAs# #-} + indexWord8ArrayAs# ba# i# = + let a = indexWord8ArrayAs# ba# i# + b = indexWord8ArrayAs# ba# (i# +# unalignedSize# a) + in (a, b) + +instance (Unaligned a, Unaligned b, Unaligned c) => Unaligned (a, b, c) where + {-# INLINE unalignedSize #-} + unalignedSize (a, b, c) = unalignedSize a + unalignedSize b + unalignedSize c + {-# INLINE writeWord8ArrayAs# #-} + writeWord8ArrayAs# mba# i# (a, b, c) s0 = + let s1 = writeWord8ArrayAs# mba# i# a s0 + s2 = writeWord8ArrayAs# mba# (i# +# unalignedSize# a) b s1 + in writeWord8ArrayAs# mba# (i# +# unalignedSize# a +# unalignedSize# b) c s2 + {-# INLINE readWord8ArrayAs# #-} + readWord8ArrayAs# mba# i# s0 = + let !(# s1, a #) = readWord8ArrayAs# mba# i# s0 + !(# s2, b #) = readWord8ArrayAs# mba# (i# +# unalignedSize# a) s1 + !(# s3, c #) = readWord8ArrayAs# mba# (i# +# unalignedSize# a +# unalignedSize# b) s2 + in (# s3, (a, b, c) #) + {-# INLINE indexWord8ArrayAs# #-} + indexWord8ArrayAs# ba# i# = + let a = indexWord8ArrayAs# ba# i# + b = indexWord8ArrayAs# ba# (i# +# unalignedSize# a) + c = indexWord8ArrayAs# ba# (i# +# unalignedSize# a +# unalignedSize# b) + in (a, b, c) +-} -------------------------------------------------------------------------------- -- Prim instances for newtypes in Foreign.C.Types diff --git a/Z/Data/CBytes.hs b/Z/Data/CBytes.hs --- a/Z/Data/CBytes.hs +++ b/Z/Data/CBytes.hs @@ -23,7 +23,7 @@ , empty, singleton, append, concat, intercalate, intercalateElem , fromCString, fromCStringN , withCBytesUnsafe, withCBytes, allocCBytesUnsafe, allocCBytes - , withCBytesListUnsafe, withCBytesListSafe + , withCBytesListUnsafe, withCBytesList -- * re-export , CString , V.c2w, V.w2c @@ -79,7 +79,7 @@ -- -- '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 'V.Bytes' with 'CB' pattern or --- 'toBytes'\/'fromBytes', then use vector combinators. +-- 'toBytes' \/ 'fromBytes', then use vector combinators. -- -- When textual represatation is needed e.g. converting to 'String', 'T.Text', 'Show' instance, etc., -- we assume 'CBytes' using UTF-8 encodings, 'CBytes' can be used with @OverloadedString@, @@ -94,7 +94,7 @@ { -- | Convert to a @\\NUL@ terminated 'PrimArray', -- - -- there's an invariance that this array never contains extra @\\NUL@ except terminator. + -- There's an invariance that this array never contains extra @\\NUL@ except terminator. rawPrimArray :: PrimArray Word8 } @@ -480,7 +480,7 @@ -- | Write 'CBytes' \'s byte sequence to buffer. -- --- This function is different from 'ShowT' instance in that it directly write byte sequence without +-- This function is different from 'T.ShowT' instance in that it directly write byte sequence without -- checking if it's UTF8 encoded. toBuilder :: CBytes -> B.Builder () toBuilder = B.bytes . toBytes @@ -552,9 +552,9 @@ -- | Pass 'CBytes' list to foreign function as a @const char**@. -- -- Check "Z.Foreign" module for more detail on how to marshall params in C side. -withCBytesListSafe :: [CBytes] -> (Ptr (Ptr Word8) -> Int -> IO a) -> IO a -{-# INLINABLE withCBytesListSafe #-} -withCBytesListSafe pas = withPrimArrayListSafe (List.map rawPrimArray pas) +withCBytesList :: [CBytes] -> (Ptr (Ptr Word8) -> Int -> IO a) -> IO a +{-# INLINABLE withCBytesList #-} +withCBytesList pas = withPrimArrayListSafe (List.map rawPrimArray pas) -- | Create a 'CBytes' with IO action. -- diff --git a/Z/Data/JSON/Base.hs b/Z/Data/JSON/Base.hs --- a/Z/Data/JSON/Base.hs +++ b/Z/Data/JSON/Base.hs @@ -119,7 +119,7 @@ -- | Decode a JSON doc, only trailing JSON whitespace are allowed. decode' :: FromValue a => V.Bytes -> Either DecodeError a {-# INLINE decode' #-} -decode' bs = case P.parse_ (JV.value <* JV.skipSpaces <* P.endOfInput) bs of +decode' bs = case P.parse' (JV.value <* JV.skipSpaces <* P.endOfInput) bs of Left pErr -> Left (Left pErr) Right v -> case convert fromValue v of Left cErr -> Left (Right cErr) @@ -948,7 +948,7 @@ fromValue = withFlatMapR "Z.Data.Vector.FlatIntMap.FlatIntMap" $ \ m -> let kvs = FM.sortedKeyValues m in FIM.packVectorR <$> (forM kvs $ \ (k, v) -> do - case P.parse_ P.int (T.getUTF8Bytes k) of + case P.parse' P.int (T.getUTF8Bytes k) of Right k' -> do v' <- fromValue v Key k return (V.IPair k' v') 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 @@ -137,7 +137,7 @@ -- bytes left, parsing will fail. parseValue' :: V.Bytes -> Either P.ParseError Value {-# INLINE parseValue' #-} -parseValue' = P.parse_ (value <* skipSpaces <* P.endOfInput) +parseValue' = P.parse' (value <* skipSpaces <* P.endOfInput) -- | Increamental parse 'Value' without consuming trailing bytes. parseValueChunks :: Monad m => m V.Bytes -> V.Bytes -> m (V.Bytes, Either P.ParseError Value) diff --git a/Z/Data/Parser.hs b/Z/Data/Parser.hs --- a/Z/Data/Parser.hs +++ b/Z/Data/Parser.hs @@ -30,7 +30,7 @@ , Parser , () -- * Running a parser - , parse, parse_, parseChunk, parseChunks, finishParsing + , parse, parse', parseChunk, parseChunks, finishParsing , runAndKeepTrack, match -- * Basic parsers , ensureN, endOfInput, atEnd @@ -43,9 +43,10 @@ , text -- * Numeric parsers -- ** Decimal - , uint, int + , uint, int, integer + , uint_, int_ -- ** Hex - , hex + , hex, hex', hex_ -- ** Fractional , rational , float, double diff --git a/Z/Data/Parser/Base.hs b/Z/Data/Parser/Base.hs --- a/Z/Data/Parser/Base.hs +++ b/Z/Data/Parser/Base.hs @@ -19,7 +19,7 @@ , Parser(..) , () -- * Running a parser - , parse, parse_, parseChunk, parseChunks, finishParsing + , parse, parse', parseChunk, parseChunks, finishParsing , runAndKeepTrack, match -- * Basic parsers , ensureN, endOfInput, atEnd @@ -28,7 +28,7 @@ -- * More parsers , scan, scanChunks, peekMaybe, peek, satisfy, satisfyWith , word8, char8, skipWord8, endOfLine, skip, skipWhile, skipSpaces - , take, takeTill, takeWhile, takeWhile1, bytes, bytesCI + , take, takeN, takeTill, takeWhile, takeWhile1, bytes, bytesCI , text -- * Misc , isSpace @@ -150,9 +150,9 @@ fail' msg = Parser (\ kf _ inp -> kf [msg] inp) -- | Parse the complete input, without resupplying -parse_ :: Parser a -> V.Bytes -> Either ParseError a -{-# INLINE parse_ #-} -parse_ (Parser p) inp = snd $ finishParsing (p Failure Success inp) +parse' :: Parser a -> V.Bytes -> Either ParseError a +{-# INLINE parse' #-} +parse' (Parser p) inp = snd $ finishParsing (p Failure Success inp) -- | Parse the complete input, without resupplying, return the rest bytes parse :: Parser a -> V.Bytes -> (V.Bytes, Either ParseError a) @@ -617,6 +617,21 @@ if V.null bs then fail' "Z.Data.Parser.Base.takeWhile1: no satisfied byte" else return bs + +-- | Similar to 'take', but requires the predicate to succeed on next N bytes +-- of input, and take N bytes(no matter if N+1 byte satisfy predicate or not). +-- +takeN :: (Word8 -> Bool) -> Int -> Parser V.Bytes +{-# INLINE takeN #-} +takeN p n = do + bs <- take n + if go bs 0 + then return bs + else fail' "Z.Data.Parser.Base.takeWhileN: byte does not satisfy" + where + go bs@(V.PrimVector _ _ l) !i + | i < l = p (V.unsafeIndex bs i) && go bs (i+1) + | otherwise = True -- | @bytes s@ parses a sequence of bytes that identically match @s@. -- diff --git a/Z/Data/Parser/Numeric.hs b/Z/Data/Parser/Numeric.hs --- a/Z/Data/Parser/Numeric.hs +++ b/Z/Data/Parser/Numeric.hs @@ -13,9 +13,10 @@ module Z.Data.Parser.Numeric ( -- * Decimal - uint, int + uint, int, integer + , uint_, int_ -- * Hex - , hex + , hex, hex', hex_ -- * Fractional , rational , float, double @@ -48,7 +49,8 @@ import qualified Z.Data.Vector.Base as V import qualified Z.Data.Vector.Extra as V -#define WORD64_MAX_DIGITS_LEN 18 +#define WORD64_MAX_DIGITS_LEN 19 +#define INT64_MAX_DIGITS_LEN 18 #define PLUS 43 #define MINUS 45 @@ -57,17 +59,48 @@ #define BIG_E 69 #define C_0 48 --- | Parse and decode an unsigned hex number. The hex digits +-- | Parse and decode an unsigned hex number, fail in case of overflow. The hex digits -- @\'a\'@ through @\'f\'@ may be upper or lower case. -- -- This parser does not accept a leading @\"0x\"@ string, and consider --- sign bit part of the binary hex nibbles, i.e. --- 'parse hex "0xFF" == Right (-1 :: Int8)' +-- sign bit part of the binary hex nibbles, e.g. -- -hex :: (Integral a, Bits a) => Parser a +-- >>> parse' hex "FF" == Right (-1 :: Int8) +-- >>> parse' hex "7F" == Right (127 :: Int8) +-- >>> parse' hex "7Ft" == Right (127 :: Int8) +-- >>> parse' hex "7FF" == Left ["Z.Data.Parser.Numeric.hex","hex numeric number overflow"] +-- +hex :: forall a.(Integral a, FiniteBits a) => Parser a {-# INLINE hex #-} -hex = "Z.Data.Parser.Numeric.hex" hexLoop 0 <$> P.takeWhile1 isHexDigit +hex = "Z.Data.Parser.Numeric.hex" do + bs <- P.takeWhile1 isHexDigit + if V.length bs <= finiteBitSize (undefined :: a) `unsafeShiftR` 2 + then return (hexLoop 0 bs) + else P.fail' "hex numeric number overflow" +-- | Same with 'hex', but only take as many as (bit_size/4) bytes. +-- +-- >>> parse' hex "FF" == Right (-1 :: Int8) +-- >>> parse' hex "7F" == Right (127 :: Int8) +-- >>> parse' hex "7Ft" == Right (127 :: Int8) +-- >>> parse' hex "7FF" == Right (127 :: Int8) +hex' :: forall a.(Integral a, FiniteBits a) => Parser a +{-# INLINE hex' #-} +hex' = "Z.Data.Parser.Numeric.hex'" do + hexLoop 0 <$> + P.takeN isHexDigit (finiteBitSize (undefined :: a) `unsafeShiftR` 2) + where + +-- | Same with 'hex', but silently cast in case of overflow. +-- +-- >>> parse' hex "FF" == Right (-1 :: Int8) +-- >>> parse' hex "7F" == Right (127 :: Int8) +-- >>> parse' hex "7Ft" == Right (127 :: Int8) +-- >>> parse' hex "7FF" == Right (-1 :: Int8) +hex_ :: (Integral a, Bits a) => Parser a +{-# INLINE hex_ #-} +hex_ = "Z.Data.Parser.Numeric.hex_" hexLoop 0 <$> P.takeWhile1 isHexDigit + -- | decode hex digits sequence within an array. hexLoop :: (Integral a, Bits a) => a -- ^ accumulator, usually start from 0 @@ -87,12 +120,33 @@ {-# INLINE isHexDigit #-} isHexDigit w = w - 48 <= 9 || w - 65 <= 5 || w - 97 <= 5 +-- | Same with 'uint', but sliently cast in case of overflow. +uint_ :: forall a. (Integral a, Bounded a) => Parser a +{-# INLINE uint_ #-} +uint_ = "Z.Data.Parser.Numeric.uint_" decLoop 0 <$> P.takeWhile1 isDigit + -- | Parse and decode an unsigned decimal number. -uint :: (Integral a) => Parser a +-- +-- Will fail in case of overflow. +uint :: forall a. (Integral a, Bounded a) => Parser a {-# INLINE uint #-} -uint = "Z.Data.Parser.Numeric.uint" decLoop 0 <$> P.takeWhile1 isDigit +uint = "Z.Data.Parser.Numeric.uint" do + bs <- P.takeWhile1 isDigit + if V.length bs <= WORD64_MAX_DIGITS_LEN + then do + let w64 = decLoop @Word64 0 bs + if w64 <= fromIntegral (maxBound :: a) + then return (fromIntegral w64) + else P.fail' "decimal numeric value overflow" + else do + let w64 = decLoop @Integer 0 bs + if w64 <= fromIntegral (maxBound :: a) + then return (fromIntegral w64) + else P.fail' "decimal numeric value overflow" --- | decode digits sequence within an array. +-- | Decode digits sequence within an array. +-- +-- This function may overflow if result can't fit into type. decLoop :: Integral a => a -- ^ accumulator, usually start from 0 -> V.Bytes @@ -117,17 +171,66 @@ -- | Parse a decimal number with an optional leading @\'+\'@ or @\'-\'@ sign -- character. -int :: (Integral a) => Parser a +-- +-- This parser will fail if overflow happens. +int :: forall a. (Integral a, Bounded a) => Parser a {-# INLINE int #-} int = "Z.Data.Parser.Numeric.int" do w <- P.peek if w == MINUS - then P.skipWord8 *> (negate <$> uint') - else if w == PLUS then P.skipWord8 *> uint' else uint' + then P.skipWord8 *> loopNe + else if w == PLUS then P.skipWord8 *> loop else loop where - -- strip uint's message - uint' = decLoop 0 <$> P.takeWhile1 isDigit + loop = do + bs <- P.takeWhile1 isDigit + if V.length bs <= WORD64_MAX_DIGITS_LEN + then do + let w64 = decLoop @Word64 0 bs + if w64 <= fromIntegral (maxBound :: a) + then return (fromIntegral w64) + else P.fail' "decimal numeric value overflow" + else do + let w64 = decLoop @Integer 0 bs + if w64 <= fromIntegral (maxBound :: a) + then return (fromIntegral w64) + else P.fail' "decimal numeric value overflow" + loopNe = do + bs <- P.takeWhile1 isDigit + if V.length bs <= INT64_MAX_DIGITS_LEN + then do + let i64 = negate (decLoop @Int64 0 bs) + if i64 >= fromIntegral (minBound :: a) + then return (fromIntegral i64) + else P.fail' "decimal numeric value overflow" + else do + let i64 = negate (decLoop @Integer 0 bs) + if i64 >= fromIntegral (minBound :: a) + then return (fromIntegral i64) + else P.fail' "decimal numeric value overflow" +-- | Same with 'int', but sliently cast if overflow happens. +int_ :: (Integral a, Bounded a) => Parser a +{-# INLINE int_ #-} +int_ = "Z.Data.Parser.Numeric.int_" do + w <- P.peek + if w == MINUS + then P.skipWord8 *> (negate <$> loop) + else if w == PLUS then P.skipWord8 *> loop else loop + where + loop = decLoop 0 <$> P.takeWhile1 isDigit + +-- | Parser specifically optimized for 'Integer'. +-- +integer :: Parser Integer +integer = "Z.Data.Parser.Numeric.integer" do + w <- P.peek + if w == MINUS + then P.skipWord8 *> (negate <$> integer') + else if w == PLUS then P.skipWord8 *> integer' else integer' + where + -- strip integer's message + integer' = decLoopIntegerFast <$> P.takeWhile1 isDigit + -- | Parse a rational number. -- -- The syntax accepted by this parser is the same as for 'double'. @@ -153,19 +256,19 @@ -- -- Examples with behaviour identical to 'read': -- --- >parse_ double "3" == ("", Right 3.0) --- >parse_ double "3.1" == ("", Right 3.1) --- >parse_ double "3e4" == ("", Right 30000.0) --- >parse_ double "3.1e4" == ("", Right 31000.0) +-- >parse' double "3" == ("", Right 3.0) +-- >parse' double "3.1" == ("", Right 3.1) +-- >parse' double "3e4" == ("", Right 30000.0) +-- >parse' double "3.1e4" == ("", Right 31000.0) -- --- >parse_ double ".3" == (".3", Left ParserError) --- >parse_ double "e3" == ("e3", Left ParserError) +-- >parse' double ".3" == (".3", Left ParserError) +-- >parse' double "e3" == ("e3", Left ParserError) -- -- Examples of differences from 'read': -- --- >parse_ double "3.foo" == (".foo", Right 3.0) --- >parse_ double "3e" == ("e", Right 3.0) --- >parse_ double "-3e" == ("e", Right -3.0) +-- >parse' double "3.foo" == (".foo", Right 3.0) +-- >parse' double "3e" == ("e", Right 3.0) +-- >parse' double "-3e" == ("e", Right -3.0) -- -- This function does not accept string representations of \"NaN\" or -- \"Infinity\". @@ -252,13 +355,13 @@ -- non-backtrack strict number parser separately using LL(1) lookahead. This parser also -- agree with 'read' on extra dot or e handling: -- --- >parse_ double "3.foo" == Left ParseError --- >parse_ double "3e" == Left ParseError +-- >parse' double "3.foo" == Left ParseError +-- >parse' double "3e" == Left ParseError -- -- Leading zeros or @+@ sign is also not allowed: -- --- >parse_ double "+3.14" == Left ParseError --- >parse_ double "0014" == Left ParseError +-- >parse' double "+3.14" == Left ParseError +-- >parse' double "0014" == Left ParseError -- -- If you have a similar grammer, you can use this parser to save considerable time. -- 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 @@ -119,27 +119,28 @@ import Control.Monad.ST import Control.Monad import Data.Bits -import Data.Char hiding (toLower, toUpper, toTitle) -import Data.Foldable (foldlM) -import Data.Hashable (Hashable(..)) -import qualified Data.List as List +import Data.Char hiding (toLower, toUpper, toTitle) +import qualified Data.CaseInsensitive as CI +import Data.Foldable (foldlM) +import Data.Hashable (Hashable(..)) +import qualified Data.List as List import Data.Primitive.PrimArray import Data.Typeable import Data.Word -import Foreign.C.Types (CSize(..)) +import Foreign.C.Types (CSize(..)) import GHC.Exts import GHC.Types import GHC.Stack -import GHC.CString (unpackCString#, unpackCStringUtf8#) +import GHC.CString (unpackCString#, unpackCStringUtf8#) import Z.Data.Array import Z.Data.Text.UTF8Codec import Z.Data.Text.UTF8Rewind -import Z.Data.Vector.Base (Bytes, PrimVector(..), c_strlen) -import qualified Z.Data.Vector.Base as V -import qualified Z.Data.Vector.Search as V -import System.IO.Unsafe (unsafeDupablePerformIO) +import Z.Data.Vector.Base (Bytes, PrimVector(..), c_strlen) +import qualified Z.Data.Vector.Base as V +import qualified Z.Data.Vector.Search as V +import System.IO.Unsafe (unsafeDupablePerformIO) -import Prelude hiding (concat, concatMap, +import Prelude hiding (concat, concatMap, elem, notElem, null, length, map, foldl, foldl1, foldr, foldr1, maximum, minimum, product, sum, @@ -200,6 +201,11 @@ instance IsString Text where {-# INLINE fromString #-} fromString = pack + +-- | case fold with default locale. +instance CI.FoldCase Text where + {-# INLINE foldCase #-} + foldCase = caseFold -- | /O(n)/ Get the nth codepoint from 'Text', throw 'IndexOutOfTextRange' -- when out of bound. diff --git a/Z/Data/Text/ShowT.hs b/Z/Data/Text/ShowT.hs --- a/Z/Data/Text/ShowT.hs +++ b/Z/Data/Text/ShowT.hs @@ -17,7 +17,7 @@ module Z.Data.Text.ShowT ( -- * ShowT class - ShowT(..), showT, toBuilder, toBytes, toString + ShowT(..), showT, toBuilder, toBytes, toString -- * Textual Builder , TextBuilder , getBuilder @@ -65,14 +65,15 @@ import Data.Proxy (Proxy(..)) import Data.Ratio (Ratio, numerator, denominator) import Data.Tagged (Tagged (..)) -import Data.Word import qualified Data.Semigroup as Semigroup import Data.Typeable import Foreign.C.Types import GHC.Exts -import GHC.Natural +import GHC.ForeignPtr import GHC.Generics +import GHC.Natural import GHC.Stack +import GHC.Word import Data.Version import System.Exit import Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..)) @@ -651,7 +652,17 @@ deriving newtype instance ShowT CFloat deriving newtype instance ShowT CDouble +instance ShowT (Ptr a) where + {-# INLINE toTextBuilder #-} + toTextBuilder _ (Ptr a) = + "0x" >> hex (W# (int2Word#(addr2Int# a))) +instance ShowT (ForeignPtr a) where + {-# INLINE toTextBuilder #-} + toTextBuilder _ (ForeignPtr a _) = + "0x" >> hex (W# (int2Word#(addr2Int# a))) + deriving anyclass instance ShowT ExitCode + deriving anyclass instance ShowT a => ShowT (Semigroup.Min a) deriving anyclass instance ShowT a => ShowT (Semigroup.Max a) deriving anyclass instance ShowT a => ShowT (Semigroup.First a) diff --git a/Z/Data/Vector.hs b/Z/Data/Vector.hs --- a/Z/Data/Vector.hs +++ b/Z/Data/Vector.hs @@ -148,7 +148,7 @@ , Radix(..) , RadixDown(..) -- * QuasiQuoters - , ascii + , vecASCII , vecW8, vecW16, vecW32, vecW64, vecWord , vecI8, vecI16, vecI32, vecI64, vecInt -- * Misc diff --git a/Z/Data/Vector/FlatIntMap.hs b/Z/Data/Vector/FlatIntMap.hs --- a/Z/Data/Vector/FlatIntMap.hs +++ b/Z/Data/Vector/FlatIntMap.hs @@ -325,7 +325,8 @@ foldlWithKey' f a (FlatIntMap vs) = V.foldl' (\ a' (V.IPair k v) -> f a' k v) a vs -- | /O(n)/. --- @'traverseWithKey' f s == 'pack' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('unpack' m)@ +-- +-- @'traverseWithKey' f s == 'pack' \<$\> 'traverse' (\(k, v) -> (,) k \<$\> f k v) ('unpack' m)@ -- That is, behaves exactly like a regular 'traverse' except that the traversing -- function also has access to the key associated with a value. traverseWithKey :: Applicative t => (Int -> a -> t b) -> FlatIntMap a -> t (FlatIntMap b) diff --git a/Z/Data/Vector/FlatMap.hs b/Z/Data/Vector/FlatMap.hs --- a/Z/Data/Vector/FlatMap.hs +++ b/Z/Data/Vector/FlatMap.hs @@ -326,7 +326,8 @@ foldlWithKey' f a (FlatMap vs) = V.foldl' (\ a' (k,v) -> f a' k v) a vs -- | /O(n)/. --- @'traverseWithKey' f s == 'pack' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('unpack' m)@ +-- +-- @'traverseWithKey' f s == 'pack' \<$\> 'traverse' (\(k, v) -> (,) k \<$>\ f k v) ('unpack' m)@ -- That is, behaves exactly like a regular 'traverse' except that the traversing -- function also has access to the key associated with a value. traverseWithKey :: Applicative t => (k -> a -> t b) -> FlatMap k a -> t (FlatMap k b) diff --git a/Z/Data/Vector/QQ.hs b/Z/Data/Vector/QQ.hs --- a/Z/Data/Vector/QQ.hs +++ b/Z/Data/Vector/QQ.hs @@ -7,13 +7,25 @@ Stability : experimental Portability : non-portable -This module provides functions for writing vector literals using 'QuasiQuote'. +This module provides functions for writing vector literals using 'QuasiQuote' similar to "Z.Data.Array.QQ" module. +@ +> :set -XQuasiQuotes +> :t [vecASCII|asdfg|] +[vecASCII|asdfg|] :: Z.Data.Vector.Base.PrimVector GHC.Word.Word8 +> [vecASCII|asdfg|] +[97,115,100,102,103] +> :t [vecI16|1,2,3,4,5|] +[vecI16|1,2,3,4,5|] :: Z.Data.Vector.Base.PrimVector GHC.Int.Int16 +> [vecI16|1,2,3,4,5|] +[1,2,3,4,5] +@ + -} module Z.Data.Vector.QQ ( -- * QuasiQuoters - ascii + vecASCII , vecW8, vecW16, vecW32, vecW64, vecWord , vecI8, vecI16, vecI32, vecI64, vecInt ) where @@ -25,12 +37,12 @@ -------------------------------------------------------------------------------- -- Quoters -ascii :: QQ.QuasiQuoter -ascii = QQ.QuasiQuoter +vecASCII :: QQ.QuasiQuoter +vecASCII = QQ.QuasiQuoter (asciiLiteral $ \ len addr -> [| PrimVector (QQ.word8ArrayFromAddr $(len) $(addr)) 0 $(len) |]) - (error "Cannot use ascii as a pattern") - (error "Cannot use ascii as a type") - (error "Cannot use ascii as a dec") + (error "Cannot use vecASCII as a pattern") + (error "Cannot use vecASCII as a type") + (error "Cannot use vecASCII as a dec") vecW8 :: QQ.QuasiQuoter vecW8 = QQ.QuasiQuoter @@ -107,4 +119,3 @@ (error "Cannot use vecInt as a pattern") (error "Cannot use vecInt as a type") (error "Cannot use vecInt as a dec") - diff --git a/Z/Foreign.hs b/Z/Foreign.hs --- a/Z/Foreign.hs +++ b/Z/Foreign.hs @@ -82,6 +82,7 @@ , castPtr , fromNullTerminated, fromPtr, fromPrimPtr -- ** re-export + , RealWorld , module Data.Primitive.ByteArray , module Data.Primitive.PrimArray , module Foreign.C.Types @@ -130,8 +131,6 @@ -- USE THIS TYPE WITH UNSAFE FFI CALL ONLY. A 'MutableByteArray#' COULD BE MOVED BY GC DURING SAFE FFI CALL. type MBA# a = MutableByteArray# RealWorld - - -- | Type alias for 'ArrayArray#'. -- -- Describe a array of 'ByteArray#' which we are going to pass across FFI. Use this type with @UnliftedFFITypes@ @@ -430,7 +429,7 @@ -- | Copy some bytes from a null terminated pointer(without copying the null terminator). -- --- You should consider using 'Z.Data.CBytes' type for storing NULL terminated bytes first, +-- You should consider using 'Z.Data.CBytes.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 @@ -466,4 +465,3 @@ copyPtrToMutablePrimArray marr 0 (Ptr addr#) len arr <- unsafeFreezePrimArray marr return (PrimVector arr 0 len) - diff --git a/test/Z/Data/Parser/BaseSpec.hs b/test/Z/Data/Parser/BaseSpec.hs --- a/test/Z/Data/Parser/BaseSpec.hs +++ b/test/Z/Data/Parser/BaseSpec.hs @@ -20,7 +20,7 @@ parse' :: P.Parser a -> [Word8] -> Maybe a -parse' p str = case P.parse_ p (V.pack str) of +parse' p str = case P.parse' p (V.pack str) of Left msg -> Nothing Right a -> Just a diff --git a/test/Z/Data/Parser/NumericSpec.hs b/test/Z/Data/Parser/NumericSpec.hs --- a/test/Z/Data/Parser/NumericSpec.hs +++ b/test/Z/Data/Parser/NumericSpec.hs @@ -26,74 +26,74 @@ spec = do describe "numeric parsers roundtrip" . modifyMaxSuccess (*10) . modifyMaxSize (*10) $ do prop "positive hex roundtrip" $ \ i -> - P.parse_ P.hex (B.buildBytes (B.hex i)) === Right (i :: Int) + P.parse' P.hex (B.buildBytes (B.hex i)) === Right (i :: Int) prop "positive hex roundtrip" $ \ i -> - P.parse_ P.hex (B.buildBytes (B.hex i)) === Right (i :: Int64) + P.parse' P.hex (B.buildBytes (B.hex i)) === Right (i :: Int64) prop "positive hex roundtrip" $ \ i -> - P.parse_ P.hex (B.buildBytes (B.hex i)) === Right (i :: Int32) + P.parse' P.hex (B.buildBytes (B.hex i)) === Right (i :: Int32) prop "positive hex roundtrip" $ \ i -> - P.parse_ P.hex (B.buildBytes (B.hex i)) === Right (i :: Int16) + P.parse' P.hex (B.buildBytes (B.hex i)) === Right (i :: Int16) prop "positive hex roundtrip" $ \ i -> - P.parse_ P.hex (B.buildBytes (B.hex i)) === Right (i :: Int8) + P.parse' P.hex (B.buildBytes (B.hex i)) === Right (i :: Int8) prop "positive hex roundtrip" $ \ i -> - P.parse_ P.hex (B.buildBytes (B.hex i)) === Right (i :: Word) + P.parse' P.hex (B.buildBytes (B.hex i)) === Right (i :: Word) prop "positive hex roundtrip" $ \ i -> - P.parse_ P.hex (B.buildBytes (B.hex i)) === Right (i :: Word64) + P.parse' P.hex (B.buildBytes (B.hex i)) === Right (i :: Word64) prop "positive hex roundtrip" $ \ i -> - P.parse_ P.hex (B.buildBytes (B.hex i)) === Right (i :: Word32) + P.parse' P.hex (B.buildBytes (B.hex i)) === Right (i :: Word32) prop "positive hex roundtrip" $ \ i -> - P.parse_ P.hex (B.buildBytes (B.hex i)) === Right (i :: Word16) + P.parse' P.hex (B.buildBytes (B.hex i)) === Right (i :: Word16) prop "positive hex roundtrip" $ \ i -> - P.parse_ P.hex (B.buildBytes (B.hex i)) === Right (i :: Word8) + P.parse' P.hex (B.buildBytes (B.hex i)) === Right (i :: Word8) prop "positive int roundtrip" $ \ (Positive i) -> - P.parse_ P.uint (B.buildBytes (B.int i)) === Right (i :: Int) + P.parse' P.uint (B.buildBytes (B.int i)) === Right (i :: Int) prop "positive int roundtrip" $ \ (Positive i) -> - P.parse_ P.uint (B.buildBytes (B.int i)) === Right (i :: Int64) + P.parse' P.uint (B.buildBytes (B.int i)) === Right (i :: Int64) prop "positive int roundtrip" $ \ (Positive i) -> - P.parse_ P.uint (B.buildBytes (B.int i)) === Right (i :: Int32) + P.parse' P.uint (B.buildBytes (B.int i)) === Right (i :: Int32) prop "positive int roundtrip" $ \ (Positive i) -> - P.parse_ P.uint (B.buildBytes (B.int i)) === Right (i :: Int16) + P.parse' P.uint (B.buildBytes (B.int i)) === Right (i :: Int16) prop "positive int roundtrip" $ \ (Positive i) -> - P.parse_ P.uint (B.buildBytes (B.int i)) === Right (i :: Int8) + P.parse' P.uint (B.buildBytes (B.int i)) === Right (i :: Int8) prop "positive int roundtrip" $ \ (Positive i) -> - P.parse_ P.uint (B.buildBytes (B.int i)) === Right (i :: Word) + P.parse' P.uint (B.buildBytes (B.int i)) === Right (i :: Word) prop "positive int roundtrip" $ \ (Positive i) -> - P.parse_ P.uint (B.buildBytes (B.int i)) === Right (i :: Word64) + P.parse' P.uint (B.buildBytes (B.int i)) === Right (i :: Word64) prop "positive int roundtrip" $ \ (Positive i) -> - P.parse_ P.uint (B.buildBytes (B.int i)) === Right (i :: Word32) + P.parse' P.uint (B.buildBytes (B.int i)) === Right (i :: Word32) prop "positive int roundtrip" $ \ (Positive i) -> - P.parse_ P.uint (B.buildBytes (B.int i)) === Right (i :: Word16) + P.parse' P.uint (B.buildBytes (B.int i)) === Right (i :: Word16) prop "positive int roundtrip" $ \ (Positive i) -> - P.parse_ P.uint (B.buildBytes (B.int i)) === Right (i :: Word8) + P.parse' P.uint (B.buildBytes (B.int i)) === Right (i :: Word8) prop "positive int roundtrip" $ \ i -> - P.parse_ P.int (B.buildBytes (B.int i)) === Right (i :: Int) + P.parse' P.int (B.buildBytes (B.int i)) === Right (i :: Int) prop "positive int roundtrip" $ \ i -> - P.parse_ P.int (B.buildBytes (B.int i)) === Right (i :: Int64) + P.parse' P.int (B.buildBytes (B.int i)) === Right (i :: Int64) prop "positive int roundtrip" $ \ i -> - P.parse_ P.int (B.buildBytes (B.int i)) === Right (i :: Int32) + P.parse' P.int (B.buildBytes (B.int i)) === Right (i :: Int32) prop "positive int roundtrip" $ \ i -> - P.parse_ P.int (B.buildBytes (B.int i)) === Right (i :: Int16) + P.parse' P.int (B.buildBytes (B.int i)) === Right (i :: Int16) prop "positive int roundtrip" $ \ i -> - P.parse_ P.int (B.buildBytes (B.int i)) === Right (i :: Int8) + P.parse' P.int (B.buildBytes (B.int i)) === Right (i :: Int8) prop "positive int roundtrip" $ \ i -> - P.parse_ P.int (B.buildBytes (B.int i)) === Right (i :: Word) + P.parse' P.int (B.buildBytes (B.int i)) === Right (i :: Word) prop "positive int roundtrip" $ \ i -> - P.parse_ P.int (B.buildBytes (B.int i)) === Right (i :: Word64) + P.parse' P.int (B.buildBytes (B.int i)) === Right (i :: Word64) prop "positive int roundtrip" $ \ i -> - P.parse_ P.int (B.buildBytes (B.int i)) === Right (i :: Word32) + P.parse' P.int (B.buildBytes (B.int i)) === Right (i :: Word32) prop "positive int roundtrip" $ \ i -> - P.parse_ P.int (B.buildBytes (B.int i)) === Right (i :: Word16) + P.parse' P.int (B.buildBytes (B.int i)) === Right (i :: Word16) prop "positive int roundtrip" $ \ i -> - P.parse_ P.int (B.buildBytes (B.int i)) === Right (i :: Word8) + P.parse' P.int (B.buildBytes (B.int i)) === Right (i :: Word8) prop "float roundtrip" $ \ i -> - P.parse_ P.float (B.buildBytes (B.float i)) === Right (i :: Float) + P.parse' P.float (B.buildBytes (B.float i)) === Right (i :: Float) prop "double roundtrip" $ \ i -> - P.parse_ P.double (B.buildBytes (B.double i)) === Right (i :: Double) + P.parse' P.double (B.buildBytes (B.double i)) === Right (i :: Double) describe "floatToScientific, doubleToScientific === fromFloatDigits" $ do prop "floatToScientific == fromFloatDigits" $ \ i ->