-- | 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 560 bytes (14x5=70 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.
--
-- This module should be imported qualified (to avoid name clashes with Prelude).
--
-- TODO: ability to add user-defined (fixed-length) header, it can be 
-- potentially useful for some applications 
--

{-# LANGUAGE CPP, BangPatterns, ForeignFunctionInterface #-}
module Data.Vector.Compact.WordVec 
  ( -- * The dynamic Word vector type
    WordVec(..)
  , Shape(..)
  , vecShape , vecShape'
  , vecLen , vecBits , vecIsSmall
    -- * Show instance
  , showWordVec , showsPrecWordVec
    -- * Empty vector, singleton
  , null , empty
  , singleton , isSingleton
    -- * Conversion to\/from lists
  , fromList , fromListN , fromList'
  , toList , toRevList
    -- * Indexing
  , unsafeIndex , safeIndex 
    -- * Head, tail, etc
  , head , tail , cons , uncons
  , last ,        snoc                   -- init, unsnoc
  , concat
    -- * Specialized operations 
    --
    -- $spec
    --
    -- ** Specialized folds 
  , sum , maximum
    -- ** Specialized \"zipping folds\" 
  , eqStrict  , eqExtZero
  , cmpStrict , cmpExtZero
  , lessOrEqual , partialSumsLessOrEqual
    -- ** Specialized zips
  , add , subtract
    -- ** Specialized maps
  , scale 
    -- ** Specialized scans
  , partialSums
    -- * Generic operations
  , fold
  , naiveMap , boundedMap
  , naiveZipWith , boundedZipWith , listZipWith
    -- * Number of bits needed
  , bitsNeededFor , bitsNeededFor'
  , roundBits
  )
  where

--------------------------------------------------------------------------------

import Prelude hiding ( head , tail , init , last , null , concat , subtract , sum , maximum ) 
import qualified Data.List as L

import Data.Bits
import Data.Word

import Foreign.C

import Data.Vector.Compact.Blob hiding ( head , tail , last )
import qualified Data.Vector.Compact.Blob as Blob

--------------------------------------------------------------------------------

-- ???? how to determine this properly... 
-- why on earth isn't this stuff properly documented?!?!?!?!? 
#ifdef x86_64_HOST_ARCH
#define MACHINE_WORD_BITS 64 
#elif i386_HOST_ARCH
#define MACHINE_WORD_BITS 32
#elif i686_HOST_ARCH
#define MACHINE_WORD_BITS 32
#elif aarch64_HOST_ARCH
#define MACHINE_WORD_BITS 64 
#else
#define MACHINE_WORD_BITS 32
#endif

--------------------------------------------------------------------------------
-- * 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...)
--
-- About the instances:
-- 
-- * the @Eq@ instance is strict: @x == y@ iff @toList x == toList y@.
--   For an equality which disregards trailing zeros, see 'eqExtZero'
-- 
-- * the @Ord@ instance first compares the length, 
--   then if the lengths are equal, compares the content lexicographically.
--   For a comparison which disregards the length, and lexicographically
--   compares the sequences extended with zeros, see 'cmpExtZero'
--
newtype WordVec 
  = WordVec Blob

-- | The \"shape\" of a dynamic word vector
data Shape = Shape
  { Shape -> Int
shapeLen  :: !Int      -- ^ length of the vector
  , Shape -> Int
shapeBits :: !Int      -- ^ bits per element (quantized to multiples of 4)
  }
  deriving (Shape -> Shape -> Bool
(Shape -> Shape -> Bool) -> (Shape -> Shape -> Bool) -> Eq Shape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c== :: Shape -> Shape -> Bool
Eq,Int -> Shape -> ShowS
[Shape] -> ShowS
Shape -> String
(Int -> Shape -> ShowS)
-> (Shape -> String) -> ([Shape] -> ShowS) -> Show Shape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shape] -> ShowS
$cshowList :: [Shape] -> ShowS
show :: Shape -> String
$cshow :: Shape -> String
showsPrec :: Int -> Shape -> ShowS
$cshowsPrec :: Int -> Shape -> ShowS
Show)

vecShape :: WordVec -> Shape
vecShape :: WordVec -> Shape
vecShape = (Bool, Shape) -> Shape
forall a b. (a, b) -> b
snd ((Bool, Shape) -> Shape)
-> (WordVec -> (Bool, Shape)) -> WordVec -> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WordVec -> (Bool, Shape)
vecShape'
  
-- | @vecShape' vec == (vecIsSmall vec , vecShape vec)@
vecShape' :: WordVec -> (Bool,Shape)
vecShape' :: WordVec -> (Bool, Shape)
vecShape' (WordVec Blob
blob) = (Bool
isSmall,Shape
shape) where
  !h :: Word64
h      = Blob -> Word64
Blob.head Blob
blob
  !h2 :: Word64
h2     = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
h Int
1
  !isSmall :: Bool
isSmall = (Word64
h Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
1) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
  shape :: Shape
shape   = if Bool
isSmall
    then Word64 -> Word64 -> Shape
mkShape (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
h Int
3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
31        ) (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL ((Word64
h2Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
3)Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1) Int
2)
    else Word64 -> Word64 -> Shape
mkShape (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
h Int
5 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x07ffffff) (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL ((Word64
h2Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&.Word64
15)Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1) Int
2)
  mkShape :: Word64 -> Word64 -> Shape
  mkShape :: Word64 -> Word64 -> Shape
mkShape !Word64
x !Word64
y = Int -> Int -> Shape
Shape (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x) (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
y)

