diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for Z-Data +## 0.8.3.0 -- 2021-06-02 + +* Fix numeric literals' `Print` instances when precedence > 6 and value < 0. +* Add `no-avx` build flag to run tests on VMs without AVX support. + ## 0.8.2.0 -- 2021-05-10 * Add `withCPtrs`, `withCPtrsUnsafe` to `Z.Foreign.CPtr`. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,6 +5,9 @@ [![macOS Build Status](https://github.com/ZHaskell/z-data/workflows/osx-ci/badge.svg)](https://github.com/ZHaskell/z-data/actions) [![Windows Build Status](https://github.com/ZHaskell/z-data/workflows/win-ci/badge.svg)](https://github.com/ZHaskell/z-data/actions) [![Gitter chat](https://badges.gitter.im/gitterHQ/gitter.svg)](https://gitter.im/Z-Haskell/community) + + + This package is part of [ZHaskell](https://z.haskell.world) project, providing basic data structures and functions: 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.8.2.0 +version: 0.8.3.0 synopsis: Array, vector and text description: This package provides array, slice and text operations license: BSD-3-Clause @@ -115,6 +115,15 @@ default: False manual: True +flag no-avx + description: + Do not use AVX instructions(utf8 validation, base64 codec, etc), this is added for + making some cached code runnable on VMs where AVX is not available. + + default: False + manual: True + + library exposed-modules: Z.Data.Array @@ -272,6 +281,9 @@ build-tool-depends: hsc2hs:hsc2hs -any cc-options: -march=native -Wno-sign-compare + if flag(no-avx) + cc-options: -DNO_AVX + -- currently it's ignored, see https://github.com/haskell/cabal/pull/6226 -- we work around this issue using Setup.hs cxx-options: -std=c++11 @@ -371,3 +383,6 @@ else cpp-options: -DINTEGER_GMP build-depends: integer-gmp >=0.2 && <1.2 + + if flag(no-avx) + cc-options: -DNO_AVX diff --git a/Z/Data/Builder.hs b/Z/Data/Builder.hs --- a/Z/Data/Builder.hs +++ b/Z/Data/Builder.hs @@ -56,7 +56,7 @@ , scientific' , scientificWith -- * Builder helpers - , paren, curly, square, angle, quotes, squotes, colon, comma, intercalateVec, intercalateList + , paren, parenWhen, curly, square, angle, quotes, squotes, colon, comma, intercalateVec, intercalateList -- * Time , day , timeOfDay diff --git a/Z/Data/Builder/Base.hs b/Z/Data/Builder/Base.hs --- a/Z/Data/Builder/Base.hs +++ b/Z/Data/Builder/Base.hs @@ -49,7 +49,7 @@ , stringModifiedUTF8, charModifiedUTF8, stringUTF8 , charUTF8, string7, char7, word7, string8, char8, word8, word8N, text -- * Builder helpers - , paren, curly, square, angle, quotes, squotes, colon, comma, intercalateVec, intercalateList + , paren, parenWhen, curly, square, angle, quotes, squotes, colon, comma, intercalateVec, intercalateList ) where import Control.Monad @@ -494,6 +494,14 @@ paren :: Builder () -> Builder () {-# INLINE paren #-} paren b = encodePrim PAREN_LEFT >> b >> encodePrim PAREN_RIGHT + +-- | Add "(..)" around builders when condition is met, otherwise add nothing. +-- +-- This is useful when defining 'Print' instances. +parenWhen :: Bool -> Builder () -> Builder () +{-# INLINE parenWhen #-} +parenWhen True b = paren b +parenWhen _ b = b -- | add @{...}@ to original builder. curly :: Builder () -> Builder () 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 @@ -133,13 +133,13 @@ | x < 0 = let !x' = (fromIntegral (complement x) :: Word64) + 1 in ensureN width' (\ (MutablePrimArray mba#) i -> - (c_int_dec x' (-1) width pad (unsafeCoerce# mba#) i)) + (c_int_dec x' (-1) width pad mba# i)) | posSign = ensureN width' (\ (MutablePrimArray mba#) i -> - (c_int_dec (fromIntegral x) 1 width pad (unsafeCoerce# mba#) i)) + (c_int_dec (fromIntegral x) 1 width pad mba# i)) | otherwise = ensureN width' (\ (MutablePrimArray mba#) i -> - (c_int_dec (fromIntegral x) 0 width pad (unsafeCoerce# mba#) i)) + (c_int_dec (fromIntegral x) 0 width pad mba# i)) where width' = max 21 width pad = case padding of NoPadding -> 0 diff --git a/Z/Data/Generics/Utils.hs b/Z/Data/Generics/Utils.hs --- a/Z/Data/Generics/Utils.hs +++ b/Z/Data/Generics/Utils.hs @@ -16,6 +16,8 @@ module Z.Data.Generics.Utils ( ProductSize(..) , productSize + , SumSize(..) + , sumSize ) where import GHC.Generics @@ -34,3 +36,17 @@ productSize :: forall f. KnownNat (PSize f) => Proxy# f -> Int {-# INLINE productSize #-} productSize _ = fromIntegral (natVal' (proxy# :: Proxy# (PSize f))) + + +class KnownNat (SSize f) => SumSize (f :: * -> *) where + type SSize f :: Nat + +instance SumSize (C1 c a) where + type SSize (C1 c a) = 1 + +instance (KnownNat (SSize a + SSize b), SumSize a, SumSize b) => SumSize (a :+: b) where + type SSize (a :+: b) = SSize a + SSize b + +sumSize :: forall f. KnownNat (SSize f) => Proxy# f -> Int +{-# INLINE sumSize #-} +sumSize _ = fromIntegral (natVal' (proxy# :: Proxy# (SSize f))) 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 @@ -166,9 +166,12 @@ decodeChunks = P.parseChunks decodeChunk -- | Directly encode data to JSON bytes. +-- +-- This function use 'B.buildWith' 'V.smallChunkSize' to balance common use case, if you need fine tuning on memory usage, +-- please use 'B.buildWith' and a custom initial chunk size with 'encodeJSON'. encode :: JSON a => a -> V.Bytes {-# INLINE encode #-} -encode = B.build . encodeJSON +encode = B.buildWith V.smallChunkSize . encodeJSON -- | Encode data to JSON bytes chunks. encodeChunks :: JSON a => a -> [V.Bytes] 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 @@ -1071,15 +1071,18 @@ -} isCategory :: Category -> Text -> Bool +{-# INLINE isCategory #-} isCategory c (Text (V.PrimVector (PrimArray arr#) (I# s#) l@(I# l#))) | l == 0 = True | otherwise = utf8_iscategory arr# s# l# c == l + {-| Try to match as many code points with the matching category flags as possible and return the prefix and suffix. -} spanCategory :: Category -> Text -> (Text, Text) +{-# INLINE spanCategory #-} spanCategory c (Text (V.PrimVector arr@(PrimArray arr#) s@(I# s#) l@(I# l#))) | l == 0 = (empty, empty) | otherwise = diff --git a/Z/Data/Text/Print.hs b/Z/Data/Text/Print.hs --- a/Z/Data/Text/Print.hs +++ b/Z/Data/Text/Print.hs @@ -50,9 +50,8 @@ , B.scientific' , B.scientificWith -- * Helpers - , B.paren, B.curly, B.square, B.angle, B.quotes, B.squotes + , B.paren, B.parenWhen, B.curly, B.square, B.angle, B.quotes, B.squotes , B.colon, B.comma, B.intercalateVec, B.intercalateList - , parenWhen ) where import Control.Monad @@ -195,7 +194,7 @@ instance (GFieldToText (S1 sc f), Constructor c) => GToText (C1 c (S1 sc f)) where {-# INLINE gToUTF8BuilderP #-} gToUTF8BuilderP p m1@(M1 x) = - parenWhen (p > 10) $ do + B.parenWhen (p > 10) $ do B.stringModifiedUTF8 $ conName m1 B.char8 ' ' if conIsRecord m1 @@ -206,13 +205,13 @@ {-# INLINE gToUTF8BuilderP #-} gToUTF8BuilderP p m1@(M1 x) = case conFixity m1 of - Prefix -> parenWhen (p > 10) $ do + Prefix -> B.parenWhen (p > 10) $ do B.stringModifiedUTF8 $ conName m1 B.char8 ' ' if conIsRecord m1 then B.curly $ gFieldToUTF8BuilderP (B.char7 ',' >> B.char7 ' ') p x else gFieldToUTF8BuilderP (B.char7 ' ') 11 x - Infix _ p' -> parenWhen (p > p') $ do + Infix _ p' -> B.parenWhen (p > p') $ do gFieldToUTF8BuilderP (B.char8 ' ' >> B.stringModifiedUTF8 (conName m1) >> B.char8 ' ') (p'+1) x @@ -220,14 +219,6 @@ {-# INLINE gToUTF8BuilderP #-} gToUTF8BuilderP p (K1 x) = toUTF8BuilderP p x --- | Add "(..)" around builders when condition is met, otherwise add nothing. --- --- This is useful when defining 'Print' instances. -parenWhen :: Bool -> B.Builder () -> B.Builder () -{-# INLINE parenWhen #-} -parenWhen True b = B.paren b -parenWhen _ b = b - -------------------------------------------------------------------------------- -- Data types instance GToText f => GToText (D1 c f) where @@ -244,21 +235,21 @@ {-# INLINE toUTF8BuilderP #-} toUTF8BuilderP _ = B.string8 . show -instance Print Double where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.double;} -instance Print Float where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.float;} +instance Print Double where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP p x = B.parenWhen (p > 6 && x < 0) (B.double x) ;} +instance Print Float where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP p x = B.parenWhen (p > 6 && x < 0) (B.float x) ;} -instance Print Int where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;} -instance Print Int8 where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;} -instance Print Int16 where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;} -instance Print Int32 where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;} -instance Print Int64 where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;} +instance Print Int where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP p x = B.parenWhen (p > 6 && x < 0) (B.int x) ;} +instance Print Int8 where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP p x = B.parenWhen (p > 6 && x < 0) (B.int x) ;} +instance Print Int16 where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP p x = B.parenWhen (p > 6 && x < 0) (B.int x) ;} +instance Print Int32 where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP p x = B.parenWhen (p > 6 && x < 0) (B.int x) ;} +instance Print Int64 where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP p x = B.parenWhen (p > 6 && x < 0) (B.int x) ;} instance Print Word where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;} instance Print Word8 where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;} instance Print Word16 where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;} instance Print Word32 where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;} instance Print Word64 where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;} -instance Print Integer where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.integer;} +instance Print Integer where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP p x = B.parenWhen (p > 6 && x < 0) (B.integer x) ;} instance Print Natural where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.integer . fromIntegral} instance Print Ordering where {-# INLINE toUTF8BuilderP #-} @@ -312,7 +303,7 @@ instance Print Sci.Scientific where {-# INLINE toUTF8BuilderP #-} - toUTF8BuilderP _ = B.scientific + toUTF8BuilderP p x = B.parenWhen (p > 6 && x < 0) (B.scientific x) instance Print a => Print [a] where {-# INLINE toUTF8BuilderP #-} @@ -389,17 +380,17 @@ instance Print a => Print (Maybe a) where {-# INLINE toUTF8BuilderP #-} - toUTF8BuilderP p (Just x) = parenWhen (p > 10) $ "Just " >> toUTF8BuilderP 11 x + toUTF8BuilderP p (Just x) = B.parenWhen (p > 10) $ "Just " >> toUTF8BuilderP 11 x toUTF8BuilderP _ _ = "Nothing" instance (Print a, Print b) => Print (Either a b) where {-# INLINE toUTF8BuilderP #-} - toUTF8BuilderP p (Left x) = parenWhen (p > 10) $ "Left " >> toUTF8BuilderP 11 x - toUTF8BuilderP p (Right x) = parenWhen (p > 10) $ "Right " >> toUTF8BuilderP 11 x + toUTF8BuilderP p (Left x) = B.parenWhen (p > 10) $ "Left " >> toUTF8BuilderP 11 x + toUTF8BuilderP p (Right x) = B.parenWhen (p > 10) $ "Right " >> toUTF8BuilderP 11 x instance (Print a, Integral a) => Print (Ratio a) where {-# INLINE toUTF8BuilderP #-} - toUTF8BuilderP p r = parenWhen (p > 10) $ do + toUTF8BuilderP p r = B.parenWhen (p > 7) $ do toUTF8BuilderP 8 (numerator r) " % " toUTF8BuilderP 8 (denominator r) @@ -504,7 +495,7 @@ instance Print SystemTime where {-# INLINE toUTF8BuilderP #-} - toUTF8BuilderP p (MkSystemTime s ns) = parenWhen (p > 10) $ do + toUTF8BuilderP p (MkSystemTime s ns) = B.parenWhen (p > 10) $ do "MkSystemTime {systemSeconds = " B.int s ", systemNanoseconds = " @@ -513,7 +504,7 @@ instance Print CalendarDiffTime where {-# INLINE toUTF8BuilderP #-} - toUTF8BuilderP p (CalendarDiffTime m nt) = parenWhen (p > 10) $ do + toUTF8BuilderP p (CalendarDiffTime m nt) = B.parenWhen (p > 10) $ do B.encodePrim LETTER_P B.integer m B.encodePrim (LETTER_M, LETTER_T) @@ -522,7 +513,7 @@ instance Print CalendarDiffDays where {-# INLINE toUTF8BuilderP #-} - toUTF8BuilderP p (CalendarDiffDays m d) = parenWhen (p > 10) $ do + toUTF8BuilderP p (CalendarDiffDays m d) = B.parenWhen (p > 10) $ do B.encodePrim LETTER_P B.integer m B.encodePrim LETTER_M diff --git a/cbits/bytes.c b/cbits/bytes.c --- a/cbits/bytes.c +++ b/cbits/bytes.c @@ -255,9 +255,9 @@ } void hs_base64_encode(uint8_t* output, HsInt output_off, const uint8_t* input, HsInt off, HsInt len){ -#if defined(__AVX2__) +#if defined(__AVX2__) && !defined(NO_AVX) tb64avx2enc(input+off, (size_t)len, output+output_off); -#elif defined(__AVX__) +#elif defined(__AVX__) && !defined(NO_AVX) tb64avxenc(input+off, (size_t)len, output+output_off); #elif defined(__SSE3__) tb64sseenc(input+off, (size_t)len, output+output_off); @@ -267,9 +267,9 @@ } HsInt hs_base64_decode(uint8_t* output, const uint8_t* input, HsInt off, HsInt len){ -#if defined(__AVX2__) +#if defined(__AVX2__) && !defined(NO_AVX) return (HsInt)tb64avx2dec(input+off, (size_t)len, output); -#elif defined(__AVX__) +#elif defined(__AVX__) && !defined(NO_AVX) return (HsInt)tb64avxdec(input+off, (size_t)len, output); #elif defined(__SSE3__) return (HsInt)tb64ssedec(input+off, (size_t)len, output); diff --git a/cbits/text.c b/cbits/text.c --- a/cbits/text.c +++ b/cbits/text.c @@ -37,7 +37,7 @@ HsInt ascii_validate(const char* p, HsInt off, HsInt len){ const char* q = p + off; -#if defined(__AVX2__) +#if defined(__AVX2__) && !defined(NO_AVX) return (HsInt)validate_ascii_fast_avx(q, (size_t)len); #elif defined(__SSE2__) return (HsInt)validate_ascii_fast(q, (size_t)len); @@ -48,7 +48,7 @@ // for some reason unknown, on windows we have to supply a seperated version of ascii_validate // otherwise we got segfault if we import the same FFI with different type (Addr# vs ByteArray#) HsInt ascii_validate_addr(const char* p, HsInt len){ -#if defined(__AVX2__) +#if defined(__AVX2__) && !defined(NO_AVX) return (HsInt)validate_ascii_fast_avx(p, (size_t)len); #elif defined(__SSE2__) return (HsInt)validate_ascii_fast(p, (size_t)len); @@ -59,7 +59,7 @@ HsInt utf8_validate(const char* p, HsInt off, HsInt len){ const char* q = p + off; -#if defined(__AVX2__) +#if defined(__AVX2__) && !defined(NO_AVX) return (HsInt)validate_utf8_fast_avx(q, (size_t)len); #elif defined(__SSE2__) return (HsInt)validate_utf8_fast(q, (size_t)len); @@ -70,7 +70,7 @@ // for some reason unknown, on windows we have to supply a seperated version of utf8_validate // otherwise we got segfault if we import the same FFI with different type (Addr# vs ByteArray#) HsInt utf8_validate_addr(const char* p, HsInt len){ -#if defined(__AVX2__) +#if defined(__AVX2__) && !defined(NO_AVX) return (HsInt)validate_utf8_fast_avx(p, (size_t)len); #elif defined(__SSE2__) return (HsInt)validate_utf8_fast(p, (size_t)len); diff --git a/test/Z/Data/Text/BaseSpec.hs b/test/Z/Data/Text/BaseSpec.hs --- a/test/Z/Data/Text/BaseSpec.hs +++ b/test/Z/Data/Text/BaseSpec.hs @@ -7,14 +7,41 @@ import qualified Data.List as List import Data.Word import qualified Z.Data.Text.Base as T +import qualified Z.Data.Vector.Base as V import Test.QuickCheck import Test.QuickCheck.Function import Test.QuickCheck.Property import Test.Hspec +import Test.HUnit import Test.Hspec.QuickCheck spec :: Spec spec = describe "text-base" $ do + + it "text validate cases" $ do + T.validateMaybe (V.pack [0xc0, 0xaf ]) @=? Nothing + T.validateMaybe (V.pack [0xe0, 0x80, 0xaf ]) @=? Nothing + T.validateMaybe (V.pack [0xf0, 0x80, 0x80, 0xaf ]) @=? Nothing + T.validateMaybe (V.pack [0xf8, 0x80, 0x80, 0x80, 0xaf ]) @=? Nothing + T.validateMaybe (V.pack [0xfc, 0x80, 0x80, 0x80, 0x80, 0xaf]) @=? Nothing + + T.validateMaybe (V.pack [0xed, 0xa0, 0x80] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xad, 0xbf] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xae, 0x80] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xaf, 0xbf] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xb0, 0x80] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xbe, 0x80] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xbf, 0xbf] ) @=? Nothing + + T.validateMaybe (V.pack [0xed, 0xa0, 0x80, 0xed, 0xb0, 0x80] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xa0, 0x80, 0xed, 0xbf, 0xbf] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xad, 0xbf, 0xed, 0xb0, 0x80] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xad, 0xbf, 0xed, 0xbf, 0xbf] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xae, 0x80, 0xed, 0xb0, 0x80] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xae, 0x80, 0xed, 0xbf, 0xbf] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xaf, 0xbf, 0xed, 0xb0, 0x80] ) @=? Nothing + T.validateMaybe (V.pack [0xed, 0xaf, 0xbf, 0xed, 0xbf, 0xbf] ) @=? Nothing + describe "text Eq Ord property" $ do prop "text eq === List.eq" $ \ xs ys -> (T.pack xs == T.pack ys) === (xs == ys) diff --git a/test/Z/Data/Text/PrintSpec.hs b/test/Z/Data/Text/PrintSpec.hs --- a/test/Z/Data/Text/PrintSpec.hs +++ b/test/Z/Data/Text/PrintSpec.hs @@ -36,7 +36,7 @@ infixl 6 :- spec :: Spec -spec = describe "JSON Base instances" $ do +spec = describe "Print Base instances" $ do it "Nullary constructor are encoded as text" $ toText (Nullary :: T Integer) === "Nullary"