compact-word-vectors (empty) → 0.1
raw patch · 10 files changed
+1232/−0 lines, 10 filesdep +QuickCheckdep +basedep +compact-word-vectorssetup-changed
Dependencies added: QuickCheck, base, compact-word-vectors, primitive, random, tasty, tasty-hunit, tasty-quickcheck
Files
- LICENSE +29/−0
- Setup.hs +2/−0
- compact-word-vectors.cabal +66/−0
- src/Data/Vector/Compact/Blob.hs +403/−0
- src/Data/Vector/Compact/IntVec.hs +147/−0
- src/Data/Vector/Compact/WordVec.hs +271/−0
- test/TestSuite.hs +26/−0
- test/Tests/Blob.hs +87/−0
- test/Tests/IntVec.hs +100/−0
- test/Tests/WordVec.hs +101/−0
+ LICENSE view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ compact-word-vectors.cabal view
@@ -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++--------------------------------------------------------------------------------++
+ src/Data/Vector/Compact/Blob.hs view
@@ -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++--------------------------------------------------------------------------------+
+ src/Data/Vector/Compact/IntVec.hs view
@@ -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++--------------------------------------------------------------------------------+
+ src/Data/Vector/Compact/WordVec.hs view
@@ -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)++--------------------------------------------------------------------------------+
+ test/TestSuite.hs view
@@ -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+ ]++--------------------------------------------------------------------------------+
+ test/Tests/Blob.hs view
@@ -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 ++--------------------------------------------------------------------------------
+ test/Tests/IntVec.hs view
@@ -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++--------------------------------------------------------------------------------
+ test/Tests/WordVec.hs view
@@ -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++--------------------------------------------------------------------------------