-- | @True@ if the internal representation is the \"small\" one
vecIsSmall :: WordVec -> Bool
vecIsSmall :: WordVec -> Bool
vecIsSmall (WordVec !Blob
blob) = (Blob -> Word64
Blob.head Blob
blob Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
1) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0  

-- | The length of the vector
vecLen :: WordVec -> Int
vecLen :: WordVec -> Int
vecLen  = Shape -> Int
shapeLen  (Shape -> Int) -> (WordVec -> Shape) -> WordVec -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WordVec -> Shape
vecShape

-- | The number of bits per element used to encode the vector
vecBits :: WordVec -> Int
vecBits :: WordVec -> Int
vecBits = Shape -> Int
shapeBits (Shape -> Int) -> (WordVec -> Shape) -> WordVec -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WordVec -> Shape
vecShape

--------------------------------------------------------------------------------
-- * Instances

instance Show WordVec where
  showsPrec :: Int -> WordVec -> ShowS
showsPrec = Int -> WordVec -> ShowS
showsPrecWordVec

showWordVec :: WordVec -> String
showWordVec :: WordVec -> String
showWordVec WordVec
dynvec = Int -> WordVec -> ShowS
showsPrecWordVec Int
0 WordVec
dynvec []

showsPrecWordVec :: Int -> WordVec -> ShowS
showsPrecWordVec :: Int -> WordVec -> ShowS
showsPrecWordVec Int
prec WordVec
dynvec
  = Bool -> ShowS -> ShowS
showParen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) 
  (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"fromList' "
  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Shape -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (WordVec -> Shape
vecShape WordVec
dynvec)
  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' 
  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word] -> ShowS
forall a. Show a => a -> ShowS
shows (WordVec -> [Word]
toList WordVec
dynvec)
    
-- | The Eq instance is strict: @x == y@ iff @toList x == toList y@.
-- For an equality which disregards trailing zeros, see 'eqExtZero'.
instance Eq WordVec where
  == :: WordVec -> WordVec -> Bool
(==) WordVec
x WordVec
y  = WordVec -> WordVec -> Bool
eqStrict WordVec
x WordVec
y 
  -- (==) x y  = (vecLen x == vecLen y) && (toList x == toList y)

-- | The Ord instance first compares the length, then if the lengths are equal, 
-- compares the content lexicographically. For a different ordering, see 'cmpExtZero'.
instance Ord WordVec where
  compare :: WordVec -> WordVec -> Ordering
compare WordVec
x WordVec
y = WordVec -> WordVec -> Ordering
cmpStrict WordVec
x WordVec
y
{-
  compare x y = case compare (vecLen x) (vecLen y) of 
    LT -> LT
    GT -> GT
    EQ -> compare (toList x) (toList y)
-}

--------------------------------------------------------------------------------
-- * Empty vector, singleton

empty :: WordVec
empty :: WordVec
empty = [Word] -> WordVec
fromList []

null :: WordVec -> Bool
null :: WordVec -> Bool
null (WordVec !Blob
blob) = 
  -- null v = (vecLen v == 0)
  let !h :: Word64
h = Blob -> Word64
Blob.head Blob
blob 
  in  (Word64
h Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xf9 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0) Bool -> Bool -> Bool
|| (Word64
h Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xffffffe1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
1)
  -- 0xf9       = 000 ... 00|11111001
  -- 0xffffffe1 = 111 ... 11|11100001
 
{-  
null_naive :: WordVec -> Bool
null_naive v = (vecLen v == 0)
-}

singleton :: Word -> WordVec
singleton :: Word -> WordVec
singleton !Word
x = Int -> Word -> [Word] -> WordVec
fromListN Int
1 Word
x [Word
x] where

isSingleton :: WordVec -> Maybe Word
isSingleton :: WordVec -> Maybe Word
isSingleton !WordVec
v = case (WordVec -> Int
vecLen WordVec
v) of
  Int
1 -> Word -> Maybe Word
forall a. a -> Maybe a
Just (WordVec -> Word
head WordVec
v)
  Int
_ -> Maybe Word
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- * Indexing

-- | No boundary check is done. Indexing starts from 0.
unsafeIndex :: Int -> WordVec -> Word
unsafeIndex :: Int -> WordVec -> Word
unsafeIndex Int
idx dynvec :: WordVec
dynvec@(WordVec Blob
blob) = 
  case Bool
isSmall of
    Bool
True  -> Int -> Blob -> Int -> Word
forall a. Integral a => Int -> Blob -> Int -> a
extractSmallWord Int
bits Blob
blob ( Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
idx)
    Bool
False -> Int -> Blob -> Int -> Word
forall a. Integral a => Int -> Blob -> Int -> a
extractSmallWord Int
bits Blob
blob (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
idx)
  where
    (Bool
isSmall, Shape Int
_ Int
bits) = WordVec -> (Bool, Shape)
vecShape' WordVec
dynvec

safeIndex :: Int -> WordVec -> Maybe Word
safeIndex :: Int -> WordVec -> Maybe Word
safeIndex Int
idx dynvec :: WordVec
dynvec@(WordVec Blob
blob)
  | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0    = Maybe Word
forall a. Maybe a
Nothing
  | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Maybe Word
forall a. Maybe a
Nothing
  | Bool
otherwise  = Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word) -> Word -> Maybe Word
forall a b. (a -> b) -> a -> b
$ case Bool
isSmall of
      Bool
True  -> Int -> Blob -> Int -> Word
forall a. Integral a => Int -> Blob -> Int -> a
extractSmallWord Int
bits Blob
blob ( Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
idx)
      Bool
