hw-prim 0.6.1.0 → 0.6.2.0
raw patch · 4 files changed
+71/−20 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ HaskellWorks.Data.Vector.AsVector64: instance HaskellWorks.Data.Vector.AsVector64.AsVector64 Data.ByteString.Internal.ByteString
Files
- hw-prim.cabal +2/−2
- src/HaskellWorks/Data/Vector/AsVector64.hs +41/−0
- src/HaskellWorks/Data/Vector/AsVector64s.hs +19/−17
- test/HaskellWorks/Data/Vector/AsVector64sSpec.hs +9/−1
hw-prim.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: b4513a18c623ca2703a2c1fc185d0b0ff8165c970ded30e2cf582ae54be58819+-- hash: 3da5a5c4ec15aafba41e3a027d8092886e0bca1ad4a9bcb85767e43bf4684b59 name: hw-prim-version: 0.6.1.0+version: 0.6.2.0 synopsis: Primitive functions and data types description: Please see README.md category: Data
src/HaskellWorks/Data/Vector/AsVector64.hs view
@@ -3,8 +3,10 @@ ( AsVector64(..) ) where +import Data.Bits import Data.Word +import qualified Data.ByteString as BS import qualified Data.Vector.Storable as DVS class AsVector64 a where@@ -12,3 +14,42 @@ instance AsVector64 (DVS.Vector Word64) where asVector64 = id++instance AsVector64 BS.ByteString where+ asVector64 bs = DVS.constructN ((BS.length bs + 7) `div` 8) go+ where go :: DVS.Vector Word64 -> Word64+ go u = let bsi = DVS.length u * 8 in+ if bsi + 8 <= BS.length bs+ then let w0 = fromIntegral $ BS.index bs (bsi + 0)+ w1 = fromIntegral $ BS.index bs (bsi + 1)+ w2 = fromIntegral $ BS.index bs (bsi + 2)+ w3 = fromIntegral $ BS.index bs (bsi + 3)+ w4 = fromIntegral $ BS.index bs (bsi + 4)+ w5 = fromIntegral $ BS.index bs (bsi + 5)+ w6 = fromIntegral $ BS.index bs (bsi + 6)+ w7 = fromIntegral $ BS.index bs (bsi + 7)+ in (w0 `shiftL` 0) .|.+ (w1 `shiftL` 8) .|.+ (w2 `shiftL` 16) .|.+ (w3 `shiftL` 24) .|.+ (w4 `shiftL` 32) .|.+ (w5 `shiftL` 40) .|.+ (w6 `shiftL` 48) .|.+ (w7 `shiftL` 56)+ else let w0 = let i = bsi + 0 in if i < BS.length bs then fromIntegral $ BS.index bs (bsi + 0) else 0+ w1 = let i = bsi + 1 in if i < BS.length bs then fromIntegral $ BS.index bs (bsi + 1) else 0+ w2 = let i = bsi + 2 in if i < BS.length bs then fromIntegral $ BS.index bs (bsi + 2) else 0+ w3 = let i = bsi + 3 in if i < BS.length bs then fromIntegral $ BS.index bs (bsi + 3) else 0+ w4 = let i = bsi + 4 in if i < BS.length bs then fromIntegral $ BS.index bs (bsi + 4) else 0+ w5 = let i = bsi + 5 in if i < BS.length bs then fromIntegral $ BS.index bs (bsi + 5) else 0+ w6 = let i = bsi + 6 in if i < BS.length bs then fromIntegral $ BS.index bs (bsi + 6) else 0+ w7 = let i = bsi + 7 in if i < BS.length bs then fromIntegral $ BS.index bs (bsi + 7) else 0+ in (w0 `shiftL` 0) .|.+ (w1 `shiftL` 8) .|.+ (w2 `shiftL` 16) .|.+ (w3 `shiftL` 24) .|.+ (w4 `shiftL` 32) .|.+ (w5 `shiftL` 40) .|.+ (w6 `shiftL` 48) .|.+ (w7 `shiftL` 56)+
src/HaskellWorks/Data/Vector/AsVector64s.hs view
@@ -1,5 +1,8 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} module HaskellWorks.Data.Vector.AsVector64s ( AsVector64s(..)@@ -29,35 +32,34 @@ {-# 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 []+bytestringsToVectors n bss = go bss+ where go :: [BS.ByteString] -> [DVS.Vector Word64]+ go bs = case DVS.createT (buildOneVector n bs) of+ (cs, ws) -> if DVS.length ws > 0+ then ws:go cs+ else [] {-# 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+buildOneVector :: forall s. Int -> [BS.ByteString] -> ST s ([BS.ByteString], DVS.MVector s Word64)+buildOneVector n ss = case dropWhile ((== 0) . BS.length) ss of+ [] -> ([],) <$> DVSM.new 0 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]+ return (rs, v64)+ where go :: [BS.ByteString] -> DVSM.MVector s Word8 -> ST s [BS.ByteString] 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+ if BS.length u <= DVSM.length v+ then case DVSM.splitAt (BS.length u) v of (va, vb) -> do- DVSM.copy va u+ DVSM.copy va (byteStringToVector8 u) go us vb- else case DVSM.splitAt (DVSM.length v) u of+ else case BS.splitAt (DVSM.length v) u of (ua, ub) -> do- DVSM.copy v ua+ DVSM.copy v (byteStringToVector8 ua) return (ub:us) [] -> do DVSM.set v 0
test/HaskellWorks/Data/Vector/AsVector64sSpec.hs view
@@ -6,6 +6,7 @@ ( spec ) where +import HaskellWorks.Data.Vector.AsVector64 import HaskellWorks.Data.Vector.AsVector64s import HaskellWorks.Hspec.Hedgehog import Hedgehog@@ -20,7 +21,7 @@ spec :: Spec spec = describe "HaskellWorks.Data.Vector.AsVector64sSpec" $ do- it "Conversion of ByteString works" $ requireProperty $ do+ it "Conversion of ByteString works 1" $ 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@@ -30,3 +31,10 @@ let expected = mconcat (asVector64s 1 bss) (reverse . dropWhile (== 0) . reverse) (DVS.toList actual) === (reverse . dropWhile (== 0) . reverse) (DVS.toList expected) True === True+ it "Conversion of ByteString works 3" $ 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 bss)+ let expected = asVector64 (mconcat bss)+ (reverse . dropWhile (== 0) . reverse) (DVS.toList actual) === (reverse . dropWhile (== 0) . reverse) (DVS.toList expected)+ True === True+