hw-prim 0.6.0.0 → 0.6.1.0

raw patch · 5 files changed

+131/−8 lines, 5 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• bench/Main.hs +14/−4
• hw-prim.cabal +4/−2
• src/HaskellWorks/Data/FromByteString.hs +9/−2
• src/HaskellWorks/Data/Vector/AsVector64s.hs +72/−0
• test/HaskellWorks/Data/Vector/AsVector64sSpec.hs +32/−0

@@ -7,9 +7,11 @@ import Data.Word import Foreign import HaskellWorks.Data.FromForeignRegion+import HaskellWorks.Data.Vector.AsVector64s  import qualified Data.ByteString          as BS import qualified Data.ByteString.Internal as BSI+import qualified Data.ByteString.Lazy     as LBS import qualified Data.Vector.Storable     as DVS import qualified System.IO.MMap           as IO @@ -31,17 +33,25 @@   let !_ = BS.foldl' (+) 0 bs   return () -sumFileVectorWord64 :: FilePath -> IO ()-sumFileVectorWord64 filePath = do+sumFileVector64 :: FilePath -> IO ()+sumFileVector64 filePath = do   !(v :: DVS.Vector Word64) <- mmapVectorLike filePath   let !_ = DVS.foldl' (+) 0 v   return () +sumFileLazyByteStringViaVector64 :: FilePath -> IO ()+sumFileLazyByteStringViaVector64 filePath = do+  !bs <- LBS.readFile filePath+  let wss = asVector64s 64 bs+  let !_ = sum (DVS.foldl' (+) 0 <$> wss)+  return ()+ benchRankJson40Conduits :: [Benchmark] benchRankJson40Conduits =   [ env (return ()) $ \_ -> bgroup "medium.csv"-    [ bench "Foldl' over ByteString"    (whnfIO (sumFileByteString   "corpus/medium.csv"))-    , bench "Foldl' over Vector Word64" (whnfIO (sumFileVectorWord64 "corpus/medium.csv"))+    [ bench "Foldl' over ByteString"                        (whnfIO (sumFileByteString                "corpus/medium.csv"))+    , bench "Foldl' over Vector Word64"                     (whnfIO (sumFileVector64                  "corpus/medium.csv"))+    , bench "Foldl' over Lazy ByteString via Vector Word64" (whnfIO (sumFileLazyByteStringViaVector64 "corpus/medium.csv"))     ]   ] 

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 28b96617af1777ecd486d96708483a873f7ade860b7bcfa1ba5f666fde5ecd49+-- hash: b4513a18c623ca2703a2c1fc185d0b0ff8165c970ded30e2cf582ae54be58819  name:           hw-prim-version:        0.6.0.0+version:        0.6.1.0 synopsis:       Primitive functions and data types description:    Please see README.md category:       Data@@ -69,6 +69,7 @@       HaskellWorks.Data.Uncons       HaskellWorks.Data.Unsign       HaskellWorks.Data.Vector.AsVector64+      HaskellWorks.Data.Vector.AsVector64s       HaskellWorks.Data.Vector.BoxedVectorLike       HaskellWorks.Data.Vector.StorableVectorLike   other-modules:@@ -100,6 +101,7 @@       HaskellWorks.Data.FromByteStringSpec       HaskellWorks.Data.FromForeignRegionSpec       HaskellWorks.Data.SearchSpec+      HaskellWorks.Data.Vector.AsVector64sSpec       Paths_hw_prim   default-language: Haskell2010 

@@ -7,9 +7,12 @@  import Data.Bits import Data.Word+import Foreign.ForeignPtr -import qualified Data.ByteString      as BS-import qualified Data.Vector.Storable as DVS+import qualified Data.ByteString              as BS+import qualified Data.ByteString.Internal     as BS+import qualified Data.Vector.Storable         as DVS+import qualified Data.Vector.Storable.Mutable as DVSM  -- | Class for byte-string-like datastructures class FromByteString a where@@ -65,3 +68,7 @@             | otherwise = case BS.uncons cs of                 Just (d, ds) -> gen' (n + 8) (w .|. (fromIntegral d `shiftL` fromIntegral n)) ds                 Nothing      -> Just (w, cs)++instance FromByteString (DVSM.MVector s Word8) where+  fromByteString bs = case BS.toForeignPtr bs of+    (fptr, off, len) -> DVSM.unsafeFromForeignPtr (castForeignPtr fptr) off len

@@ -0,0 +1,72 @@+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Vector.AsVector64s+  ( AsVector64s(..)+  ) where++import Control.Monad.ST+import Data.Word+import Foreign.ForeignPtr++import qualified Data.ByteString              as BS+import qualified Data.ByteString.Internal     as BS+import qualified Data.ByteString.Lazy         as LBS+import qualified Data.Vector.Storable         as DVS+import qualified Data.Vector.Storable.Mutable as DVSM++class AsVector64s a where+  -- | Represent the value as a list of Vector of 'n' Word64 chunks.  The last chunk will+  -- also be of the specified chunk size filled with trailing zeros.+  asVector64s :: Int -> a -> [DVS.Vector Word64]++instance AsVector64s LBS.ByteString where+  asVector64s n = asVector64s n . LBS.toChunks+  {-# INLINE asVector64s #-}++instance AsVector64s [BS.ByteString] where+  asVector64s = bytestringsToVectors+  {-# INLINE asVector64s #-}++bytestringsToVectors :: Int -> [BS.ByteString] -> [DVS.Vector Word64]+bytestringsToVectors n bss = DVS.createT $ go (byteStringToVector8 <$> bss)+  where go :: [DVSM.MVector s Word8] -> ST s [DVSM.MVector s Word64]+        go ts = do+          result <- buildOneVector n ts+          case result of+            Just (us, v) -> (v:) <$> go us+            Nothing      -> return []+{-# INLINE bytestringsToVectors #-}++buildOneVector :: forall s. Int -> [DVSM.MVector s Word8] -> ST s (Maybe ([DVSM.MVector s Word8], DVSM.MVector s Word64))+buildOneVector n ss = case dropWhile ((== 0) . DVSM.length) ss of+  [] -> return Nothing+  cs -> do+    v64 <- DVSM.unsafeNew n+    let v8 = DVSM.unsafeCast v64+    rs  <- go cs v8+    return (Just (rs, v64))+  where go :: [DVSM.MVector s Word8] -> DVSM.MVector s Word8 -> ST s [DVSM.MVector s Word8]+        go ts v = if DVSM.length v > 0+          then case ts of+            (u:us) -> do+              if DVSM.length u <= DVSM.length v+                then case DVSM.splitAt (DVSM.length u) v of+                  (va, vb) -> do+                    DVSM.copy va u+                    go us vb+                else case DVSM.splitAt (DVSM.length v) u of+                  (ua, ub) -> do+                    DVSM.copy v ua+                    return (ub:us)+            [] -> do+              DVSM.set v 0+              return []+          else return ts+        {-# INLINE go #-}+{-# INLINE buildOneVector #-}++byteStringToVector8 :: BS.ByteString -> DVSM.MVector s Word8+byteStringToVector8 bs = case BS.toForeignPtr bs of+  (fptr, off, len) -> DVSM.unsafeFromForeignPtr (castForeignPtr fptr) off len+{-# INLINE byteStringToVector8 #-}

@@ -0,0 +1,32 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Vector.AsVector64sSpec+  ( spec+  ) where++import HaskellWorks.Data.Vector.AsVector64s+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString      as BS+import qualified Data.Vector.Storable as DVS+import qualified Hedgehog.Gen         as G+import qualified Hedgehog.Range       as R++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Vector.AsVector64sSpec" $ do+  it "Conversion of ByteString works" $ requireProperty $ do+    bss <- forAll $ (BS.pack <$>) <$> G.list (R.linear 0 8) (G.list (R.linear 0 24) (G.word8 R.constantBounded))+    mconcat (asVector64s 1 [mconcat bss]) === mconcat (asVector64s 1 bss)+    True === True+  it "Conversion of ByteString works 2" $ requireProperty $ do+    bss <- forAll $ (BS.pack <$>) <$> G.list (R.linear 0 8) (G.list (R.linear 0 24) (G.word8 R.constantBounded))+    let actual    = mconcat (asVector64s 1 [mconcat bss])+    let expected  = mconcat (asVector64s 1 bss)+    (reverse . dropWhile (== 0) . reverse) (DVS.toList actual) === (reverse . dropWhile (== 0) . reverse) (DVS.toList expected)+    True === True