False -> Int -> Blob -> Int -> Word
forall a. Integral a => Int -> Blob -> Int -> a
extractSmallWord Int
bits Blob
blob (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
idx)
  where
    (Bool
isSmall, Shape Int
len Int
bits) = WordVec -> (Bool, Shape)
vecShape' WordVec
dynvec

--------------------------------------------------------------------------------
-- * Head, tail, etc
    
-- | Note: For the empty vector, @head@ returns 0
head :: WordVec -> Word
head :: WordVec -> Word
head dynvec :: WordVec
dynvec@(WordVec Blob
blob) 
  | WordVec -> Bool
null WordVec
dynvec  = Word
0
  | Bool
otherwise    = case WordVec -> Bool
vecIsSmall WordVec
dynvec of
      Bool
True  -> Int -> Blob -> Int -> Word
forall a. Integral a => Int -> Blob -> Int -> a
extractSmallWord Int
bits Blob
blob  Int
8
      Bool
False -> Int -> Blob -> Int -> Word
forall a. Integral a => Int -> Blob -> Int -> a
extractSmallWord Int
bits Blob
blob Int
32
  where
    bits :: Int
bits = WordVec -> Int
vecBits WordVec
dynvec

-- | Note: For the empty vector, @last@ returns 0
last :: WordVec -> Word
last :: WordVec -> Word
last dynvec :: WordVec
dynvec@(WordVec Blob
blob) 
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = Word
0
  | Bool
otherwise  = case Bool
isSmall of
    Bool
True  -> Int -> Blob -> Int -> Word
forall a. Integral a => Int -> Blob -> Int -> a
extractSmallWord Int
bits Blob
blob ( Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
    Bool
False -> Int -> Blob -> Int -> Word
forall a. Integral a => Int -> Blob -> Int -> a
extractSmallWord Int
bits Blob
blob (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
  where
    (Bool
isSmall, Shape Int
len Int
bits) = WordVec -> (Bool, Shape)
vecShape' WordVec
dynvec

--------------------------------------------------------------------------------

-- | Note: For the empty vector, @tail@ returns (another) empty vector
tail :: WordVec -> WordVec
tail :: WordVec -> WordVec
tail = WordVec -> WordVec
tail_v2

-- | Prepends an element
cons :: Word -> WordVec -> WordVec
cons :: Word -> WordVec -> WordVec
cons = Word -> WordVec -> WordVec
cons_v2

-- | Appends an element
snoc :: WordVec -> Word -> WordVec
snoc :: WordVec -> Word -> WordVec
snoc = WordVec -> Word -> WordVec
snoc_v2

uncons :: WordVec -> Maybe (Word, WordVec)
uncons :: WordVec -> Maybe (Word, WordVec)
uncons = WordVec -> Maybe (Word, WordVec)
uncons_v2

concat :: WordVec -> WordVec -> WordVec
concat :: WordVec -> WordVec -> WordVec
concat WordVec
u WordVec
v = Shape -> [Word] -> WordVec
fromList' (Int -> Int -> Shape
Shape (Int
luInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lv) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
bu Int
bv)) (WordVec -> [Word]
toList WordVec
u [Word] -> [Word] -> [Word]
forall a. [a] -> [a] -> [a]
++ WordVec -> [Word]
toList WordVec
v) where
  Shape Int
lu Int
bu = WordVec -> Shape
vecShape WordVec
u
  Shape Int
lv Int
bv = WordVec -> Shape
vecShape WordVec
v

--------------------------------------------------------------------------------

foreign import ccall unsafe "vec_identity"  c_vec_identity  :: CFun11_       -- for testing
foreign import ccall unsafe "vec_tail"      c_vec_tail      :: CFun11_
foreign import ccall unsafe "vec_head_tail" c_vec_head_tail :: CFun11 Word64
foreign import ccall unsafe "vec_cons"      c_vec_cons      :: Word64 -> CFun11_
foreign import ccall unsafe "vec_snoc"      c_vec_snoc      :: Word64 -> CFun11_

tail_v2 :: WordVec -> WordVec
tail_v2 :: WordVec -> WordVec
tail_v2 (WordVec Blob
blob) = Blob -> WordVec
WordVec (Blob -> WordVec) -> Blob -> WordVec
forall a b. (a -> b) -> a -> b
$ CFun11_ -> (Int -> Int) -> Blob -> Blob
wrapCFun11_ CFun11_
c_vec_tail Int -> Int
forall a. a -> a
id Blob
blob

cons_v2 :: Word -> WordVec -> WordVec
cons_v2 :: Word -> WordVec -> WordVec
cons_v2 Word
y vec :: WordVec
vec@(WordVec Blob
blob) = Blob -> WordVec
WordVec (Blob -> WordVec) -> Blob -> WordVec
forall a b. (a -> b) -> a -> b
$ CFun11_ -> (Int -> Int) -> Blob -> Blob
wrapCFun11_ (Word64 -> CFun11_
c_vec_cons (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
y)) Int -> Int
f Blob
blob where
  f :: Int -> Int
f !Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Int
worstcase
  len :: Int
len  = WordVec -> Int
vecLen WordVec
vec
  worstcase :: Int
worstcase = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
bitsNeededFor Word
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
63) Int
6
  -- it can happen that we cons (2^64-1) to a long vector of 4 bit numbers...
  -- now it either fits in the old bits, in which case we need at most 1 new word
  -- (maybe two, if we also switch from small header to big header at the same time???)
  -- or does not, which is computed by @worstcase@

