byteslice 0.1.3.0 → 0.1.4.0

raw patch · 7 files changed

+429/−10 lines, 7 filesdep +bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring

API changes (from Hackage documentation)

Files

• CHANGELOG.md +16/−0
• byteslice.cabal +8/−1
• cbits/bs_custom.c +35/−0
• include/bs_custom.h +7/−0
• src/Data/Bytes.hs +170/−7
• src/Data/Bytes/Byte.hs +117/−0
• test/Main.hs +76/−2

@@ -1,5 +1,21 @@ # Revision history for byteslice +## 0.1.4.0 -- 2019-11-12++* Add `toLatinString`.+* Add `stripPrefix`, `stripSuffix`, `stripOptionalPrefix`, and+  `stripOptionalSuffix`.+* Add `takeWhileEnd` and `dropWhileEnd`.+* Add `count`.+* Add an optimized `split` function.+* Add `splitInit`.+* Add `splitFirst`.+* Add `copy`.+* Add `pin`.+* Add `touch`.+* Add `elem`.+* Add `unsafeIndex`.+ ## 0.1.3.0 -- 2019-09-15  * Add `isPrefixOf` and `isSuffixOf`.

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: byteslice-version: 0.1.3.0+version: 0.1.4.0 synopsis: Slicing managed and unmanaged memory description:   This library provides types that allow the user to talk about a slice of@@ -22,6 +22,8 @@     Data.Bytes     Data.Bytes.Mutable     Data.Bytes.Types+  other-modules:+    Data.Bytes.Byte   build-depends:     , base >=4.11.1 && <5     , primitive >=0.7 && <0.8@@ -30,6 +32,10 @@   hs-source-dirs: src   ghc-options: -Wall -O2   default-language: Haskell2010+  include-dirs: include+  includes: bs_custom.h+  install-includes: bs_custom.h+  c-sources: cbits/bs_custom.c  test-suite test   default-language: Haskell2010@@ -40,6 +46,7 @@   build-depends:     , base >=4.11.1 && <5     , byteslice+    , bytestring     , primitive     , tasty-hunit     , tasty

@@ -0,0 +1,35 @@+#define _GNU_SOURCE++#include <bs_custom.h>+#include <string.h>+#include "Rts.h"++// Find all occurrences of a byte, writing the lengths of each piece+// to the sizes buffer. This uses rawmemchr, so the total number of+// occurrences of the delimiter must be computed in advance. This+// returns the total length of all pieces processed.+HsInt memchr_ba_many(unsigned char *p, HsInt off, HsInt *sizes, HsInt sizesLen, unsigned char w) {+  HsInt szIx, delta, total;+  unsigned char* pos;+  p = p + off;+  total = 0;+  for (szIx = 0; szIx < sizesLen; ++szIx) {+    pos = (unsigned char*)(rawmemchr((void*)p,w));+    delta = pos - p;+    sizes[szIx] = delta;+    total = total + delta + 1;+    p = pos + 1;+  }+  return total;+}++// TODO: Possibly use SIMD in here. Or check so see if gcc optimizes+// this on its own.+HsInt count_ba(unsigned char *p, HsInt off, HsInt len, unsigned char w) {+  HsInt c;+  p = p + off;+  for (c = 0; len-- != 0; ++p)+      if (*p == w)+          ++c;+  return c;+}

@@ -0,0 +1,7 @@+#define _GNU_SOURCE++#include <string.h>+#include "Rts.h"++HsInt memchr_ba_many(unsigned char *p, HsInt off, HsInt *sizes, HsInt sizesLen, unsigned char w);+HsInt count_ba(unsigned char *p, HsInt off, HsInt len, unsigned char w);

