diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2019, Balazs Komuves +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +- Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +- Neither names of the copyright holders nor the names of the contributors +may be used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/compact-word-vectors.cabal b/compact-word-vectors.cabal new file mode 100644 --- /dev/null +++ b/compact-word-vectors.cabal @@ -0,0 +1,66 @@ +Name: compact-word-vectors +Version: 0.1 +Synopsis: Small vectors of small integers stored very compactly. +Description: A data structure to store small vectors of small integers + with minimal memory overhead. For example the vector + corresponding to [1..14] only takes 16 bytes (2 machine + words on 64 bit architectures) of heap memory. +License: BSD3 +License-file: LICENSE +Author: Balazs Komuves +Copyright: (c) 2019 Balazs Komuves +Maintainer: bkomuves (plus) hackage (at) gmail (dot) com +Homepage: http://moire.be/haskell/ +Stability: Experimental +Category: Data +Tested-With: GHC == 8.6.5 +Cabal-Version: 1.24 +Build-Type: Simple + +source-repository head + type: git + location: https://github.com/bkomuves/compact-word-vectors + +-------------------------------------------------------------------------------- + +Library + + Build-Depends: base >= 4 && < 5, primitive >= 0.7 + + Exposed-Modules: Data.Vector.Compact.WordVec + Data.Vector.Compact.IntVec + Data.Vector.Compact.Blob + + Default-Extensions: CPP, BangPatterns + Other-Extensions: MagicHash, UnboxedTuples + + Default-Language: Haskell2010 + + Hs-Source-Dirs: src + + ghc-options: -fwarn-tabs -fno-warn-unused-matches -fno-warn-name-shadowing -fno-warn-unused-imports + + +-------------------------------------------------------------------------------- + +test-suite compact-word-vector-tests + + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: TestSuite.hs + + other-modules: Tests.Blob + Tests.WordVec + Tests.IntVec + + build-depends: base >= 4 && < 5, primitive >= 0.7, random, + compact-word-vectors >= 0.1, + QuickCheck >= 2, + tasty, tasty-quickcheck, tasty-hunit + + Default-Language: Haskell2010 + Default-Extensions: CPP, BangPatterns + +-------------------------------------------------------------------------------- + + diff --git a/src/Data/Vector/Compact/Blob.hs b/src/Data/Vector/Compact/Blob.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Compact/Blob.hs @@ -0,0 +1,403 @@ + +-- | Blobs are raw data in continuous regions of memory. +-- +-- This library provides a type for blobs consisting 64 bit words +-- which is optimized for small sizes. They take: +-- +-- * only 1 extra word up for blobs of size up to 48 bytes (that is, up to 6 @Word64@-s); +-- +-- * but (unfortunataly) 4 extra words above that. +-- +-- (This particular tradeoff was chosen so that pointer tagging still +-- works on 64 bit architectures: there are 7 constructors of the data type.) +-- +-- The 'Blob' data type is useful if you want to store large amounts of small, +-- serialized data. Some example use cases: +-- +-- * small vectors of small nonnegative integers (for example: partitions, permutations, monomials) +-- +-- * cryptographic hashes +-- +-- * tables indexed by such things +-- + +{-# LANGUAGE CPP, BangPatterns, MagicHash, UnboxedTuples #-} +module Data.Vector.Compact.Blob where + +-------------------------------------------------------------------------------- + +import Data.Char +import Data.Bits +import Data.Int +import Data.Word +import Data.List + +import Control.Monad +import Control.Monad.ST + +import GHC.Int +import GHC.Word +import GHC.Ptr +import GHC.Exts +import GHC.IO + +import Foreign.Ptr +import Foreign.Marshal.Array + +import Control.Monad.Primitive +import Data.Primitive.ByteArray + +-------------------------------------------------------------------------------- +-- * the Blob type + +-- | A 'Blob' is a nonempty array of 'Word64'-s. +-- For arrays of length at most 6 (that is, at most 48 bytes), there is only a single +-- machine word overhead in memory consumption. For larger arrays, there is 4 words of overhead. +-- +data Blob + = Blob1 {-# UNPACK #-} !Word64 + | Blob2 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 + | Blob3 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 + | Blob4 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 + | Blob5 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 + | Blob6 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 + | BlobN !(ByteArray#) + +-------------------------------------------------------------------------------- + +blobTag :: Blob -> Int +blobTag blob = I# (dataToTag# blob) + +-- | Number of 'Word64'-s +blobSizeInWords :: Blob -> Int +blobSizeInWords blob = case blob of + BlobN arr -> shiftR (I# (sizeofByteArray# arr)) 3 + otherwise -> blobTag blob + 1 + +blobSizeInBytes :: Blob -> Int +blobSizeInBytes blob = case blob of + BlobN arr -> I# (sizeofByteArray# arr) + otherwise -> shiftL (blobTag blob + 1) 3 + +blobSizeInBits :: Blob -> Int +blobSizeInBits blob = shiftL (blobSizeInBytes blob) 3 + +-------------------------------------------------------------------------------- +-- * Conversion to\/from lists + +blobFromWordList :: [Word64] -> Blob +blobFromWordList ws = blobFromWordListN (length ws) ws + +blobFromWordListN :: Int -> [Word64] -> Blob +blobFromWordListN n ws = case n of + 0 -> Blob1 0 + 1 -> case ws of { (a:_) -> Blob1 a } + 2 -> case ws of { (a:b:_) -> Blob2 a b } + 3 -> case ws of { (a:b:c:_) -> Blob3 a b c } + 4 -> case ws of { (a:b:c:d:_) -> Blob4 a b c d } + 5 -> case ws of { (a:b:c:d:e:_) -> Blob5 a b c d e } + 6 -> case ws of { (a:b:c:d:e:f:_) -> Blob6 a b c d e f } + _ -> case byteArrayFromListN n ws of + ByteArray ba# -> BlobN ba# + +blobToWordList :: Blob -> [Word64] +blobToWordList blob = case blob of + Blob1 a -> a:[] + Blob2 a b -> a:b:[] + Blob3 a b c -> a:b:c:[] + Blob4 a b c d -> a:b:c:d:[] + Blob5 a b c d e -> a:b:c:d:e:[] + Blob6 a b c d e f -> a:b:c:d:e:f:[] + BlobN ba# -> foldrByteArray (:) [] (ByteArray ba#) + +-------------------------------------------------------------------------------- +-- * Conversion to\/from @ByteArray@-s + +-- | Note: we pad the input with zero bytes, assuming little-endian architecture. +blobFromByteArray :: ByteArray -> Blob +blobFromByteArray ba@(ByteArray ba#) + | nwords > 6 = if nwords1 == nwords + then BlobN ba# + else let ByteArray new# = byteArrayFromListN nwords words + in BlobN new# + | nwords == 0 = Blob1 0 + | otherwise = blobFromWordListN nwords words + where + !nbytes = sizeofByteArray ba + !nwords1 = shiftR (nbytes ) 3 + !nwords = shiftR (nbytes + 7) 3 + + words :: [Word64] + words = if nwords1 == nwords + then foldrByteArray (:) [] (ByteArray ba#) + else let !ofs = shiftL nwords1 3 + !m = nbytes - ofs + w8_to_w64 :: Word8 -> Word64 + w8_to_w64 = fromIntegral + !lastWord = foldl' (.|.) 0 [ shiftL (w8_to_w64 (indexByteArray ba (ofs + i))) (shiftL i 3) | i<-[0..m-1] ] + in foldrByteArray (:) [] (ByteArray ba#) ++ [lastWord] + +blobToByteArray :: Blob -> ByteArray +blobToByteArray blob = case blob of + BlobN ba# -> ByteArray ba# + _ -> byteArrayFromListN (blobSizeInWords blob) (blobToWordList blob) + +-------------------------------------------------------------------------------- + +instance Show Blob where + showsPrec prec blob + = showParen (prec > 10) + $ showString "blobFromWordList " + . shows (map Hex $ blobToWordList blob) + +instance Eq Blob where + (==) = eqBlob + +eqBlob :: Blob -> Blob -> Bool +eqBlob !x !y = if blobTag x /= blobTag y + then False + else case (x,y) of + ( Blob1 a , Blob1 p ) -> a==p + ( Blob2 a b , Blob2 p q ) -> a==p && b==q + ( Blob3 a b c , Blob3 p q r ) -> a==p && b==q && c==r + ( Blob4 a b c d , Blob4 p q r s ) -> a==p && b==q && c==r && d==s + ( Blob5 a b c d e , Blob5 p q r s t ) -> a==p && b==q && c==r && d==s && e==t + ( Blob6 a b c d e f , Blob6 p q r s t u ) -> a==p && b==q && c==r && d==s && e==t && f==u + ( BlobN one# , BlobN two# ) -> ByteArray one# == ByteArray two# + _ -> error "FATAL ERROR: should not happen" + +-------------------------------------------------------------------------------- +-- * Hexadecimal + +newtype Hex + = Hex Word64 + +instance Show Hex where + show (Hex w) = hexWord64 w + +hexWord64 :: Word64 -> String +hexWord64 word= '0' : 'x' : hexWord64_ word + +hexWord64_ :: Word64 -> String +hexWord64_ word = go [] 16 word where + + go !acc 0 !w = acc + go !acc !k !w = go (hexNibble (w .&. 15) : acc) (k-1) (shiftR w 4) + + hexNibble :: Integral a => a -> Char + hexNibble i0 = let i = (fromIntegral i0 :: Int) in if (i < 10) then chr (i+48) else chr (i+87) + +-------------------------------------------------------------------------------- +-- * Peek + +peekWord :: Blob -> Int -> Word64 +peekWord blob idx = case blob of + + Blob1 a + | idx == 0 -> a + | otherwise -> error "Blob/peekWord: index out of bounds" + + Blob2 a b + | idx == 0 -> a + | idx == 1 -> b + | otherwise -> error "Blob/peekWord: index out of bounds" + + Blob3 a b c + | idx == 0 -> a + | idx == 1 -> b + | idx == 2 -> c + | otherwise -> error "Blob/peekWord: index out of bounds" + + Blob4 a b c d + | idx == 0 -> a + | idx == 1 -> b + | idx == 2 -> c + | idx == 3 -> d + | otherwise -> error "Blob/peekWord: index out of bounds" + + Blob5 a b c d e + | idx == 0 -> a + | idx == 1 -> b + | idx == 2 -> c + | idx == 3 -> d + | idx == 4 -> e + | otherwise -> error "Blob/peekWord: index out of bounds" + + Blob6 a b c d e f + | idx == 0 -> a + | idx == 1 -> b + | idx == 2 -> c + | idx == 3 -> d + | idx == 4 -> e + | idx == 5 -> f + | otherwise -> error "Blob/peekWord: index out of bounds" + + BlobN arr# -> indexByteArray (ByteArray arr#) idx + +-- | NOTE: We assume a little-endian architecture here. +-- Though it seems that since GHC does not gives us direct access to the closure, +-- it doesn\'t matter after all... +-- +peekByte :: Blob -> Int -> Word8 +peekByte blob idx = + let w = peekWord blob (shiftR idx 3) + in fromIntegral $ shiftR w (8 * (idx .&. 7)) + +blobHead :: Blob -> Word64 +blobHead blob = case blob of + Blob1 a -> a + Blob2 a _ -> a + Blob3 a _ _ -> a + Blob4 a _ _ _ -> a + Blob5 a _ _ _ _ -> a + Blob6 a _ _ _ _ _ -> a + BlobN arr# -> indexByteArray (ByteArray arr#) 0 + +-------------------------------------------------------------------------------- + +-- | @extractSmallWord n blob ofs@ extracts a small word of @n@ bits starting from the +-- @ofs@-th bit. This should satisfy +-- +-- > testBit (extractSmallWord n blob ofs) i == testBit blob (ofs+i) +-- +-- NOTE: we assume that @n@ is at most the bits in 'Word', and that @ofs+n@ is less +-- than the size (in bits) of the blob. +-- +extractSmallWord :: Integral a => Int -> Blob -> Int -> a +extractSmallWord n blob ofs = fromIntegral (extractSmallWord64 n blob ofs) + +extractSmallWord64 :: Int -> Blob -> Int -> Word64 +extractSmallWord64 !n !blob !ofs + | q2 == q1 = mask .&. shiftR (peekWord blob q1) r1 + | q2 == q1 + 1 = mask .&. (shiftR (peekWord blob q1) r1 .|. shiftL (peekWord blob q2) (64-r1)) + | otherwise = error "Blob/extractSmallWord: FATAL ERROR" + where + mask = shiftL 1 n - 1 + end = ofs + n - 1 + q1 = shiftR ofs 6 + q2 = shiftR end 6 + r1 = ofs .&. 63 + +-- | An alternate implementation using 'testBit', for testing purposes only +extractSmallWord64_naive :: Int -> Blob -> Int -> Word64 +extractSmallWord64_naive n blob ofs = sum [ shiftL 1 i | i<-[0..n-1] , testBit blob (ofs+i) ] + +-------------------------------------------------------------------------------- +-- * change size + +extendToSize :: Int -> Blob -> Blob +extendToSize tgt blob + | n >= tgt = blob + | otherwise = blobFromWordListN tgt (blobToWordList blob ++ replicate (tgt-n) 0) + where + n = blobSizeInWords blob + +cutToSize :: Int -> Blob -> Blob +cutToSize tgt blob + | n <= tgt = blob + | otherwise = blobFromWordListN tgt (take tgt $ blobToWordList blob) + where + n = blobSizeInWords blob + +forceToSize :: Int -> Blob -> Blob +forceToSize tgt blob + | n == tgt = blob + | n >= tgt = blobFromWordListN tgt (take tgt $ blobToWordList blob) + | otherwise = blobFromWordListN tgt (blobToWordList blob ++ replicate (tgt-n) 0) + where + n = blobSizeInWords blob + +-------------------------------------------------------------------------------- +-- * map and zipWith + +mapBlob :: (Word64 -> Word64) -> Blob -> Blob +mapBlob f blob = case blob of + Blob1 a -> Blob1 (f a) + Blob2 a b -> Blob2 (f a) (f b) + Blob3 a b c -> Blob3 (f a) (f b) (f c) + Blob4 a b c d -> Blob4 (f a) (f b) (f c) (f d) + Blob5 a b c d e -> Blob5 (f a) (f b) (f c) (f d) (f e) + Blob6 a b c d e y -> Blob6 (f a) (f b) (f c) (f d) (f e) (f y) + BlobN arr# -> runST $ do + let !n = blobSizeInWords blob + let ba = ByteArray arr# + mut <- newByteArray (shiftL n 3) + forM_ [0..n-1] $ \i -> writeByteArray mut i $ f (indexByteArray ba i) + new@(ByteArray new#) <- unsafeFreezeByteArray mut + return (BlobN new#) + +shortZipWith :: (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob +shortZipWith f !blob1 !blob2 + | n1 == n2 = unsafeZipWith f blob1 blob2 + | n1 > n2 = unsafeZipWith f (cutToSize n2 blob1) blob2 + | otherwise = unsafeZipWith f blob1 (cutToSize n1 blob2) + where + n1 = blobSizeInWords blob1 + n2 = blobSizeInWords blob2 + +longZipWith :: (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob +longZipWith f !blob1 !blob2 + | n1 == n2 = unsafeZipWith f blob1 blob2 + | n1 < n2 = unsafeZipWith f (extendToSize n2 blob1) blob2 + | otherwise = unsafeZipWith f blob1 (extendToSize n1 blob2) + where + n1 = blobSizeInWords blob1 + n2 = blobSizeInWords blob2 + +unsafeZipWith :: (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob +unsafeZipWith f !blob1 !blob2 = case (blob1,blob2) of + ( Blob1 a , Blob1 p ) -> Blob1 (f a p) + ( Blob2 a b , Blob2 p q ) -> Blob2 (f a p) (f b q) + ( Blob3 a b c , Blob3 p q r ) -> Blob3 (f a p) (f b q) (f c r) + ( Blob4 a b c d , Blob4 p q r s ) -> Blob4 (f a p) (f b q) (f c r) (f d s) + ( Blob5 a b c d e , Blob5 p q r s t ) -> Blob5 (f a p) (f b q) (f c r) (f d s) (f e t) + ( Blob6 a b c d e y , Blob6 p q r s t u ) -> Blob6 (f a p) (f b q) (f c r) (f d s) (f e t) (f y u) + ( BlobN one# , BlobN two# ) -> + runST $ do + let !n = blobSizeInWords blob1 + ba1 = ByteArray one# + ba2 = ByteArray two# + mut <- newByteArray (shiftL n 3) + forM_ [0..n-1] $ \i -> writeByteArray mut i $ f (indexByteArray ba1 i) (indexByteArray ba2 i) + new@(ByteArray new#) <- unsafeFreezeByteArray mut + return (BlobN new#) + _ -> error "FATAL ERROR: should not happen" + +-------------------------------------------------------------------------------- + +instance Bits Blob where + (.&.) = shortZipWith (.&.) + (.|.) = longZipWith (.|.) + xor = longZipWith xor + complement = mapBlob complement + + shiftL = error "shiftR" + shiftR = error "shiftR" + rotateL = error "rotateL" + rotateR = error "rotateR" + +#if MIN_VERSION_base(4,12,0) + bitSizeMaybe = Just . blobSizeInBits + bitSize = blobSizeInBits +#else + bitSize = blobSizeInBits +#endif + + zeroBits = Blob1 0 + isSigned _ = False + popCount blob = foldl' (+) 0 (map popCount $ blobToWordList blob) + + testBit !blob !k = if q >= n then False else testBit (peekWord blob q) r where + (q,r) = divMod k 64 + n = blobSizeInWords blob + + bit k = blobFromWordListN (q+1) (replicate q 0 ++ [bit r]) where + (q,r) = divMod k 64 + +#if MIN_VERSION_base(4,12,0) +instance FiniteBits Blob where + finiteBitSize = blobSizeInBits +#endif + +-------------------------------------------------------------------------------- + diff --git a/src/Data/Vector/Compact/IntVec.hs b/src/Data/Vector/Compact/IntVec.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Compact/IntVec.hs @@ -0,0 +1,147 @@ + +-- | Signed integer version of dynamic word vectors. +-- +-- See "Data.Vector.Compact.WordVec" for more details. + +{-# LANGUAGE BangPatterns #-} +module Data.Vector.Compact.IntVec where + +-------------------------------------------------------------------------------- + +import Data.Bits +import Data.List + +import Data.Vector.Compact.WordVec ( Shape(..) ) +import qualified Data.Vector.Compact.WordVec as Dyn + +-------------------------------------------------------------------------------- +-- * The dynamic Int vector type + +-- | A dynamic int vector is a (small) vector of small signed integers stored compactly +newtype IntVec + = IntVec Dyn.WordVec + deriving (Eq,Ord) + +vecShape :: IntVec -> Shape +vecShape (IntVec dyn) = Dyn.vecShape dyn + +vecLen :: IntVec -> Int +vecLen (IntVec dyn) = Dyn.vecLen dyn + +vecBits :: IntVec -> Int +vecBits (IntVec dyn) = Dyn.vecBits dyn + +-------------------------------------------------------------------------------- + +instance Show IntVec where + showsPrec = showsPrecIntVec + +showIntVec :: IntVec -> String +showIntVec vec = showsPrecIntVec 0 vec [] + +showsPrecIntVec :: Int -> IntVec -> ShowS +showsPrecIntVec prec intvec + = showParen (prec > 10) + $ showString "fromList " +-- . showsPrec 11 (lenMinMax intvec) + . showChar ' ' + . shows (toList intvec) + +-------------------------------------------------------------------------------- +-- * Empty + +empty :: IntVec +empty = fromList [] + +null :: IntVec -> Bool +null v = vecLen v == 0 + +-------------------------------------------------------------------------------- +-- * Conversion from\/to lists + +toList :: IntVec -> [Int] +toList (IntVec dynvec) = map (word2int bits) $ Dyn.toList dynvec where + !bits = Dyn.vecBits dynvec + +fromList :: [Int] -> IntVec +fromList xs = IntVec $ Dyn.fromList' (Dyn.Shape len bits) $ map (int2word bits) xs where + (!len,!minMax) = lenMinMax xs + !bits = roundBits (bitsNeededForMinMax minMax) + +fromList' :: (Int,(Int,Int)) -> [Int] -> IntVec +fromList' (!len,!minMax) xs = IntVec $ Dyn.fromList' (Dyn.Shape len bits) $ map (int2word bits) xs where + !bits = roundBits (bitsNeededForMinMax minMax) + +lenMinMax :: [Int] -> (Int,(Int,Int)) +lenMinMax = go 0 0 0 where + go !cnt !p !q (x:xs) = go (cnt+1) (min x p) (max x q) xs + go !cnt !p !q [] = (cnt,(p,q)) + +int2word :: Int -> (Int -> Word) +int2word !bits = i2w where + !mask = shiftL 1 bits - 1 :: Word + + i2w :: Int -> Word + i2w x = (fromIntegral x :: Word) .&. mask + +word2int :: Int -> (Word -> Int) +word2int !bits = w2i where + !mask = shiftL 1 bits - 1 :: Word + !ffff = complement mask :: Word + !bitsMinus1 = bits - 1 + + w2i :: Word -> Int + w2i x = case testBit x bitsMinus1 of + False -> fromIntegral x -- non-negative + True -> fromIntegral (ffff .|. x) -- negative + +-------------------------------------------------------------------------------- +-- * Indexing + +unsafeIndex :: Int -> IntVec -> Int +unsafeIndex idx (IntVec dynvec) = word2int bits (Dyn.unsafeIndex idx dynvec) where + !bits = Dyn.vecBits dynvec + +safeIndex :: Int -> IntVec -> Maybe Int +safeIndex idx (IntVec dynvec) = (word2int bits) <$> (Dyn.safeIndex idx dynvec) where + !bits = Dyn.vecBits dynvec + +head :: IntVec -> Int +head (IntVec dynvec) = word2int bits (Dyn.head dynvec) where + !bits = Dyn.vecBits dynvec + +-------------------------------------------------------------------------------- + +{- +concat :: IntVec -> IntVec -> IntVec +concat u v = fromList' (Shape (lu+lv) (max bu bv)) (toList u ++ toList v) where + Shape lu bu = vecShape u + Shape lv bv = vecShape v +-} + +-------------------------------------------------------------------------------- +-- * helpers for counting the necessary number of bits + +bitsNeededForMinMax :: (Int,Int) -> Int +bitsNeededForMinMax (p,q) = max (bitsNeededFor p) (bitsNeededFor q) + +bitsNeededFor :: Int -> Int +bitsNeededFor bound + | bound >= 0 = ceilingLog2 ( bound + 1) + 1 -- +8 needs 5 bits (-16..+15) + | bound < 0 = ceilingLog2 (abs bound ) + 1 -- -8 needs 4 bits (-8 ..+7 ) + where + + -- | Smallest integer @k@ such that @2^k@ is larger or equal to @n@ + ceilingLog2 :: Int -> Int + ceilingLog2 0 = 0 + ceilingLog2 n = 1 + go (n-1) where + go 0 = -1 + go k = 1 + go (shiftR k 1) + +-- | We only allow multiples of 4. +roundBits :: Int -> Int +roundBits 0 = 4 +roundBits k = shiftL (shiftR (k+3) 2) 2 + +-------------------------------------------------------------------------------- + diff --git a/src/Data/Vector/Compact/WordVec.hs b/src/Data/Vector/Compact/WordVec.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Compact/WordVec.hs @@ -0,0 +1,271 @@ + +-- | Vector of (small) words which adapt their representation +-- to make them more compact when the elements are small. +-- +-- This is data structure engineered to store large amount of +-- small vectors of small elements compactly on memory. +-- +-- For example the list @[1..14] :: [Int]@ consumes 576 bytes (72 words) on +-- a 64 bit machine, while the corresponding 'WordVec' takes only +-- 16 bytes (2 words), and the one corresponding to @[101..115]@ still only +-- 24 bytes (3 words). +-- +-- Unboxed arrays or unboxed vectors are better, as they only have a constant +-- overhead, but those constants are big: 13 words (104 bytes on 64 bit) +-- for unboxed arrays, and 6 words (48 bytes) for unboxed vectors. And you +-- still have to select the number of bits per element in advance. +-- +-- Some operations may be a bit slower, but hopefully the cache-friendlyness +-- will somewhat balance that (a simple microbenchmark with 'Data.Map'-s +-- indexed by @[Int]@ vs. @WordVec@ showed a 2x improvement in speed and +-- 20x improvement in memory usage). In any case the primary goal +-- here is optimized memory usage. +-- +-- TODO: ability to add user-defined (fixed-length) header, it can be useful +-- for some applications +-- + +{-# LANGUAGE BangPatterns #-} +module Data.Vector.Compact.WordVec where + +-------------------------------------------------------------------------------- + +import Data.Bits +import Data.Word + +import Data.Vector.Compact.Blob + +-------------------------------------------------------------------------------- +-- * The dynamic Word vector type + +-- | Dynamic word vectors are internally 'Blob'-s, which the first few bits +-- encoding their shape, and after that their content. +-- +-- * small vectors has 2 bits of \"resolution\" and 5 bits of length +-- * big vectors has 4 bits of \"resolution\" and 27 bits of length +-- +-- Resolution encodes the number of bits per element. The latter is always a multiple +-- of 4 (that is: 4 bits per element, or 8, or 12, etc. up to 64 bits per element). +-- +-- We use the very first bit to decide which of these two encoding we use. +-- (if we would make a sum type instead, it would take 2 extra words...) +-- +newtype WordVec = WordVec Blob + -- deriving Show + +-- | The \"shape\" of a dynamic word vector +data Shape = Shape + { shapeLen :: !Int -- ^ length of the vector + , shapeBits :: !Int -- ^ bits per element (quantized to multiples of 4) + } + deriving (Eq,Show) + +vecShape :: WordVec -> Shape +vecShape = snd . vecShape' + +vecShape' :: WordVec -> (Bool,Shape) +vecShape' (WordVec blob) = (isSmall,shape) where + !h = blobHead blob + !h2 = shiftR h 1 + !isSmall = (h .&. 1) == 0 + shape = if isSmall + then mkShape (shiftR h 3 .&. 31 ) (shiftL ((h2.&. 3)+1) 2) + else mkShape (shiftR h 5 .&. 0x07ffffff) (shiftL ((h2.&.15)+1) 2) + mkShape :: Word64 -> Word64 -> Shape + mkShape !x !y = Shape (fromIntegral x) (fromIntegral y) + +vecIsSmall :: WordVec -> Bool +vecIsSmall (WordVec blob) = (blobHead blob .&. 1) == 0 + +vecLen, vecBits :: WordVec -> Int +vecLen = shapeLen . vecShape +vecBits = shapeBits . vecShape + +-------------------------------------------------------------------------------- +-- * Instances + +instance Show WordVec where + showsPrec = showsPrecWordVec + +showWordVec :: WordVec -> String +showWordVec dynvec = showsPrecWordVec 0 dynvec [] + +showsPrecWordVec :: Int -> WordVec -> ShowS +showsPrecWordVec prec dynvec + = showParen (prec > 10) + $ showString "fromList' " + . showsPrec 11 (vecShape dynvec) + . showChar ' ' + . shows (toList dynvec) + +instance Eq WordVec where + (==) x y = (vecLen x == vecLen y) && (toList x == toList y) + +instance Ord WordVec where + compare x y = case compare (vecLen x) (vecLen y) of + LT -> LT + GT -> GT + EQ -> compare (toList x) (toList y) + +-------------------------------------------------------------------------------- +-- * Empty vectors + +empty :: WordVec +empty = fromList [] + +null :: WordVec -> Bool +null v = (vecLen v == 0) + +-------------------------------------------------------------------------------- +-- * Indexing + +unsafeIndex :: Int -> WordVec -> Word +unsafeIndex idx dynvec@(WordVec blob) = + case isSmall of + True -> extractSmallWord bits blob ( 8 + bits*idx) + False -> extractSmallWord bits blob (32 + bits*idx) + where + (isSmall, Shape _ bits) = vecShape' dynvec + +safeIndex :: Int -> WordVec -> Maybe Word +safeIndex idx dynvec@(WordVec blob) + | idx < 0 = Nothing + | idx >= len = Nothing + | otherwise = Just $ case isSmall of + True -> extractSmallWord bits blob ( 8 + bits*idx) + False -> extractSmallWord bits blob (32 + bits*idx) + where + (isSmall, Shape len bits) = vecShape' dynvec + +head :: WordVec -> Word +head dynvec@(WordVec blob) = + case vecIsSmall dynvec of + True -> extractSmallWord bits blob 8 + False -> extractSmallWord bits blob 32 + where + bits = vecBits dynvec + +-------------------------------------------------------------------------------- +-- * Conversion to\/from lists + +toList :: WordVec -> [Word] +toList dynvec@(WordVec blob) = + case isSmall of + True -> worker 8 len (shiftR header 8 : restOfWords) + False -> worker 32 len (shiftR header 32 : restOfWords) + + where + isSmall = (header .&. 1) == 0 + (header:restOfWords) = blobToWordList blob + + Shape len bits = vecShape dynvec + + the_mask = shiftL 1 bits - 1 :: Word64 + + mask :: Word64 -> Word + mask w = fromIntegral (w .&. the_mask) + + worker !bitOfs !0 _ = [] + worker !bitOfs !k [] = replicate k 0 -- this shouldn't happen btw + worker !bitOfs !k (this:rest) = + let newOfs = bitOfs + bits + in case compare newOfs 64 of + LT -> (mask this) : worker newOfs (k-1) (shiftR this bits : rest) + EQ -> (mask this) : worker 0 (k-1) rest + GT -> case rest of + (that:rest') -> + let !newOfs' = newOfs - 64 + !elem = mask (this .|. shiftL that (64-bitOfs)) + in elem : worker newOfs' (k-1) (shiftR that newOfs' : rest') + [] -> error "WordVec/toList: FATAL ERROR! this should not happen" + +-- | Another implementation of 'toList', for testing purposes only +toList_naive :: WordVec -> [Word] +toList_naive dynvec@(WordVec blob) = + case isSmall of + True -> [ extractSmallWord bits blob ( 8 + bits*i) | i<-[0..len-1] ] + False -> [ extractSmallWord bits blob (32 + bits*i) | i<-[0..len-1] ] + where + (isSmall, Shape len bits) = vecShape' dynvec + +-------------------------------------------------------------------------------- + +fromList :: [Word] -> WordVec +fromList [] = fromList' (Shape 0 4) [] +fromList xs = fromList' (Shape l b) xs where + l = length xs + b = bitsNeededFor (maximum xs) + +fromList' :: Shape -> [Word] -> WordVec +fromList' (Shape len bits0) words + | bits <= 16 && len <= 31 = WordVec $ mkBlob (mkHeader 0 2) 8 words + | otherwise = WordVec $ mkBlob (mkHeader 1 4) 32 words + + where + !bits = max 4 $ min 64 $ (bits0 + 3) .&. 0xfc + !bitsEnc = shiftR bits 2 - 1 :: Int + !content = bits*len :: Int + !mask = shiftL 1 bits - 1 :: Word64 + + mkHeader :: Word64 -> Int -> Word64 + mkHeader !isSmall !resoBits = isSmall + fromIntegral (shiftL (bitsEnc + shiftL len resoBits) 1) + + mkBlob !header !ofs words = blobFromWordListN (shiftR (ofs+content+63) 6) + $ worker len header ofs words + + worker :: Int -> Word64 -> Int -> [Word] -> [Word64] + worker 0 !current !bitOfs _ = if bitOfs == 0 then [] else [current] + worker !k !current !bitOfs [] = worker k current bitOfs [0] + worker !k !current !bitOfs (this0:rest) = + let !this = (fromIntegral this0) .&. mask + !newOfs = bitOfs + bits + !current' = (shiftL this bitOfs) .|. current + in case compare newOfs 64 of + LT -> worker (k-1) current' newOfs rest + EQ -> current' : worker (k-1) 0 0 rest + GT -> let !newOfs' = newOfs - 64 + in current' : worker (k-1) (shiftR this (64-bitOfs)) newOfs' rest + +-------------------------------------------------------------------------------- +-- * Some more operations + +naiveMap :: (Word -> Word) -> WordVec -> WordVec +naiveMap f u = fromList (map f $ toList u) + +-- | If you have a (nearly sharp) upper bound to the result of your of function +-- on your vector, mapping can be more efficient +boundedMap :: Word -> (Word -> Word) -> WordVec -> WordVec +boundedMap bound f vec = fromList' (Shape l bits) (toList vec) where + l = vecLen vec + bits = bitsNeededFor bound + +concat :: WordVec -> WordVec -> WordVec +concat u v = fromList' (Shape (lu+lv) (max bu bv)) (toList u ++ toList v) where + Shape lu bu = vecShape u + Shape lv bv = vecShape v + +naiveZipWith :: (Word -> Word -> Word) -> WordVec -> WordVec -> WordVec +naiveZipWith f u v = fromList $ zipWith f (toList u) (toList v) + +-- | If you have a (nearly sharp) upper bound to the result of your of function +-- on your vector, zipping can be more efficient +boundedZipWith :: Word -> (Word -> Word -> Word) -> WordVec -> WordVec -> WordVec +boundedZipWith bound f vec1 vec2 = fromList' (Shape l bits) $ zipWith f (toList vec1) (toList vec2) where + l = min (vecLen vec1) (vecLen vec2) + bits = bitsNeededFor bound + +-------------------------------------------------------------------------------- +-- * Misc helpers + +bitsNeededFor :: Word -> Int +bitsNeededFor bound = ceilingLog2 (bound + 1) where -- for example, if maximum is 16, log2 = 4 but we need 5 bits + + -- | Smallest integer @k@ such that @2^k@ is larger or equal to @n@ + ceilingLog2 :: Word -> Int + ceilingLog2 0 = 0 + ceilingLog2 n = 1 + go (n-1) where + go 0 = -1 + go k = 1 + go (shiftR k 1) + +-------------------------------------------------------------------------------- + diff --git a/test/TestSuite.hs b/test/TestSuite.hs new file mode 100644 --- /dev/null +++ b/test/TestSuite.hs @@ -0,0 +1,26 @@ + +-- | The test-suite + +module Main where + +-------------------------------------------------------------------------------- + +import Test.Tasty + +import qualified Tests.Blob +import qualified Tests.WordVec +import qualified Tests.IntVec + +-------------------------------------------------------------------------------- + +main = defaultMain tests + +tests :: TestTree +tests = testGroup "Tests" + [ Tests.Blob.all_tests + , Tests.WordVec.all_tests + , Tests.IntVec.all_tests + ] + +-------------------------------------------------------------------------------- + diff --git a/test/Tests/Blob.hs b/test/Tests/Blob.hs new file mode 100644 --- /dev/null +++ b/test/Tests/Blob.hs @@ -0,0 +1,87 @@ + +-- | Tests for blobs + +{-# LANGUAGE CPP,BangPatterns #-} +module Tests.Blob where + +-------------------------------------------------------------------------------- + +import Data.Word +import Data.List as L + +import Data.Primitive.ByteArray + +import Data.Vector.Compact.Blob + +import Test.Tasty +import Test.Tasty.HUnit + +-------------------------------------------------------------------------------- + +all_tests = tests_blobs + +tests_blobs = testGroup "unit tests for Blobs" + [ testCase "toList . fromList == id" $ forall_ w64_lists prop_from_to_list + , testCase "fromList . toList == id" $ forall_ blobs prop_to_from_blob + , testCase "toList vs. peekWord" $ forall_ blobs prop_tolist_vs_peek + , testCase "blobHead vs. list head" $ forall_ w64_lists prop_head_of_list + , testCase "eqBlob vs. naive" $ forall_ blob_pairs prop_eq_vs_naive + , testCase "fromBA . toBA == id" $ forall_ blobs prop_to_from_bytearray + , testCase "toBA . fromBA == pad" $ forall_ byte_lists prop_from_to_bytearray + ] + +forall_ :: [a] -> (a -> Bool) -> Assertion +forall_ xs cond = assertBool "failed" (and (map cond xs)) + +-------------------------------------------------------------------------------- +-- * inputs + +w64_lists_of_length :: Int -> [[Word64]] +w64_lists_of_length ni = + [ [ i | i<-[1..n] ] + , [ i | i<-[1001+n,1000+n .. 1001] ] + , [ i | i<-[2^32-1-n .. 2^32-1 ] ] + , [ i | i<-[2^32-1 .. 2^32+n-2 ] ] + , [ i | i<-[2^64-1-n .. 2^64-1 ] ] + ] + where + n = fromIntegral ni :: Word64 + +w64_lists = concatMap w64_lists_of_length [1..33] :: [[Word64]] +blobs = map blobFromWordList w64_lists :: [Blob] + +blob_pairs = [ (b1,b2)| b1<-blobs, b2<-blobs ] :: [(Blob,Blob)] + +byte_lists = [ map fromIntegral [1..n] | n<-[1..(512::Int)] ] :: [[Word8]] + +-------------------------------------------------------------------------------- + +eqBlob_naive b1 b2 = blobToWordList b1 == blobToWordList b2 + +baToList :: ByteArray -> [Word8] +baToList = foldrByteArray (:) [] + +pad :: [Word8] -> [Word8] +pad xs = xs ++ replicate (len8-len) 0 where + len = length xs + len8 = 8 * (div (len+7) 8) + +-------------------------------------------------------------------------------- +-- * properties + +prop_from_to_list list = blobToWordList (blobFromWordList list) == list +prop_to_from_blob blob = blobFromWordList (blobToWordList blob) == blob + +prop_tolist_vs_peek blob = [ peekWord blob i | i<-[0..n-1] ] == blobToWordList blob where + n = blobSizeInWords blob + +prop_head_of_list list = blobHead (blobFromWordList list) == L.head list + +prop_eq_vs_naive (b1,b2) = eqBlob b1 b2 == eqBlob_naive b1 b2 + +prop_to_from_bytearray blob = blobFromByteArray (blobToByteArray blob) == blob + +prop_from_to_bytearray list = baToList (blobToByteArray (blobFromByteArray ba)) == pad list where + ba = byteArrayFromList list + +-------------------------------------------------------------------------------- diff --git a/test/Tests/IntVec.hs b/test/Tests/IntVec.hs new file mode 100644 --- /dev/null +++ b/test/Tests/IntVec.hs @@ -0,0 +1,100 @@ + +-- | Tests for dynamic int vectors + +{-# LANGUAGE CPP,BangPatterns #-} +module Tests.IntVec where + +-------------------------------------------------------------------------------- + +import Data.Int +import Data.List as L + +import Data.Vector.Compact.IntVec as V + +import Test.Tasty +import Test.Tasty.HUnit + +#ifdef x86_64_HOST_ARCH +arch_bits = 64 +#elif i386_HOST_ARCH +arch_bits = 32 +#else +arch_bits = 32 +#endif + +-------------------------------------------------------------------------------- + +all_tests = testGroup "unit tests for IntVec-s" + [ tests_small + , tests_bighead + ] + +tests_small = testGroup "unit tests for small dynamic int vectors" + [ testCase "toList . fromList == id" $ forall_ small_Lists prop_from_to_list + , testCase "fromList . toList == id" $ forall_ small_Vecs prop_to_from_vec + , testCase "fromList vs. indexing" $ forall_ small_Lists prop_fromlist_vs_index + , testCase "vec head vs. list head" $ forall_ small_NELists prop_head_of_list + , testCase "head vs. indexing" $ forall_ small_NEVecs prop_head_vs_index + ] + +tests_bighead = testGroup "unit tests for small dynamic int vectors with big heads" + [ testCase "toList . fromList == id" $ forall_ bighead_Lists prop_from_to_list + , testCase "fromList . toList == id" $ forall_ bighead_Vecs prop_to_from_vec + , testCase "fromList vs. indexing" $ forall_ bighead_Lists prop_fromlist_vs_index + , testCase "vec head vs. list head" $ forall_ bighead_NELists prop_head_of_list + , testCase "head vs. indexing" $ forall_ bighead_NEVecs prop_head_vs_index + ] + +forall_ :: [a] -> (a -> Bool) -> Assertion +forall_ xs cond = assertBool "failed" (and (map cond xs)) + +-------------------------------------------------------------------------------- +-- * inputs +newtype List = List [Int] deriving Show +newtype NEList = NEList [Int] deriving Show + +newtype Vec = Vec IntVec deriving Show +newtype NEVec = NEVec IntVec deriving Show + +small_Lists :: [List] +small_Lists = List [] : [ List xs | NEList xs <- small_NELists ] + +small_NELists :: [NEList] +small_NELists = [ NEList [ofs..ofs+len-1] | ofs<-[-25..25] , len<-[1..65] ] + +small_Vecs :: [Vec] +small_Vecs = [ Vec (V.fromList xs) | List xs <- small_Lists ] + +small_NEVecs :: [NEVec] +small_NEVecs = [ NEVec (V.fromList xs) | NEList xs <- small_NELists ] + +-------------------------------------------------------------------------------- + +add_bighead :: List -> [List] +add_bighead (List xs) = + [ List (-2^k-1 : xs) | k<-[1..arch_bits-1] ] ++ + [ List (-2^k : xs) | k<-[1..arch_bits-1] ] ++ + [ List (-2^k+1 : xs) | k<-[1..arch_bits-1] ] ++ + [ List ( 2^k-1 : xs) | k<-[1..arch_bits-1] ] ++ + [ List ( 2^k : xs) | k<-[1..arch_bits-1] ] ++ + [ List ( 2^k+1 : xs) | k<-[1..arch_bits-1] ] + +bighead_Lists = concatMap add_bighead small_Lists :: [List] +bighead_Vecs = [ Vec (V.fromList xs) | List xs <- bighead_Lists ] :: [Vec] +bighead_NELists = [ NEList xs | List xs <- bighead_Lists ] :: [NEList] +bighead_NEVecs = [ NEVec v | Vec v <- bighead_Vecs ] :: [NEVec] + +-------------------------------------------------------------------------------- +-- * properties + +prop_from_to_list (List list) = V.toList (V.fromList list) == list +prop_to_from_vec (Vec vec ) = V.fromList (V.toList vec ) == vec + +prop_fromlist_vs_index (List list) = [ unsafeIndex i vec | i<-[0..n-1] ] == list where + vec = V.fromList list + n = V.vecLen vec + +prop_head_of_list (NEList list) = V.head (V.fromList list) == L.head list +prop_head_vs_index (NEVec vec ) = V.head vec == unsafeIndex 0 vec + +-------------------------------------------------------------------------------- diff --git a/test/Tests/WordVec.hs b/test/Tests/WordVec.hs new file mode 100644 --- /dev/null +++ b/test/Tests/WordVec.hs @@ -0,0 +1,101 @@ + +-- | Tests for dynamic word vectors + +{-# LANGUAGE CPP,BangPatterns #-} +module Tests.WordVec where + +-------------------------------------------------------------------------------- + +import Data.Word +import Data.List as L + +import Data.Vector.Compact.WordVec as V + +import Test.Tasty +import Test.Tasty.HUnit + +#ifdef x86_64_HOST_ARCH +arch_bits = 64 +#elif i386_HOST_ARCH +arch_bits = 32 +#else +arch_bits = 32 +#endif + +-------------------------------------------------------------------------------- + +all_tests = testGroup "unit tests for WordVec-s" + [ tests_small + , tests_bighead + ] + +tests_small = testGroup "unit tests for small dynamic word vectors" + [ testCase "toList . fromList == id" $ forall_ small_Lists prop_from_to_list + , testCase "fromList . toList == id" $ forall_ small_Vecs prop_to_from_vec + , testCase "fromList vs. indexing" $ forall_ small_Lists prop_fromlist_vs_index + , testCase "toList vs. naive" $ forall_ small_Vecs prop_tolist_vs_naive + , testCase "vec head vs. list head" $ forall_ small_NELists prop_head_of_list + , testCase "head vs. indexing" $ forall_ small_NEVecs prop_head_vs_index + ] + +tests_bighead = testGroup "unit tests for small dynamic word vectors with big heads" + [ testCase "toList . fromList == id" $ forall_ bighead_Lists prop_from_to_list + , testCase "fromList . toList == id" $ forall_ bighead_Vecs prop_to_from_vec + , testCase "fromList vs. indexing" $ forall_ bighead_Lists prop_fromlist_vs_index + , testCase "toList vs. naive" $ forall_ bighead_Vecs prop_tolist_vs_naive + , testCase "vec head vs. list head" $ forall_ bighead_NELists prop_head_of_list + , testCase "head vs. indexing" $ forall_ bighead_NEVecs prop_head_vs_index + ] + +forall_ :: [a] -> (a -> Bool) -> Assertion +forall_ xs cond = assertBool "failed" (and (map cond xs)) + +-------------------------------------------------------------------------------- +-- * inputs +newtype List = List [Word] deriving Show +newtype NEList = NEList [Word] deriving Show + +newtype Vec = Vec WordVec deriving Show +newtype NEVec = NEVec WordVec deriving Show + +small_Lists :: [List] +small_Lists = List [] : [ List xs | NEList xs <- small_NELists ] + +small_NELists :: [NEList] +small_NELists = [ NEList [ofs..ofs+len-1] | ofs<-[0..25] , len<-[1..65] ] + +small_Vecs :: [Vec] +small_Vecs = [ Vec (V.fromList xs) | List xs <- small_Lists ] + +small_NEVecs :: [NEVec] +small_NEVecs = [ NEVec (V.fromList xs) | NEList xs <- small_NELists ] + +-------------------------------------------------------------------------------- + +add_bighead :: List -> [List] +add_bighead (List xs) = + [ List (2^k-1 : xs) | k<-[1..arch_bits-1] ] ++ + [ List (2^k : xs) | k<-[1..arch_bits-1] ] ++ + [ List (2^k+1 : xs) | k<-[1..arch_bits-1] ] + +bighead_Lists = concatMap add_bighead small_Lists :: [List] +bighead_Vecs = [ Vec (V.fromList xs) | List xs <- bighead_Lists ] :: [Vec] +bighead_NELists = [ NEList xs | List xs <- bighead_Lists ] :: [NEList] +bighead_NEVecs = [ NEVec v | Vec v <- bighead_Vecs ] :: [NEVec] + +-------------------------------------------------------------------------------- +-- * properties + +prop_from_to_list (List list) = V.toList (V.fromList list) == list +prop_to_from_vec (Vec vec ) = V.fromList (V.toList vec ) == vec + +prop_tolist_vs_naive (Vec vec) = (V.toList vec == V.toList_naive vec) + +prop_fromlist_vs_index (List list) = [ unsafeIndex i vec | i<-[0..n-1] ] == list where + vec = V.fromList list + n = V.vecLen vec + +prop_head_of_list (NEList list) = V.head (V.fromList list) == L.head list +prop_head_vs_index (NEVec vec ) = V.head vec == unsafeIndex 0 vec + +--------------------------------------------------------------------------------