snoc_v2 :: WordVec -> Word -> WordVec
snoc_v2 :: WordVec -> Word -> WordVec
snoc_v2 vec :: WordVec
vec@(WordVec Blob
blob) Word
y = Blob -> WordVec
WordVec (Blob -> WordVec) -> Blob -> WordVec
forall a b. (a -> b) -> a -> b
$ CFun11_ -> (Int -> Int) -> Blob -> Blob
wrapCFun11_ (Word64 -> CFun11_
c_vec_snoc (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
y)) Int -> Int
f Blob
blob where
  f :: Int -> Int
f !Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Int
worstcase
  len :: Int
len  = WordVec -> Int
vecLen WordVec
vec
  worstcase :: Int
worstcase = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
bitsNeededFor Word
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
63) Int
6
 
uncons_v2 :: WordVec -> Maybe (Word,WordVec)
uncons_v2 :: WordVec -> Maybe (Word, WordVec)
uncons_v2 vec :: WordVec
vec@(WordVec Blob
blob) = if WordVec -> Bool
null WordVec
vec 
  then Maybe (Word, WordVec)
forall a. Maybe a
Nothing
  else let (Word64
hd,Blob
tl) = CFun11 Word64 -> (Int -> Int) -> Blob -> (Word64, Blob)
forall a. CFun11 a -> (Int -> Int) -> Blob -> (a, Blob)
wrapCFun11 CFun11 Word64
c_vec_head_tail Int -> Int
forall a. a -> a
id Blob
blob
       in  (Word, WordVec) -> Maybe (Word, WordVec)
forall a. a -> Maybe a
Just (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
hd , Blob -> WordVec
WordVec Blob
tl)
       
--------------------------------------------------------------------------------
-- * Conversion to\/from lists

toList :: WordVec -> [Word]
toList :: WordVec -> [Word]
toList dynvec :: WordVec
dynvec@(WordVec Blob
blob) =
  case Bool
isSmall of
    Bool
True  -> Int -> Int -> [Word64] -> [Word]
worker  Int
8 Int
len (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
header  Int
8 Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: [Word64]
restOfWords)
    Bool
False -> Int -> Int -> [Word64] -> [Word]
worker Int
32 Int
len (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
header Int
32 Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: [Word64]
restOfWords)
  
  where
    isSmall :: Bool
isSmall = (Word64
header Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
1) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
    (Word64
header:[Word64]
restOfWords) = Blob -> [Word64]
blobToWordList Blob
blob
      
    Shape Int
len Int
bits = WordVec -> Shape
vecShape WordVec
dynvec
    
    the_mask :: Word64
the_mask = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL Word64
1 Int
bits Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1 :: Word64

    mask :: Word64 -> Word
    mask :: Word64 -> Word
mask Word64
w = Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
the_mask)

    worker :: Int -> Int -> [Word64] -> [Word]
worker !Int
bitOfs !Int
0 [Word64]
_  = []
    worker !Int
bitOfs !Int
k [] = Int -> Word -> [Word]
forall a. Int -> a -> [a]
replicate Int
k Word
0     -- this shouldn't happen btw 
    worker !Int
bitOfs !Int
k (Word64
this:[Word64]
rest) = 
      let newOfs :: Int
newOfs = Int
bitOfs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bits 
      in  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
newOfs Int
64 of
        Ordering
LT -> (Word64 -> Word
mask Word64
this) Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: Int -> Int -> [Word64] -> [Word]
worker Int
newOfs (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
this Int
bits Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: [Word64]
rest)
        Ordering
EQ -> (Word64 -> Word
mask Word64
this) Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: Int -> Int -> [Word64] -> [Word]
worker Int
0      (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)                     [Word64]
rest
        Ordering
GT -> case [Word64]
rest of 
                (Word64
that:[Word64]
rest') -> 
                  let !newOfs' :: Int
newOfs' = Int
newOfs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
64
                      !elem :: Word
elem = Word64 -> Word
mask (Word64
this Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL Word64
that (Int
64Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
bitOfs)) 
                  in  Word
elem Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: Int -> Int -> [Word64] -> [Word]
worker Int
newOfs' (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
that Int
newOfs' Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: [Word64]
rest') 
                [] -> String -> [Word]
forall a. HasCallStack => String -> a
error String
"WordVec/toList: FATAL ERROR! this should not happen"

-- | @toRevList vec == reverse (toList vec)@, but should be faster (?)
toRevList :: WordVec -> [Word] 
toRevList :: WordVec -> [Word]
toRevList dynvec :: WordVec
dynvec@(WordVec Blob
blob)  = 
  case Bool
isSmall of
    Bool
True  -> [ Int -> Blob -> Int -> Word
forall a. Integral a => Int -> Blob -> Int -> a
extractSmallWord Int
bits Blob
blob ( Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)) | Int
i<-[Int
1..Int
len] ]
    Bool
False -> [ Int -> Blob -> Int -> Word
forall a. Integral a => Int -> Blob -> Int -> a
extractSmallWord Int
bits Blob
blob (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)) | Int
i<-[Int
1..Int
len] ]
  where
    (Bool
isSmall, Shape Int
len Int
bits) = WordVec -> (Bool, Shape)
vecShape' WordVec
dynvec

--------------------------------------------------------------------------------
    
fromList :: [Word] -> WordVec
fromList :: [Word] -> WordVec
fromList [] = Shape -> [Word] -> WordVec
fromList' (Int -> Int -> Shape
Shape Int
0 Int
4) []
fromList [Word]
xs = Shape -> [Word] -> WordVec
fromList' (Int -> Int -> Shape
Shape Int
l Int
b) [Word]
xs where
  l :: Int
