diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,15 @@ # Revision history for byteslice +## 0.2.4.0 -- 2020-10-15 + +* Add `toByteString` and `fromByteString`. +* Add `fromShortByteString`. +* Add `equalsLatin(9|10|11|12)`. +* Add `toPinnedByteArray`, `toPinnedByteArrayClone`, and `concatPinnedU`. +* Add `toLowerAsciiByteArrayClone`. +* Add `intercalateByte2`. +* Add `splitEnd1`. + ## 0.2.3.0 -- 2020-04-30 * Add `fnv1a32` and `fnv1a64`, implementations of the 32-bit and diff --git a/byteslice.cabal b/byteslice.cabal --- a/byteslice.cabal +++ b/byteslice.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: byteslice -version: 0.2.3.0 +version: 0.2.4.0 synopsis: Slicing managed and unmanaged memory description: This library provides types that allow the user to talk about a slice of @@ -13,10 +13,14 @@ license-file: LICENSE author: Andrew Martin maintainer: andrew.thaddeus@gmail.com -copyright: 2019 Andrew Martin +copyright: 2020 Andrew Martin category: Data extra-source-files: CHANGELOG.md +flag avoid-rawmemchr + default: True + description: Avoid using rawmemchr which is non-portable GNU libc only + library exposed-modules: Data.Bytes @@ -31,6 +35,7 @@ UnliftedBytes build-depends: , base >=4.11.1 && <5 + , bytestring >=0.10.8 && <0.11 , primitive >=0.7 && <0.8 , primitive-unlifted >=0.1.2 && <0.2 , primitive-addr >=0.1 && <0.2 @@ -49,6 +54,8 @@ includes: bs_custom.h install-includes: bs_custom.h c-sources: cbits/bs_custom.c + if flag(avoid-rawmemchr) + cc-options: -DAVOID_RAWMEMCHR=1 test-suite test default-language: Haskell2010 diff --git a/cbits/bs_custom.c b/cbits/bs_custom.c --- a/cbits/bs_custom.c +++ b/cbits/bs_custom.c @@ -19,7 +19,7 @@ p = p + off; total = 0; for (szIx = 0; szIx < sizesLen; ++szIx) { -#ifdef __linux__ +#if defined(__linux__) && !AVOID_RAWMEMCHR pos = (unsigned char*)(rawmemchr((void*)p,(int)w)); delta = (HsInt)(pos - p); #else diff --git a/src/Data/Bytes.hs b/src/Data/Bytes.hs --- a/src/Data/Bytes.hs +++ b/src/Data/Bytes.hs @@ -1,7 +1,9 @@ {-# language BangPatterns #-} {-# language BlockArguments #-} +{-# language DuplicateRecordFields #-} {-# language MagicHash #-} {-# language NamedFieldPuns #-} +{-# language RankNTypes #-} {-# language TypeApplications #-} {-# language UnboxedTuples #-} @@ -11,6 +13,7 @@ -- * Constants , Pure.empty , Pure.emptyPinned + , Pure.emptyPinnedU -- * Properties , null , Pure.length @@ -46,18 +49,23 @@ -- * Common Folds , elem -- * Splitting + -- ** Unlimited , Byte.split , Byte.splitU , Byte.splitInit , Byte.splitInitU , Byte.splitNonEmpty , Byte.splitStream + -- ** Fixed from Beginning , Byte.split1 , Byte.split2 , Byte.split3 , Byte.split4 + -- ** Fixed from End + , Byte.splitEnd1 -- * Combining , intercalate + , intercalateByte2 -- * Counting , Byte.count -- * Prefix and Suffix @@ -84,6 +92,10 @@ , equalsLatin6 , equalsLatin7 , equalsLatin8 + , equalsLatin9 + , equalsLatin10 + , equalsLatin11 + , equalsLatin12 -- ** C Strings , equalsCString -- * Hashing @@ -102,11 +114,19 @@ -- * Conversion , Pure.toByteArray , Pure.toByteArrayClone + , Pure.toPinnedByteArray + , Pure.toPinnedByteArrayClone , fromAsciiString , fromLatinString , Pure.fromByteArray , toLatinString , fromCString# + , toByteString + , fromByteString + , fromShortByteString + , toShortByteString + , toShortByteStringClone + , toLowerAsciiByteArrayClone -- * I\/O with Handles , BIO.hGet , readFile @@ -116,7 +136,10 @@ import Prelude hiding (length,takeWhile,dropWhile,null,foldl,foldr,elem,replicate,any,all,readFile) import Control.Monad.Primitive (PrimMonad,primitive_,unsafeIOToPrim) +import Control.Monad.ST (ST) import Control.Monad.ST.Run (runByteArrayST) +import Data.ByteString (ByteString) +import Data.ByteString.Short.Internal (ShortByteString(SBS)) import Data.Bytes.Compat (cstringLength#) import Data.Bytes.Pure (length,fromByteArray) import Data.Bytes.Types (Bytes(Bytes,array,offset)) @@ -126,17 +149,23 @@ import Foreign.Ptr (Ptr,plusPtr,castPtr) import GHC.Exts (Int(I#),Char(C#),Ptr(Ptr),word2Int#,chr#) import GHC.Exts (Addr#,Word#,Int#) +import GHC.IO (unsafeIOToST) import GHC.Word (Word8(W8#)) +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Internal as ByteString +import qualified Data.ByteString.Unsafe as ByteString import qualified Data.Bytes.Byte as Byte import qualified Data.Bytes.Chunks as Chunks import qualified Data.Bytes.IO as BIO import qualified Data.Bytes.Pure as Pure +import qualified Data.Bytes.Types as Types import qualified Data.Foldable as F import qualified Data.List as List import qualified Data.Primitive as PM import qualified Data.Primitive.Ptr as PM import qualified GHC.Exts as Exts +import qualified GHC.ForeignPtr as ForeignPtr -- | Is the byte sequence empty? null :: Bytes -> Bool @@ -408,7 +437,7 @@ -- | Convert a 'String' consisting of only characters representable -- by ISO-8859-1. These are encoded with ISO-8859-1. Any character --- with a codepoint above @U+00FF@ is replace an unspecified byte. +-- with a codepoint above @U+00FF@ is replaced by an unspecified byte. fromLatinString :: String -> Bytes fromLatinString = fromByteArray . Exts.fromList . map (fromIntegral @Int @Word8 . ord) @@ -518,6 +547,72 @@ c7 == indexCharArray arr (off + 7) _ -> False +-- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text, +-- a 9-tuple whose elements match the characters? +equalsLatin9 :: Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool +equalsLatin9 !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 !c8 (Bytes arr off len) = case len of + 9 -> c0 == indexCharArray arr off && + c1 == indexCharArray arr (off + 1) && + c2 == indexCharArray arr (off + 2) && + c3 == indexCharArray arr (off + 3) && + c4 == indexCharArray arr (off + 4) && + c5 == indexCharArray arr (off + 5) && + c6 == indexCharArray arr (off + 6) && + c7 == indexCharArray arr (off + 7) && + c8 == indexCharArray arr (off + 8) + _ -> False + +-- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text, +-- a 10-tuple whose elements match the characters? +equalsLatin10 :: Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool +equalsLatin10 !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 !c8 !c9 (Bytes arr off len) = case len of + 10 -> c0 == indexCharArray arr off && + c1 == indexCharArray arr (off + 1) && + c2 == indexCharArray arr (off + 2) && + c3 == indexCharArray arr (off + 3) && + c4 == indexCharArray arr (off + 4) && + c5 == indexCharArray arr (off + 5) && + c6 == indexCharArray arr (off + 6) && + c7 == indexCharArray arr (off + 7) && + c8 == indexCharArray arr (off + 8) && + c9 == indexCharArray arr (off + 9) + _ -> False + +-- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text, +-- a 11-tuple whose elements match the characters? +equalsLatin11 :: Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool +equalsLatin11 !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 !c8 !c9 !c10 (Bytes arr off len) = case len of + 11 -> c0 == indexCharArray arr off && + c1 == indexCharArray arr (off + 1) && + c2 == indexCharArray arr (off + 2) && + c3 == indexCharArray arr (off + 3) && + c4 == indexCharArray arr (off + 4) && + c5 == indexCharArray arr (off + 5) && + c6 == indexCharArray arr (off + 6) && + c7 == indexCharArray arr (off + 7) && + c8 == indexCharArray arr (off + 8) && + c9 == indexCharArray arr (off + 9) && + c10 == indexCharArray arr (off + 10) + _ -> False + +-- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text, +-- a 12-tuple whose elements match the characters? +equalsLatin12 :: Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool +equalsLatin12 !c0 !c1 !c2 !c3 !c4 !c5 !c6 !c7 !c8 !c9 !c10 !c11 (Bytes arr off len) = case len of + 12 -> c0 == indexCharArray arr off && + c1 == indexCharArray arr (off + 1) && + c2 == indexCharArray arr (off + 2) && + c3 == indexCharArray arr (off + 3) && + c4 == indexCharArray arr (off + 4) && + c5 == indexCharArray arr (off + 5) && + c6 == indexCharArray arr (off + 6) && + c7 == indexCharArray arr (off + 7) && + c8 == indexCharArray arr (off + 8) && + c9 == indexCharArray arr (off + 9) && + c10 == indexCharArray arr (off + 10) && + c11 == indexCharArray arr (off + 11) + _ -> False + -- | Is the byte sequence equal to the @NUL@-terminated C String? -- The C string must be a constant. equalsCString :: CString -> Bytes -> Bool @@ -579,6 +674,25 @@ ) len0 bs PM.unsafeFreezeByteArray marr +-- | Specialization of 'intercalate' where the separator is a single byte and +-- there are exactly two byte sequences that are being concatenated. +intercalateByte2 :: + Word8 -- ^ Separator + -> Bytes -- ^ First byte sequence + -> Bytes -- ^ Second byte sequence + -> Bytes +intercalateByte2 !sep !a !b = Bytes + { Types.array = runByteArrayST $ do + dst <- PM.newByteArray len + Pure.unsafeCopy dst 0 a + PM.writeByteArray dst (length a) sep + Pure.unsafeCopy dst (length a + 1) b + PM.unsafeFreezeByteArray dst + , Types.length = len + , Types.offset = 0 + } + where len = length a + length b + 1 + -- | /O(n)/ Returns true if any byte in the sequence satisfies the predicate. any :: (Word8 -> Bool) -> Bytes -> Bool {-# inline any #-} @@ -588,3 +702,72 @@ all :: (Word8 -> Bool) -> Bytes -> Bool {-# inline all #-} all f = foldr (\b r -> f b && r) True + +-- | /O(n)/ when unpinned, /O(1)/ when pinned. Create a 'ByteString' from +-- a byte sequence. This only copies the byte sequence if it is not pinned. +toByteString :: Bytes -> ByteString +toByteString !b = pinnedToByteString (Pure.pin b) + +-- | Convert the sliced 'Bytes' to an unsliced 'ShortByteString'. This +-- reuses the array backing the sliced 'Bytes' if the slicing metadata +-- implies that all of the bytes are used. Otherwise, it makes a copy. +toShortByteString :: Bytes -> ShortByteString +toShortByteString !b = case Pure.toByteArray b of + PM.ByteArray x -> SBS x + +-- | Variant of 'toShortByteString' that unconditionally makes a copy of +-- the array backing the sliced 'Bytes' even if the original array +-- could be reused. Prefer 'toShortByteString'. +toShortByteStringClone :: Bytes -> ShortByteString +toShortByteStringClone !b = case Pure.toByteArrayClone b of + PM.ByteArray x -> SBS x + +-- | /O(1)/ Create 'Bytes' from a 'ShortByteString'. +fromShortByteString :: ShortByteString -> Bytes +fromShortByteString (SBS x) = fromByteArray (ByteArray x) + +-- | /O(n)/ Interpreting the bytes an ASCII-encoded characters, convert +-- the string to lowercase. This adds @0x20@ to bytes in the range +-- @[0x41,0x5A]@ and leaves all other bytes alone. Unconditionally +-- copies the bytes. +toLowerAsciiByteArrayClone :: Bytes -> ByteArray +toLowerAsciiByteArrayClone (Bytes src off0 len0) = + runByteArrayST action + where + action :: forall s. ST s ByteArray + action = do + dst <- PM.newByteArray len0 + let go !off !ix !len = if len == 0 + then pure () + else do + let w = PM.indexByteArray src off :: Word8 + w' = if w >= 0x41 && w <= 0x5A + then w + 32 + else w + PM.writeByteArray dst ix w' + go (off + 1) (ix + 1) (len - 1) + go off0 0 len0 + PM.unsafeFreezeByteArray dst + + +-- | /O(n)/ Copy a 'ByteString' to a byte sequence. +fromByteString :: ByteString -> Bytes +fromByteString !b = Bytes + ( runByteArrayST $ unsafeIOToST $ do + dst@(PM.MutableByteArray dst# ) <- PM.newByteArray len + ByteString.unsafeUseAsCString b $ \src -> do + PM.copyPtrToMutablePrimArray (PM.MutablePrimArray dst# ) 0 src len + PM.unsafeFreezeByteArray dst + ) 0 len + where + !len = ByteString.length b + +-- Precondition: bytes are pinned +pinnedToByteString :: Bytes -> ByteString +pinnedToByteString (Bytes y@(PM.ByteArray x) off len) = + ByteString.PS + (ForeignPtr.ForeignPtr + (case plusPtr (PM.byteArrayContents y) off of {Exts.Ptr p -> p}) + (ForeignPtr.PlainPtr (Exts.unsafeCoerce# x)) + ) + 0 len diff --git a/src/Data/Bytes/Byte.hs b/src/Data/Bytes/Byte.hs --- a/src/Data/Bytes/Byte.hs +++ b/src/Data/Bytes/Byte.hs @@ -22,6 +22,7 @@ , split2 , split3 , split4 + , splitEnd1 ) where import Prelude hiding (length) @@ -279,3 +280,23 @@ then off# else elemIndexLoop# w (Bytes arr (off + 1) (len - 1)) +-- Variant of elemIndexLoop# that starts at the end. Similarly, returns +-- negative one if the element is not found. +elemIndexLoopBackwards# :: Word8 -> ByteArray -> Int -> Int -> Int# +elemIndexLoopBackwards# !w !arr !start !pos@(I# pos#) = if pos < start + then (-1#) + else if PM.indexByteArray arr pos == w + then pos# + else elemIndexLoopBackwards# w arr start (pos - 1) + +-- | Split a byte sequence on the last occurrence of the target +-- byte. The target is removed from the result. For example: +-- +-- >>> split1 0xA [0x1,0x2,0xA,0xB,0xA,0xC] +-- Just ([0x1,0x2,0xA,0xB],[0xC]) +splitEnd1 :: Word8 -> Bytes -> Maybe (Bytes,Bytes) +{-# inline splitEnd1 #-} +splitEnd1 !w (Bytes arr off len) = case elemIndexLoopBackwards# w arr off (off + len - 1) of + (-1#) -> Nothing + i# -> let i = I# i# in + Just (Bytes arr off (i - off), Bytes arr (i + 1) (len - (1 + i - off))) diff --git a/src/Data/Bytes/Chunks.hs b/src/Data/Bytes/Chunks.hs --- a/src/Data/Bytes/Chunks.hs +++ b/src/Data/Bytes/Chunks.hs @@ -24,6 +24,7 @@ , concat , concatPinned , concatU + , concatPinnedU , reverse , reverseOnto -- * Folds @@ -120,6 +121,15 @@ ChunksCons b y -> case y of ChunksNil -> Bytes.toByteArray b ChunksCons c z -> case concatFollowing2 b c z of + (# _, r #) -> ByteArray r + +-- | Variant of 'concatPinned' that returns an unsliced pinned byte sequence. +concatPinnedU :: Chunks -> ByteArray +concatPinnedU x = case x of + ChunksNil -> Bytes.emptyPinnedU + ChunksCons b y -> case y of + ChunksNil -> Bytes.toPinnedByteArray b + ChunksCons c z -> case concatPinnedFollowing2 b c z of (# _, r #) -> ByteArray r concatFollowing2 :: Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #) diff --git a/src/Data/Bytes/Pure.hs b/src/Data/Bytes/Pure.hs --- a/src/Data/Bytes/Pure.hs +++ b/src/Data/Bytes/Pure.hs @@ -8,11 +8,14 @@ module Data.Bytes.Pure ( empty , emptyPinned + , emptyPinnedU , pin , contents , unsafeCopy , toByteArray , toByteArrayClone + , toPinnedByteArray + , toPinnedByteArrayClone , fromByteArray , length , foldl' @@ -36,13 +39,18 @@ empty :: Bytes empty = Bytes mempty 0 0 --- | The empty byte sequence. +-- | The empty pinned byte sequence. emptyPinned :: Bytes emptyPinned = Bytes ( runByteArrayST (PM.newPinnedByteArray 0 >>= PM.unsafeFreezeByteArray) ) 0 0 +-- | The empty pinned byte sequence. +emptyPinnedU :: ByteArray +emptyPinnedU = runByteArrayST + (PM.newPinnedByteArray 0 >>= PM.unsafeFreezeByteArray) + -- | Yields a pinned byte sequence whose contents are identical to those -- of the original byte sequence. If the @ByteArray@ backing the argument -- was already pinned, this simply aliases the argument and does not perform @@ -118,3 +126,22 @@ -- to call this on a 'Bytes' backed by a pinned @ByteArray@. contents :: Bytes -> Ptr Word8 contents (Bytes arr off _) = plusPtr (PM.byteArrayContents arr) off + +-- | Convert the sliced 'Bytes' to an unsliced 'ByteArray'. This +-- reuses the array backing the sliced 'Bytes' if the slicing metadata +-- implies that all of the bytes are used and they are already pinned. +-- Otherwise, it makes a copy. +toPinnedByteArray :: Bytes -> ByteArray +toPinnedByteArray b@(Bytes arr off len) + | off == 0, PM.sizeofByteArray arr == len, PM.isByteArrayPinned arr = arr + | otherwise = toPinnedByteArrayClone b + +-- | Variant of 'toPinnedByteArray' that unconditionally makes a copy of +-- the array backing the sliced 'Bytes' even if the original array +-- could be reused. Prefer 'toPinnedByteArray'. +toPinnedByteArrayClone :: Bytes -> ByteArray +toPinnedByteArrayClone (Bytes arr off len) = runByteArrayST $ do + m <- PM.newPinnedByteArray len + PM.copyByteArray m 0 arr off len + PM.unsafeFreezeByteArray m + diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -38,9 +38,15 @@ , lawsToTest (QCC.ordLaws (Proxy :: Proxy Bytes)) , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy Bytes)) , lawsToTest (QCC.monoidLaws (Proxy :: Proxy Bytes)) - , testGroup "isPrefixOf" + , testGroup "toLowerAsciiByteArrayClone" [ testCase "A" $ THU.assertBool "" $ Bytes.isPrefixOf (bytes "hey") (bytes "hey man") + ] + , testGroup "isPrefixOf" + [ testCase "A" $ + Bytes.toLowerAsciiByteArrayClone (bytes "FooBar") + @=? + pack "foobar" , testCase "B" $ THU.assertBool "" $ not (Bytes.isPrefixOf (bytes "an") (bytes "hey man")) ] @@ -148,6 +154,14 @@ [Bytes.fromAsciiString "hello", Bytes.fromAsciiString "world"] @=? (Bytes.splitInit 0x0A (Bytes.fromAsciiString "hello\nworld\nthere")) + , testProperty "splitEnd1" $ \(x :: Word8) (xs :: [Word8]) -> + case ByteString.split x (ByteString.pack xs) of + [] -> Bytes.splitEnd1 x (slicedPack xs) === Nothing + [_] -> Bytes.splitEnd1 x (slicedPack xs) === Nothing + [y1,z1] -> case Bytes.splitEnd1 x (slicedPack xs) of + Nothing -> property False + Just (y2,z2) -> (y1,z1) === (bytesToByteString y2, bytesToByteString z2) + _ -> property Discard , testProperty "split1" $ \(x :: Word8) (xs :: [Word8]) -> case ByteString.split x (ByteString.pack xs) of [] -> Bytes.split1 x (slicedPack xs) === Nothing @@ -184,6 +198,7 @@ [ testCase "empty" (Bytes.fnv1a64 Bytes.empty @=? 0xcbf29ce484222325) , testCase "a" (Bytes.fnv1a64 (bytes "a") @=? 0xaf63dc4c8601ec8c) , testCase "foobar" (Bytes.fnv1a64 (bytes "foobar") @=? 0x85944171f73967e8) + , testCase "google.com" (Bytes.fnv1a64 (bytes "google.com") @=? 0xe1a2c1ae38dcdf45) ] ] , testGroup "Chunks"