@@ -1,6 +1,8 @@ {-# language BangPatterns #-} {-# language MagicHash #-}+{-# language NamedFieldPuns #-} {-# language TypeApplications #-}+{-# language UnboxedTuples #-}  module Data.Bytes   ( -- * Types@@ -11,34 +13,61 @@     -- * Filtering   , takeWhile   , dropWhile+  , takeWhileEnd+  , dropWhileEnd     -- * Folds   , foldl   , foldl'   , foldr   , foldr'-    -- * Equality+    -- * Common Folds+  , elem+    -- * Splitting+  , Byte.split+  , Byte.splitInit+  , splitFirst+    -- * Counting+  , Byte.count+    -- * Prefix and Suffix   , isPrefixOf   , isSuffixOf+  , stripPrefix+  , stripOptionalPrefix+  , stripSuffix+  , stripOptionalSuffix     -- * Unsafe Slicing   , unsafeTake   , unsafeDrop+  , unsafeIndex+    -- * Copying+  , copy+    -- * Pointers+  , pin+  , contents+  , touch     -- * Conversion   , toByteArray   , toByteArrayClone   , fromAsciiString   , fromByteArray+  , toLatinString   ) where -import Prelude hiding (length,takeWhile,dropWhile,null,foldl,foldr)+import Prelude hiding (length,takeWhile,dropWhile,null,foldl,foldr,elem) -import Data.Bytes.Types (Bytes(Bytes))-import Data.Primitive (ByteArray(ByteArray))-import Data.Word (Word8)-import Data.Char (ord)+import Control.Monad.Primitive (PrimMonad,PrimState,primitive_,unsafeIOToPrim) import Control.Monad.ST.Run (runByteArrayST)-import GHC.Exts (Int(I#))+import Control.Monad.ST (runST)+import Data.Bytes.Types (Bytes(Bytes,array,offset))+import Data.Char (ord)+import Data.Primitive (ByteArray(ByteArray),MutableByteArray)+import GHC.Exts (Int(I#),Char(C#),word2Int#,chr#)+import GHC.Exts (Word#,Int#)+import GHC.Word (Word8(W8#))+import Foreign.Ptr (Ptr,plusPtr)  import qualified Data.Primitive as PM+import qualified Data.Bytes.Byte as Byte import qualified GHC.Exts as Exts  -- | Is the byte sequence empty?@@ -68,6 +97,68 @@     then compareByteArrays a aOff b (bOff + bLen - aLen) aLen == EQ     else False +-- | /O(n)/ Return the suffix of the second string if its prefix+-- matches the entire first string.+stripPrefix :: Bytes -> Bytes -> Maybe Bytes+stripPrefix !pre !str = if pre `isPrefixOf` str+  then Just (Bytes (array str) (offset str + length pre) (length str - length pre))+  else Nothing++-- | /O(n)/ Return the suffix of the second string if its prefix+-- matches the entire first string. Otherwise, return the second+-- string unchanged.+stripOptionalPrefix :: Bytes -> Bytes -> Bytes+stripOptionalPrefix !pre !str = if pre `isPrefixOf` str+  then Bytes (array str) (offset str + length pre) (length str - length pre)+  else str++-- | /O(n)/ Return the prefix of the second string if its suffix+-- matches the entire first string.+stripSuffix :: Bytes -> Bytes -> Maybe Bytes+stripSuffix !suf !str = if suf `isSuffixOf` str+  then Just (Bytes (array str) (offset str) (length str - length suf))+  else Nothing++-- | /O(n)/ Return the prefix of the second string if its suffix+-- matches the entire first string. Otherwise, return the second+-- string unchanged.+stripOptionalSuffix :: Bytes -> Bytes -> Bytes+stripOptionalSuffix !suf !str = if suf `isSuffixOf` str+  then Bytes (array str) (offset str) (length str - length suf)+  else str++-- | Split a byte sequence on the first occurrence of the target+-- byte. The target is removed from the result. For example:+--+-- >>> splitOnce 0xA [0x1,0x2,0xA,0xB]+-- Just ([0x1,0x2],[0xB])+splitFirst :: Word8 -> Bytes -> Maybe (Bytes,Bytes)+{-# inline splitFirst #-}+splitFirst w b@(Bytes arr off len) = case elemIndexLoop# w b of+  (-1#) -> Nothing+  i# -> let i = I# i# in+    Just (Bytes arr off (i - off), Bytes arr (i + 1) (len - (1 + i - off)))++-- This returns the offset into the byte array. This is not an index+-- that will mean anything to the end user, so it cannot be returned+-- to them.+elemIndexLoop# :: Word8 -> Bytes -> Int#+elemIndexLoop# !w (Bytes arr off@(I# off# ) len) = case len of+  0 -> (-1#)+  _ -> if PM.indexByteArray arr off == w+    then off#+    else elemIndexLoop# w (Bytes arr (off + 1) (len - 1))++elem :: Word8 -> Bytes -> Bool+elem (W8# w) b = case elemLoop 0# w b of+  1# -> True+  _ -> False++elemLoop :: Int# -> Word# -> Bytes -> Int#+elemLoop !r !w (Bytes arr@(ByteArray arr# ) off@(I# off# ) len) = case len of+  0 -> r+  _ -> elemLoop (Exts.orI# r (Exts.eqWord# w (Exts.indexWord8Array# arr# off# ) )) w (Bytes arr (off + 1) (len - 1))+ -- | Take bytes while the predicate is true. takeWhile :: (Word8 -> Bool) -> Bytes -> Bytes {-# inline takeWhile #-}@@ -78,6 +169,26 @@ {-# inline dropWhile #-} dropWhile k b = unsafeDrop (countWhile k b) b +-- | Index into the byte sequence at the given position. This index+-- must be less than the length.+unsafeIndex :: Bytes -> Int -> Word8+unsafeIndex (Bytes arr off _) ix = PM.indexByteArray arr (off + ix)++-- | /O(n)/ 'dropWhileEnd' @p@ @b@ returns the prefix remaining after+-- dropping characters that satisfy the predicate @p@ from the end of+-- @t@.+dropWhileEnd :: (Word8 -> Bool) -> Bytes -> Bytes+{-# inline dropWhileEnd #-}+dropWhileEnd k !b = unsafeTake (length b - countWhileEnd k b) b++-- | /O(n)/ 'takeWhileEnd' @p@ @b@ returns the longest suffix of+-- elements that satisfy predicate @p@.+takeWhileEnd :: (Word8 -> Bool) -> Bytes -> Bytes+{-# inline takeWhileEnd #-}+takeWhileEnd k !b =+  let n = countWhileEnd k b+   in Bytes (array b) (offset b + length b - n) n+ -- | Take the first @n@ bytes from the argument. Precondition: @n ≤ len@ unsafeTake :: Int -> Bytes -> Bytes {-# inline unsafeTake #-}@@ -103,6 +214,17 @@       else n     else n +-- Internal. Variant of countWhile that starts from the end+-- of the string instead of the beginning.+countWhileEnd :: (Word8 -> Bool) -> Bytes -> Int+{-# inline countWhileEnd #-}+countWhileEnd k (Bytes arr off0 len0) = go (off0 + len0 - 1) (len0 - 1) 0 where+  go !off !len !n = if len >= 0+    then if k (PM.indexByteArray arr off)+      then go (off - 1) (len - 1) (n + 1)+      else n+    else n+ -- | Left fold over bytes, non-strict in the accumulator. foldl :: (a -> Word8 -> a) -> a -> Bytes -> a {-# inline foldl #-}@@ -162,6 +284,10 @@ fromAsciiString :: String -> Bytes fromAsciiString = fromByteArray . Exts.fromList . map (fromIntegral @Int @Word8 . ord) +-- | Interpret a byte sequence as text encoded by ISO-8859-1.+toLatinString :: Bytes -> String+toLatinString = foldr (\(W8# w) xs -> C# (chr# (word2Int# w)) : xs) []+ -- | Create a slice of 'Bytes' that spans the entire argument array. fromByteArray :: ByteArray -> Bytes fromByteArray b = Bytes b 0 (PM.sizeofByteArray b)@@ -170,3 +296,40 @@ {-# INLINE compareByteArrays #-} compareByteArrays (ByteArray ba1#) (I# off1#) (ByteArray ba2#) (I# off2#) (I# n#) =   compare (I# (Exts.compareByteArrays# ba1# off1# ba2# off2# n#)) 0++-- | Copy the byte sequence into a mutable buffer. The buffer must have+-- enough space to accomodate the byte sequence, but this this is not+-- checked.+copy :: PrimMonad m+  => MutableByteArray (PrimState m) -- ^ Destination+  -> Int -- ^ Destination Offset+  -> Bytes -- ^ Source+  -> m ()+{-# inline copy #-}+copy dst dstIx (Bytes src srcIx len) =+  PM.copyByteArray dst dstIx src srcIx len++-- | 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+-- any copying.+pin :: Bytes -> Bytes+pin b@(Bytes arr _ len) = case PM.isByteArrayPinned arr of+  True -> b+  False -> runST $ do+    dst <- PM.newPinnedByteArray len+    copy dst 0 b+    r <- PM.unsafeFreezeByteArray dst+    pure (Bytes r 0 len)++-- | Yields a pointer to the beginning of the byte sequence. It is only safe+-- to call this on a 'Bytes' backed by a pinned @ByteArray@.+contents :: Bytes -> Ptr Word8+contents (Bytes arr off _) = plusPtr (PM.byteArrayContents arr) off++-- | Touch the byte array backing the byte sequence. This sometimes needed+-- after calling 'contents' so that the @ByteArray@ does not get garbage+-- collected.+touch :: PrimMonad m => Bytes -> m ()+touch (Bytes (ByteArray arr) _ _) = unsafeIOToPrim+  (primitive_ (\s -> Exts.touch# arr s))

@@ -0,0 +1,117 @@+{-# language BangPatterns #-}+{-# language BlockArguments #-}+{-# language MagicHash #-}+{-# language NamedFieldPuns #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language UnliftedFFITypes #-}+{-# language UnboxedTuples #-}++-- This internal module has functions for splitting strings+-- on a particular byte and for counting occurences of that+-- byte.+module Data.Bytes.Byte+  ( count+  , split+  , splitInit+  ) where++import Prelude hiding (length)++import GHC.IO (unsafeIOToST)+import Data.Primitive (PrimArray(..),MutablePrimArray(..),ByteArray(..))+import Data.Word (Word8)+import GHC.Exts (Int(I#),ByteArray#,MutableByteArray#,Int#,Word#)+import GHC.Word (Word8(W8#))+import Data.Bytes.Types (Bytes(..))+import Control.Monad.ST.Run (runPrimArrayST)++import qualified Data.Primitive as PM+import qualified GHC.Exts as Exts++-- | Count the number of times the byte appears in the sequence.+count :: Word8 -> Bytes -> Int+count !b (Bytes{array=ByteArray arr,offset,length}) =+  count_ba arr offset length b++-- | Break a byte sequence into pieces separated by the byte argument,+-- consuming the delimiter. This function is a good producer for list+-- fusion. It is common to immidiately consume the results of @split@+-- with @foldl'@, @traverse_@, @foldlM@, and being a good producer helps+-- in this situation.+split :: Word8 -> Bytes -> [Bytes]+{-# inline split #-}+split !w !bs@Bytes{array,offset=arrIx0} = Exts.build+  (\g x0 ->+    let go !lenIx !arrIx = if lenIx < lensSz+          then let !len = PM.indexPrimArray lens lenIx in +            g (Bytes array arrIx len) (go (lenIx + 1) (arrIx + len + 1))+          else x0+     in go 0 arrIx0+  )+  where+  !lens = splitLengths w bs+  !lensSz = PM.sizeofPrimArray lens++-- | Variant of 'split' that drops the trailing element. This behaves+-- correctly even if the byte sequence is empty.+splitInit :: Word8 -> Bytes -> [Bytes]+{-# inline splitInit #-}+splitInit !w !bs@Bytes{array,offset=arrIx0} = Exts.build+  (\g x0 ->+    let go !lenIx !arrIx = if lenIx < lensSz+          then let !len = PM.indexPrimArray lens lenIx in +            g (Bytes array arrIx len) (go (lenIx + 1) (arrIx + len + 1))+          else x0+     in go 0 arrIx0+  )+  where+  -- Remember, the resulting array from splitLengthsAlt always has+  -- a length of at least one.+  !lens = splitLengthsAlt w bs+  !lensSz = PM.sizeofPrimArray lens - 1++splitLengths :: Word8 -> Bytes -> PrimArray Int+{-# inline splitLengths #-}+splitLengths (W8# b) Bytes{array=ByteArray arr,offset=I# off,length=I# len} =+  PrimArray (splitLengths# b arr off len)++-- Internal function. This is just like splitLengths except that+-- it does not treat the empty byte sequences specially. The result+-- for that byte sequence is a singleton array with the element zero.+splitLengthsAlt :: Word8 -> Bytes -> PrimArray Int+splitLengthsAlt b Bytes{array=ByteArray arr#,offset=off,length=len} = runPrimArrayST do+  let !n = count_ba arr# off len b+  dst@(MutablePrimArray dst# ) :: MutablePrimArray s Int <- PM.newPrimArray (n + 1)+  total <- unsafeIOToST (memchr_ba_many arr# off dst# n b)+  PM.writePrimArray dst n (len - total)+  PM.unsafeFreezePrimArray dst++-- Internal function. When the argument is the empty byte sequence, this+-- returns an empty array of offsets.+splitLengths# :: Word# -> ByteArray# -> Int# -> Int# -> ByteArray#+{-# noinline splitLengths# #-}+splitLengths# b# arr# off# len# = result+  where+  b = W8# b#+  off = I# off#+  len = I# len#+  -- We make 0 a special case for compatibility with the behavior+  -- that the bytestring library provides.+  !(PrimArray result) = runPrimArrayST $ case len of+    0 -> do+      marr <- PM.newByteArray 0 +      ByteArray res# <- PM.unsafeFreezeByteArray marr+      pure (PrimArray res# )+    _ -> do+      let !n = count_ba arr# off len b+      dst@(MutablePrimArray dst# ) :: MutablePrimArray s Int <- PM.newPrimArray (n + 1)+      total <- unsafeIOToST (memchr_ba_many arr# off dst# n b)+      PM.writePrimArray dst n (len - total)+      PM.unsafeFreezePrimArray dst++foreign import ccall unsafe "bs_custom.h memchr_ba_many" memchr_ba_many+  :: ByteArray# -> Int -> MutableByteArray# s -> Int -> Word8 -> IO Int++foreign import ccall unsafe "bs_custom.h count_ba" count_ba+  :: ByteArray# -> Int -> Int -> Word8 -> Int

@@ -11,15 +11,15 @@ import Data.Bytes.Types (Bytes(Bytes)) import Test.Tasty (defaultMain,testGroup,TestTree) import Test.Tasty.HUnit ((@=?),testCase)-import Test.Tasty.QuickCheck ((===),testProperty)+import Test.Tasty.QuickCheck ((===),testProperty,property,Discard(Discard))  import qualified Data.Bytes as Bytes+import qualified Data.ByteString as ByteString import qualified Data.Foldable as Foldable import qualified Data.List as List import qualified Data.Primitive as PM import qualified GHC.Exts as Exts import qualified Test.Tasty.HUnit as THU-import qualified Test.Tasty.QuickCheck as QC  main :: IO () main = defaultMain tests@@ -38,6 +38,40 @@     , testCase "B" $ THU.assertBool "" $         not (Bytes.isSuffixOf (bytes "h") (bytes "hey man"))     ]+  , testGroup "stripOptionalSuffix"+    [ testCase "A" $+        Bytes.fromAsciiString "hey m"+        @=?+        Bytes.stripOptionalSuffix (bytes "an") (bytes "hey man")+    , testCase "B" $+        Bytes.fromAsciiString "hey man"+        @=?+        Bytes.stripOptionalSuffix (bytes "h") (bytes "hey man")+    ]+  , testGroup "dropWhileEnd"+    [ testCase "A" $+        Bytes.fromAsciiString "aabbcc"+        @=?+        Bytes.dropWhileEnd (== c2w 'b') (bytes "aabbccbb")+    ]+  , testGroup "takeWhileEnd"+    [ testCase "A" $+        Bytes.fromAsciiString "bb"+        @=?+        Bytes.takeWhileEnd (== c2w 'b') (bytes "aabbccbb")+    , testCase "B" $+        Bytes.fromAsciiString ""+        @=?+        Bytes.takeWhileEnd (/= c2w '\n') (bytes "aabbccbb\n")+    , testCase "C" $+        slicedPack [0x1,0x2,0x3]+        @=?+        Bytes.takeWhileEnd (/= 0x0) (slicedPack [0x1,0x0,0x1,0x2,0x3])+    ]+  , testProperty "elem" $ \(x :: Word8) (xs :: [Word8]) ->+      List.elem x xs+      ===+      Bytes.elem x (Bytes.unsafeDrop 1 (Exts.fromList (x : xs)))   , testProperty "foldl" $ \(x :: Word8) (xs :: [Word8]) ->       List.foldl (-) 0 xs       ===@@ -54,11 +88,51 @@       Foldable.foldr' (-) 0 xs       ===       Bytes.foldr' (-) 0 (Bytes.unsafeDrop 1 (Exts.fromList (x : xs)))+  , testProperty "count" $ \(x :: Word8) (xs :: [Word8]) ->+      ByteString.count x (ByteString.pack xs)+      ===+      Bytes.count x (slicedPack xs)+  , testProperty "split" $ \(x :: Word8) (xs :: [Word8]) ->+      ByteString.split x (ByteString.pack xs)+      ===+      map bytesToByteString (Bytes.split x (slicedPack xs))+  , testProperty "splitInit" $ \(x :: Word8) (xs :: [Word8]) -> case xs of+      [] -> Bytes.splitInit x (slicedPack xs) === []+      _ -> +        List.init (ByteString.split x (ByteString.pack xs))+        ===+        map bytesToByteString (Bytes.splitInit x (slicedPack xs))+  , testCase "splitInit-A" $+      [Bytes.fromAsciiString "hello", Bytes.fromAsciiString "world"]+      @=?+      (Bytes.splitInit 0x0A (Bytes.fromAsciiString "hello\nworld\n"))+  , testCase "splitInit-B" $+      [Bytes.fromAsciiString "hello", Bytes.fromAsciiString "world"]+      @=?+      (Bytes.splitInit 0x0A (Bytes.fromAsciiString "hello\nworld\nthere"))+  , testProperty "splitFirst" $ \(x :: Word8) (xs :: [Word8]) ->+      case ByteString.split x (ByteString.pack xs) of+        [] -> Bytes.splitFirst x (slicedPack xs) === Nothing+        [_] -> Bytes.splitFirst x (slicedPack xs) === Nothing+        [y1,z1] -> case Bytes.splitFirst x (slicedPack xs) of+          Nothing -> property False+          Just (y2,z2) -> (y1,z1) === (bytesToByteString y2, bytesToByteString z2)+        _ -> property Discard   ]  bytes :: String -> Bytes bytes s = let b = pack ('x' : s) in Bytes b 1 (PM.sizeofByteArray b - 1) +slicedPack :: [Word8] -> Bytes+slicedPack s =+  let b = Exts.fromList ([0x00] ++ s ++ [0x00])+   in Bytes b 1 (PM.sizeofByteArray b - 2)+ pack :: String -> ByteArray pack = Exts.fromList . map (fromIntegral @Int @Word8 . ord) +c2w :: Char -> Word8+c2w = fromIntegral . ord++bytesToByteString :: Bytes -> ByteString.ByteString+bytesToByteString = ByteString.pack . Bytes.foldr (:) []