l = [Word] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word]
xs
  b :: Int
b = Word -> Int
bitsNeededFor ([Word] -> Word
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
L.maximum [Word]
xs)

-- | This is faster than 'fromList'
fromListN
 :: Int       -- ^ length
 -> Word      -- ^ maximum (or just an upper bound)
 -> [Word]    -- ^ elements
 -> WordVec
fromListN :: Int -> Word -> [Word] -> WordVec
fromListN Int
len Word
max = Shape -> [Word] -> WordVec
fromList' (Int -> Int -> Shape
Shape Int
len (Word -> Int
bitsNeededFor Word
max))
 
-- | If you know the shape in advance, it\'s faster to use this function 
fromList' :: Shape -> [Word] -> WordVec
fromList' :: Shape -> [Word] -> WordVec
fromList' (Shape Int
len Int
bits0) [Word]
words
  | Int
bits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
16 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
31  = Blob -> WordVec
WordVec (Blob -> WordVec) -> Blob -> WordVec
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> [Word] -> Blob
mkBlob (Word64 -> Int -> Word64
mkHeader Word64
0 Int
2)  Int
8 [Word]
words
  | Bool
otherwise                = Blob -> WordVec
WordVec (Blob -> WordVec) -> Blob -> WordVec
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> [Word] -> Blob
mkBlob (Word64 -> Int -> Word64
mkHeader Word64
1 Int
4) Int
32 [Word]
words
  
  where
    !bits :: Int
bits    = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
4 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
64 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
bits0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xfc
    !bitsEnc :: Int
bitsEnc = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
bits Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 :: Int
    !content :: Int
content = Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
len          :: Int
    !mask :: Word64
mask    = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL Word64
1 Int
bits Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1 :: Word64

    mkHeader :: Word64 -> Int -> Word64
    mkHeader :: Word64 -> Int -> Word64
mkHeader !Word64
isSmall !Int
resoBits = Word64
isSmall Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL (Int
bitsEnc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
len Int
resoBits) Int
1)
     
    mkBlob :: Word64 -> Int -> [Word] -> Blob
mkBlob !Word64
header !Int
ofs [Word]
words = Int -> [Word64] -> Blob
blobFromWordListN (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (Int
ofsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
contentInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
63) Int
6) 
                              ([Word64] -> Blob) -> [Word64] -> Blob
forall a b. (a -> b) -> a -> b
$ Int -> Word64 -> Int -> [Word] -> [Word64]
worker Int
len Word64
header Int
ofs [Word]
words
    
    worker :: Int -> Word64 -> Int -> [Word] -> [Word64]
    worker :: Int -> Word64 -> Int -> [Word] -> [Word64]
worker  Int
0 !Word64
current !Int
bitOfs [Word]
_           = if Int
bitOfs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [] else [Word64
current] 
    worker !Int
k !Word64
current !Int
bitOfs []          = Int -> Word64 -> Int -> [Word] -> [Word64]
worker Int
k Word64
current Int
bitOfs [Word
0]   
    worker !Int
k !Word64
current !Int
bitOfs (Word
this0:[Word]
rest) = 
      let !this :: Word64
this     = (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
this0) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
mask
          !newOfs :: Int
newOfs   = Int
bitOfs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bits 
          !current' :: Word64
current' = (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL Word64
this Int
bitOfs) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
current 
      in  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
newOfs Int
64 of
        Ordering
LT ->            Int -> Word64 -> Int -> [Word] -> [Word64]
worker (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Word64
current' Int
newOfs [Word]
rest
        Ordering
EQ -> Word64
current' Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: Int -> Word64 -> Int -> [Word] -> [Word64]
worker (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Word64
0        Int
0      [Word]
rest 
        Ordering
GT -> let !newOfs' :: Int
newOfs' = Int
newOfs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
64
              in   Word64
current' Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: Int -> Word64 -> Int -> [Word] -> [Word64]
worker (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
this (Int
64Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
bitOfs)) Int
newOfs' [Word]
rest

--------------------------------------------------------------------------------
-- * Specialized operations 
--
-- $spec
--
-- These are are faster than the generic operations below, and should be preferred
-- to those.
--

--------------------------------------------------------------------------------
-- ** Specialized folds 

-- | Sum of the elements of the vector
sum :: WordVec -> Word
sum :: WordVec -> Word
sum (WordVec Blob
blob) = Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Word64 -> Word
forall a b. (a -> b) -> a -> b
$ CFun10 Word64 -> Blob -> Word64
forall a. CFun10 a -> Blob -> a
wrapCFun10 CFun10 Word64
c_vec_sum Blob
blob

-- | Maximum of the elements of the vector
maximum :: WordVec -> Word
maximum :: WordVec -> Word
maximum (WordVec Blob
blob) = Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Word64 -> Word
forall a b. (a -> b) -> a -> b
$ CFun10 Word64 -> Blob -> Word64
forall a. CFun10 a -> Blob -> a
wrapCFun10 CFun10 Word64
c_vec_max Blob
blob

foreign import ccall unsafe "vec_sum" c_vec_sum :: CFun10 Word64
foreign import ccall unsafe "vec_max" c_vec_max :: CFun10 Word64

--------------------------------------------------------------------------------
-- ** Specialized \"zipping folds\" 
--

foreign import ccall unsafe "vec_equal_strict"    c_equal_strict  :: CFun20 CInt
foreign import ccall unsafe "vec_equal_extzero"   c_equal_extzero :: CFun20 CInt
foreign import ccall unsafe "vec_compare_strict"  c_compare_strict  :: CFun20 CInt
foreign import ccall unsafe "vec_compare_extzero" c_compare_extzero :: CFun20 CInt
foreign import ccall unsafe "vec_less_or_equal"              c_less_or_equal :: CFun20 CInt
foreign import ccall unsafe "vec_partial_sums_less_or_equal" c_partial_sums_less_or_equal :: CFun20 CInt

-- | Strict equality of vectors (same length, same content)
eqStrict :: WordVec -> WordVec -> Bool
eqStrict :: WordVec -> WordVec -> Bool
eqStrict (WordVec Blob
blob1) (WordVec Blob
blob2) = (CInt
0 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CFun20 CInt -> Blob -> Blob -> CInt
forall a. CFun20 a -> Blob -> Blob -> a
wrapCFun20 CFun20 CInt
c_equal_strict Blob
blob1 Blob
blob2)

-- | Equality of vectors extended with zeros to infinity
eqExtZero :: WordVec -> WordVec -> Bool
eqExtZero :: WordVec -> WordVec -> Bool
eqExtZero (WordVec Blob
blob1) (WordVec Blob
blob2) = (CInt
0 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CFun20 CInt -> Blob -> Blob -> CInt
forall a. CFun20 a -> Blob -> Blob -> a
wrapCFun20 CFun20 CInt
c_equal_extzero Blob
blob1 Blob
blob2)

cintToOrdering :: CInt -> Ordering
cintToOrdering :: CInt -> Ordering
cintToOrdering !CInt
k
  | CInt
k CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0     = Ordering
LT
  | CInt
k CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0     = Ordering
GT
  | Bool
otherwise = Ordering
EQ
  
-- | Strict comparison of vectors (first compare the lengths; if the lengths are the same then compare lexicographically)
cmpStrict :: WordVec -> WordVec -> Ordering
cmpStrict :: WordVec -> WordVec -> Ordering
cmpStrict (WordVec Blob
blob1) (WordVec Blob
blob2) = CInt -> Ordering
cintToOrdering (CInt -> Ordering) -> CInt -> Ordering
forall a b. (a -> b) -> a -> b
$ CFun20 CInt -> Blob -> Blob -> CInt
forall a. CFun20 a -> Blob -> Blob -> a
wrapCFun20 CFun20 CInt
c_compare_strict Blob
blob1 Blob
blob2

-- | Lexicographic ordering of vectors extended with zeros to infinity
cmpExtZero :: WordVec -> WordVec -> Ordering
cmpExtZero :: WordVec -> WordVec -> Ordering
cmpExtZero (WordVec Blob
blob1) (WordVec Blob
blob2) = CInt -> Ordering
cintToOrdering (CInt -> Ordering) -> CInt -> Ordering
forall a b. (a -> b) -> a -> b
$ CFun20 CInt -> Blob -> Blob -> CInt
forall a. CFun20 a -> Blob -> Blob -> a
wrapCFun20 CFun20 CInt
c_compare_extzero Blob
blob1 Blob
blob2

-- | Pointwise comparison of vectors extended with zeros to infinity
lessOrEqual :: WordVec -> WordVec -> Bool
lessOrEqual :: WordVec -> WordVec -> Bool
lessOrEqual (WordVec Blob
blob1) (WordVec Blob
blob2) = (CInt
0 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CFun20 CInt -> Blob -> Blob -> CInt
forall a. CFun20 a -> Blob -> Blob -> a
wrapCFun20 CFun20 CInt
c_less_or_equal Blob
blob1 Blob
blob2)

-- | Pointwise comparison of partial sums of vectors extended with zeros to infinity
-- 
-- For example @[x1,x2,x3] <= [y1,y2,y3]@ iff (@x1 <=y1 && x1+x2 <= y1+y2 && x1+x2+x3 <= y1+y2+y3@).
--
partialSumsLessOrEqual :: WordVec -> WordVec -> Bool
partialSumsLessOrEqual :: WordVec -> WordVec -> Bool
partialSumsLessOrEqual (WordVec Blob
blob1) (WordVec Blob
blob2) =
  (CInt
0 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CFun20 CInt -> Blob -> Blob -> CInt
forall a. CFun20 a -> Blob -> Blob -> a
wrapCFun20 CFun20 CInt
c_partial_sums_less_or_equal Blob
blob1 Blob
blob2)

--------------------------------------------------------------------------------
-- ** Specialized zips
--

foreign import ccall unsafe "vec_add"           c_vec_add          :: CFun21_
foreign import ccall unsafe "vec_sub_overflow"  c_vec_sub_overflow :: CFun21 CInt

-- | Pointwise addition of vectors. The shorter one is extended by zeros.
add :: WordVec -> WordVec -> WordVec
add :: WordVec -> WordVec -> WordVec
add vec1 :: WordVec
vec1@(WordVec Blob
blob1) vec2 :: WordVec
vec2@(WordVec Blob
blob2) = Blob -> WordVec
WordVec (Blob -> WordVec) -> Blob -> WordVec
forall a b. (a -> b) -> a -> b
$ CFun21_ -> (Int -> Int -> Int) -> Blob -> Blob -> Blob
wrapCFun21_ CFun21_
c_vec_add Int -> Int -> Int
forall p p. p -> p -> Int
f Blob
blob1 Blob
blob2 where
  -- WARNING! memory allocation is _very_ tricky here!
  -- worst case: we have a very long vector with 4 bits/elem,
  -- and a very short vector with 64 bits/elem!
  -- even @max b1 b2@ is not enough, because it can overflow...
  f :: p -> p -> Int
f p
_ p
_ = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR ( (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
b1 Int
b2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
l1 Int
l2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
63 ) Int
6
  Shape !Int
l1 !Int
b1 = WordVec -> Shape
vecShape WordVec
vec1
  Shape !Int
l2 !Int
b2 = WordVec -> Shape
vecShape WordVec
vec2

-- | Pointwise subtraction of vectors. The shorter one is extended by zeros.
-- If any element would become negative, we return Nothing
subtract :: WordVec -> WordVec -> Maybe WordVec
subtract :: WordVec -> WordVec -> Maybe WordVec
subtract vec1 :: WordVec
vec1@(WordVec Blob
blob1) vec2 :: WordVec
vec2@(WordVec Blob
blob2) = 
  case (CFun21 CInt -> (Int -> Int -> Int) -> Blob -> Blob -> (CInt, Blob)
forall a.
CFun21 a -> (Int -> Int -> Int) -> Blob -> Blob -> (a, Blob)
wrapCFun21 CFun21 CInt
c_vec_sub_overflow Int -> Int -> Int
forall p p. p -> p -> Int
f Blob
blob1 Blob
blob2) of
    (CInt
0 , Blob
blob3) -> WordVec -> Maybe WordVec
forall a. a -> Maybe a
Just (Blob -> WordVec
WordVec Blob
blob3)
    (CInt
_ , Blob
_    ) -> Maybe WordVec
forall a. Maybe a
Nothing
  where
    f :: p -> p -> Int
f p
_ p
_ = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR ( (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
b1 Int
b2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
l1 Int
l2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
63 ) Int
6
    Shape !Int
l1 !Int
b1 = WordVec -> Shape
vecShape WordVec
vec1
    Shape !Int
l2 !Int
b2 = WordVec -> Shape
vecShape WordVec
vec2

--------------------------------------------------------------------------------
-- ** Specialized maps

foreign import ccall unsafe "vec_scale" c_vec_scale :: Word64 -> CFun11_

-- | Pointwise multiplication by a constant.
scale :: Word -> WordVec -> WordVec
scale :: Word -> WordVec -> WordVec
scale Word
s vec :: WordVec
vec@(WordVec Blob
blob) = Blob -> WordVec
WordVec (Blob -> WordVec) -> Blob -> WordVec
forall a b. (a -> b) -> a -> b
$ CFun11_ -> (Int -> Int) -> Blob -> Blob
wrapCFun11_ (Word64 -> CFun11_
c_vec_scale (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s)) Int -> Int
forall p. p -> Int
f Blob
blob where
  f :: p -> Int
f p
_ = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
newbits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
63) Int
6   
  Shape !Int
len !Int
bits = WordVec -> Shape
vecShape WordVec
vec
  bound :: Word
bound = if Word
s Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> Int -> Word
forall a. Bits a => a -> Int -> a
shiftL Word
1 (Int
64Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
bits)
    then (Word
2Word -> Int -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^Int
bits Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
s
    else (Word
2Word -> Integer -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
64   Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
  newbits :: Int
newbits = Word -> Int
bitsNeededFor Word
bound  

--------------------------------------------------------------------------------
-- ** Specialized scans

foreign import ccall unsafe "vec_partial_sums" c_vec_partial_sums :: CFun11 Word64

-- | @toList (partialSums vec) == tail (scanl (+) 0 $ toList vec)@
partialSums :: WordVec -> WordVec
partialSums :: WordVec -> WordVec
partialSums vec :: WordVec
vec@(WordVec Blob
blob) = Blob -> WordVec
WordVec (Blob -> WordVec) -> Blob -> WordVec
forall a b. (a -> b) -> a -> b
$ (Word64, Blob) -> Blob
forall a b. (a, b) -> b
snd ((Word64, Blob) -> Blob) -> (Word64, Blob) -> Blob
forall a b. (a -> b) -> a -> b
$ CFun11 Word64 -> (Int -> Int) -> Blob -> (Word64, Blob)
forall a. CFun11 a -> (Int -> Int) -> Blob -> (a, Blob)
wrapCFun11 CFun11 Word64
c_vec_partial_sums Int -> Int
forall p. p -> Int
f Blob
blob where
  f :: p -> Int
f p
_ = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
newbits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
63) Int
6   
  Shape !Int
len !Int
bits = WordVec -> Shape
vecShape WordVec
vec
  bound :: Word
bound = if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
1 (Int
64Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
bits)
    then (Word
2Word -> Int -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^Int
bits Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Word -> Word -> Word
forall a. Num a => a -> a -> a
* (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len :: Word)        -- worst case: @replicate N (2^bits-1)@
    else (Word
2Word -> Integer -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
64   Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
  newbits :: Int
newbits = Word -> Int
bitsNeededFor Word
bound  
    
--------------------------------------------------------------------------------
-- * Some generic operations

-- | Left fold
fold :: (a -> Word -> a) -> a -> WordVec -> a
fold :: (a -> Word -> a) -> a -> WordVec -> a
fold a -> Word -> a
f a
x WordVec
v = (a -> Word -> a) -> a -> [Word] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' a -> Word -> a
f a
x (WordVec -> [Word]
toList WordVec
v)  

naiveMap :: (Word -> Word) -> WordVec -> WordVec
naiveMap :: (Word -> Word) -> WordVec -> WordVec
naiveMap Word -> Word
f WordVec
u = [Word] -> WordVec
fromList ((Word -> Word) -> [Word] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map Word -> Word
f ([Word] -> [Word]) -> [Word] -> [Word]
forall a b. (a -> b) -> a -> b
$ WordVec -> [Word]
toList WordVec
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 :: Word -> (Word -> Word) -> WordVec -> WordVec
boundedMap Word
bound Word -> Word
f WordVec
vec = Shape -> [Word] -> WordVec
fromList' (Int -> Int -> Shape
Shape Int
l Int
bits) (WordVec -> [Word]
toList WordVec
vec) where
  l :: Int
l    = WordVec -> Int
vecLen WordVec
vec
  bits :: Int
bits = Word -> Int
bitsNeededFor Word
bound

naiveZipWith :: (Word -> Word -> Word) -> WordVec -> WordVec -> WordVec
naiveZipWith :: (Word -> Word -> Word) -> WordVec -> WordVec -> WordVec
naiveZipWith Word -> Word -> Word
f WordVec
u WordVec
v = [Word] -> WordVec
fromList ([Word] -> WordVec) -> [Word] -> WordVec
forall a b. (a -> b) -> a -> b
$ (Word -> Word -> Word) -> [Word] -> [Word] -> [Word]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
L.zipWith Word -> Word -> Word
f (WordVec -> [Word]
toList WordVec
u) (WordVec -> [Word]
toList WordVec
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 :: Word -> (Word -> Word -> Word) -> WordVec -> WordVec -> WordVec
boundedZipWith Word
bound Word -> Word -> Word
f WordVec
vec1 WordVec
vec2  = Shape -> [Word] -> WordVec
fromList' (Int -> Int -> Shape
Shape Int
l Int
bits) ([Word] -> WordVec) -> [Word] -> WordVec
forall a b. (a -> b) -> a -> b
$ (Word -> Word -> Word) -> [Word] -> [Word] -> [Word]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
L.zipWith Word -> Word -> Word
f (WordVec -> [Word]
toList WordVec
vec1) (WordVec -> [Word]
toList WordVec
vec2) where
  l :: Int
l    = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (WordVec -> Int
vecLen WordVec
vec1) (WordVec -> Int
vecLen WordVec
vec2)
  bits :: Int
bits = Word -> Int
bitsNeededFor Word
bound

listZipWith :: (Word -> Word -> a) -> WordVec -> WordVec -> [a]
listZipWith :: (Word -> Word -> a) -> WordVec -> WordVec -> [a]
listZipWith Word -> Word -> a
f WordVec
u WordVec
v = (Word -> Word -> a) -> [Word] -> [Word] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
L.zipWith Word -> Word -> a
f (WordVec -> [Word]
toList WordVec
u) (WordVec -> [Word]
toList WordVec
v)
              
--------------------------------------------------------------------------------
-- * Misc helpers

-- | Number of bits needed to encode a given number, rounded up to multiples of four
bitsNeededFor :: Word -> Int
bitsNeededFor :: Word -> Int
bitsNeededFor = Word -> Int
bitsNeededForHs

-- | Number of bits needed to encode a given number
bitsNeededFor' :: Word -> Int
bitsNeededFor' :: Word -> Int
bitsNeededFor' = Word -> Int
bitsNeededForHs'

bitsNeededForHs :: Word -> Int
bitsNeededForHs :: Word -> Int
bitsNeededForHs = Int -> Int
roundBits (Int -> Int) -> (Word -> Int) -> Word -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
bitsNeededForHs'

bitsNeededForHs' :: Word -> Int
bitsNeededForHs' :: Word -> Int
bitsNeededForHs' Word
bound 
  | Word
bound   Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0  = Int
1                             -- this is handled incorrectly by the formula below
  | Word
boundWord -> Word -> Word
forall a. Num a => a -> a -> a
+Word
1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0  = MACHINE_WORD_BITS             -- and this handled incorrectly because of overflow
  | Bool
otherwise     = Word -> Int
ceilingLog2 (Word
bound Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)       -- for example, if maximum is 16, log2 = 4 but we need 5 bits 
  where    
    -- | Smallest integer @k@ such that @2^k@ is larger or equal to @n@
    ceilingLog2 :: Word -> Int
    ceilingLog2 :: Word -> Int
ceilingLog2 Word
0 = Int
0
    ceilingLog2 Word
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
forall t p. (Num t, Num p, Bits t) => t -> p
go (Word
nWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) where
      go :: t -> p
go t
0 = -p
1
      go t
k = p
1 p -> p -> p
forall a. Num a => a -> a -> a
+ t -> p
go (t -> Int -> t
forall a. Bits a => a -> Int -> a
shiftR t
k Int
1)

{-

-- apparently, the C implementation is _not_ faster...

foreign import ccall unsafe "export_required_bits_not_rounded" export_required_bits_not_rounded :: Word64 -> CInt
foreign import ccall unsafe "export_required_bits"             export_required_bits             :: Word64 -> CInt

bitsNeededForC :: Word -> Int
bitsNeededForC = fromIntegral . export_required_bits . fromIntegral

bitsNeededForC' :: Word -> Int
bitsNeededForC' = fromIntegral . export_required_bits_not_rounded . fromIntegral
-}

-- | We only allow multiples of 4.
roundBits :: Int -> Int
roundBits :: Int -> Int
roundBits Int
0 = Int
4
roundBits Int
k = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) Int
2) Int
2

--------------------------------------------------------------------------------