-- | Signed integer version of dynamic word vectors.
--
-- See "Data.Vector.Compact.WordVec" for more details.
--
-- Note: for unsigned integers, you really should use 'WordVec' instead, 
-- because that is significantly faster, and has much more specialized functions
-- implemented.
--
-- This module should be imported qualified (to avoid name clashes with Prelude).
--

{-# LANGUAGE BangPatterns #-}
module Data.Vector.Compact.IntVec
  ( -- * The dynamic Word vector type
    IntVec(..)
  , Shape(..)
  , vecShape 
  , vecLen , vecBits 
    -- * Show instance
  , showIntVec , showsPrecIntVec
    -- * Empty vector, singleton
  , null , empty
  , singleton , isSingleton
    -- * Conversion to\/from lists
  , fromList , fromList' , fromList''
  , lenMinMax
  , toList , toRevList
    -- * Indexing
  , unsafeIndex , safeIndex 
    -- * Head, tail, etc
  , head , tail , cons , uncons
  , last , snoc                     -- init, unsnoc
  , concat
    -- * Generic operations
  , fold
  , naiveMap , boundedMap
  , naiveZipWith , boundedZipWith , listZipWith
    -- * Number of bits needed
  , bitsNeededForMinMax
  , bitsNeededFor 
  , roundBits
  )
  where

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

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

import Data.Bits

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)   -- WARNING: deriving Eq and Ord result in INCORRECT instances!!

instance Eq IntVec where 
  == :: IntVec -> IntVec -> Bool
(==) IntVec
x IntVec
y  =  (IntVec -> Int
vecLen IntVec
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== IntVec -> Int
vecLen IntVec
y) Bool -> Bool -> Bool
&& (IntVec -> [Int]
toList IntVec
x [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== IntVec -> [Int]
toList IntVec
y)

instance Ord IntVec where
  compare :: IntVec -> IntVec -> Ordering
compare IntVec
x IntVec
y = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (IntVec -> Int
vecLen IntVec
x) (IntVec -> Int
vecLen IntVec
y) of 
    Ordering
LT -> Ordering
LT
    Ordering
GT -> Ordering
GT
    Ordering
EQ -> [Int] -> [Int] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (IntVec -> [Int]
toList IntVec
x) (IntVec -> [Int]
toList IntVec
y)
  
vecShape :: IntVec -> Shape  
vecShape :: IntVec -> Shape
vecShape (IntVec WordVec
dyn) = WordVec -> Shape
Dyn.vecShape WordVec
dyn

-- | The length of the vector
vecLen :: IntVec -> Int
vecLen :: IntVec -> Int
vecLen (IntVec WordVec
dyn) = WordVec -> Int
Dyn.vecLen WordVec
dyn 

-- | The number of bits per element used to encode the vector
vecBits :: IntVec -> Int
vecBits :: IntVec -> Int
vecBits (IntVec WordVec
dyn) = WordVec -> Int
Dyn.vecBits WordVec
dyn

--------------------------------------------------------------------------------
  
instance Show IntVec where
  showsPrec :: Int -> IntVec -> ShowS
showsPrec = Int -> IntVec -> ShowS
showsPrecIntVec

showIntVec :: IntVec -> String
showIntVec :: IntVec -> String
showIntVec IntVec
vec = Int -> IntVec -> ShowS
showsPrecIntVec Int
0 IntVec
vec []

showsPrecIntVec :: Int -> IntVec -> ShowS
showsPrecIntVec :: Int -> IntVec -> ShowS
showsPrecIntVec Int
prec IntVec
intvec
  = 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 "
--  . showsPrec 11 (lenMinMax intvec)
  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
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (IntVec -> [Int]
toList IntVec
intvec)

--------------------------------------------------------------------------------
-- * Empty, singleton
  
empty :: IntVec
empty :: IntVec
empty = [Int] -> IntVec
fromList []

null :: IntVec -> Bool
null :: IntVec -> Bool
null IntVec
v = IntVec -> Int
vecLen IntVec
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

singleton :: Int -> IntVec 
singleton :: Int -> IntVec
singleton Int
i = [Int] -> IntVec
fromList [Int
i]

isSingleton :: IntVec -> Maybe Int
isSingleton :: IntVec -> Maybe Int
isSingleton (IntVec WordVec
dynvec) = case WordVec -> Maybe Word
Dyn.isSingleton WordVec
dynvec of
  Maybe Word
Nothing -> Maybe Int
forall a. Maybe a
Nothing
  Just Word
w  -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Word -> Int
word2int (WordVec -> Int
Dyn.vecBits WordVec
dynvec) Word
w

--------------------------------------------------------------------------------
-- * Conversion from\/to lists

toList :: IntVec -> [Int]
toList :: IntVec -> [Int]
toList (IntVec WordVec
dynvec) = (Word -> Int) -> [Word] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word -> Int
word2int Int
bits) ([Word] -> [Int]) -> [Word] -> [Int]
forall a b. (a -> b) -> a -> b
$ WordVec -> [Word]
Dyn.toList WordVec
dynvec where
  !bits :: Int
bits = WordVec -> Int
Dyn.vecBits WordVec
dynvec

-- | @toRevList == reverse . toList@
toRevList :: IntVec -> [Int]
toRevList :: IntVec -> [Int]
toRevList (IntVec WordVec
dynvec) = (Word -> Int) -> [Word] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word -> Int
word2int Int
bits) ([Word] -> [Int]) -> [Word] -> [Int]
forall a b. (a -> b) -> a -> b
$ WordVec -> [Word]
Dyn.toRevList WordVec
dynvec where
  !bits :: Int
bits = WordVec -> Int
Dyn.vecBits WordVec
dynvec

-- | Note: @fromList xs = fromList' (lenMinMax xs)@ 
fromList :: [Int] -> IntVec
fromList :: [Int] -> IntVec
fromList [Int]
xs = WordVec -> IntVec
IntVec (WordVec -> IntVec) -> WordVec -> IntVec
forall a b. (a -> b) -> a -> b
$ Shape -> [Word] -> WordVec
Dyn.fromList' (Int -> Int -> Shape
Dyn.Shape Int
len Int
bits) ([Word] -> WordVec) -> [Word] -> WordVec
forall a b. (a -> b) -> a -> b
$ (Int -> Word) -> [Int] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Word
int2word Int
bits) [Int]
xs where
  (!Int
len,!(Int, Int)
minMax) = [Int] -> (Int, (Int, Int))
lenMinMax [Int]
xs
  !bits :: Int
bits = Int -> Int
roundBits ((Int, Int) -> Int
bitsNeededForMinMax (Int, Int)
minMax)

-- | usage: @fromList' (len,(min,max)) xs@ where @min@ and @max@ are the minimum and
-- maximum (or just a lower and upper bound) appearing in the list.
fromList' :: (Int,(Int,Int)) -> [Int] -> IntVec
fromList' :: (Int, (Int, Int)) -> [Int] -> IntVec
fromList' (!Int
len,!(Int, Int)
minMax) [Int]
xs = WordVec -> IntVec
IntVec (WordVec -> IntVec) -> WordVec -> IntVec
forall a b. (a -> b) -> a -> b
$ Shape -> [Word] -> WordVec
Dyn.fromList' (Int -> Int -> Shape
Dyn.Shape Int
len Int
bits) ([Word] -> WordVec) -> [Word] -> WordVec
forall a b. (a -> b) -> a -> b
$ (Int -> Word) -> [Int] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Word
int2word Int
bits) [Int]
xs where
  !bits :: Int
bits = Int -> Int
roundBits ((Int, Int) -> Int
bitsNeededForMinMax (Int, Int)
minMax)

-- | Don't use this unless you really know what you are doing!
fromList'' :: Shape -> [Int] -> IntVec
fromList'' :: Shape -> [Int] -> IntVec
fromList'' shape :: Shape
shape@(Shape Int
len !Int
bits) [Int]
xs = WordVec -> IntVec
IntVec (WordVec -> IntVec) -> WordVec -> IntVec
forall a b. (a -> b) -> a -> b
$ Shape -> [Word] -> WordVec
Dyn.fromList' Shape
shape ([Word] -> WordVec) -> [Word] -> WordVec
forall a b. (a -> b) -> a -> b
$ (Int -> Word) -> [Int] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Word
int2word Int
bits) [Int]
xs 

-- | Computes the length, minimum and maximum of a list, traversing it only
-- once (instead of 3 times).
lenMinMax :: [Int] -> (Int,(Int,Int))
lenMinMax :: [Int] -> (Int, (Int, Int))
lenMinMax = Int -> Int -> Int -> [Int] -> (Int, (Int, Int))
forall a b. (Num a, Ord b) => a -> b -> b -> [b] -> (a, (b, b))
go Int
0 Int
0 Int
0 where
  go :: a -> b -> b -> [b] -> (a, (b, b))
go !a
cnt !b
p !b
q (b
x:[b]
xs) = a -> b -> b -> [b] -> (a, (b, b))
go (a
cnta -> a -> a
forall a. Num a => a -> a -> a
+a
1) (b -> b -> b
forall a. Ord a => a -> a -> a
min b
x b
p) (b -> b -> b
forall a. Ord a => a -> a -> a
max b
x b
q) [b]
xs
  go !a
cnt !b
p !b
q []     = (a
cnt,(b
p,b
q))

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

int2word :: Int -> (Int -> Word)
int2word :: Int -> Int -> Word
int2word !Int
bits = Int -> Word
i2w where
  !mask :: Word
mask = Word -> Int -> Word
forall a. Bits a => a -> Int -> a
shiftL Word
1 Int
bits Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1 :: Word

  i2w :: Int -> Word
  i2w :: Int -> Word
i2w Int
x = (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x :: Word) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
mask

word2int :: Int -> (Word -> Int)
word2int :: Int -> Word -> Int
word2int !Int
bits = Word -> Int
w2i where
  !mask :: Word
mask = Word -> Int -> Word
forall a. Bits a => a -> Int -> a
shiftL Word
1 Int
bits Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1  :: Word
  !ffff :: Word
ffff = Word -> Word
forall a. Bits a => a -> a
complement Word
mask :: Word
  !bitsMinus1 :: Int
bitsMinus1 = Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

  w2i :: Word -> Int
  w2i :: Word -> Int
w2i Word
x = case Word -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word
x Int
bitsMinus1 of
    Bool
False -> Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral           Word
x      -- non-negative
    Bool
True  -> Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
ffff Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
x)     -- negative

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

-- | Indexing starts from 0. No bound checks are done.
unsafeIndex :: Int -> IntVec -> Int
unsafeIndex :: Int -> IntVec -> Int
unsafeIndex Int
idx (IntVec WordVec
dynvec) = Int -> Word -> Int
word2int Int
bits (Int -> WordVec -> Word
Dyn.unsafeIndex Int
idx WordVec
dynvec) where
  !bits :: Int
bits = WordVec -> Int
Dyn.vecBits WordVec
dynvec

safeIndex :: Int -> IntVec -> Maybe Int
safeIndex :: Int -> IntVec -> Maybe Int
safeIndex Int
idx (IntVec WordVec
dynvec) = (Int -> Word -> Int
word2int Int
bits) (Word -> Int) -> Maybe Word -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> WordVec -> Maybe Word
Dyn.safeIndex Int
idx WordVec
dynvec) where
  !bits :: Int
bits = WordVec -> Int
Dyn.vecBits WordVec
dynvec

--------------------------------------------------------------------------------
-- * Head, tail, etc
    
head :: IntVec -> Int
head :: IntVec -> Int
head (IntVec WordVec
dynvec) = Int -> Word -> Int
word2int Int
bits (WordVec -> Word
Dyn.head WordVec
dynvec) where
  !bits :: Int
bits = WordVec -> Int
Dyn.vecBits WordVec
dynvec

last :: IntVec -> Int
last :: IntVec -> Int
last (IntVec WordVec
dynvec) = Int -> Word -> Int
word2int Int
bits (WordVec -> Word
Dyn.last WordVec
dynvec) where
  !bits :: Int
bits = WordVec -> Int
Dyn.vecBits WordVec
dynvec

tail :: IntVec -> IntVec
tail :: IntVec -> IntVec
tail (IntVec WordVec
dynvec) = WordVec -> IntVec
IntVec (WordVec -> WordVec
Dyn.tail WordVec
dynvec)

uncons :: IntVec -> Maybe (Int,IntVec)
uncons :: IntVec -> Maybe (Int, IntVec)
uncons (IntVec WordVec
dynvec) = case WordVec -> Maybe (Word, WordVec)
Dyn.uncons WordVec
dynvec of
  Maybe (Word, WordVec)
Nothing     -> Maybe (Int, IntVec)
forall a. Maybe a
Nothing
  Just (Word
w,WordVec
tl) -> (Int, IntVec) -> Maybe (Int, IntVec)
forall a. a -> Maybe a
Just (Int -> Word -> Int
word2int Int
bits Word
w , WordVec -> IntVec
IntVec WordVec
tl)
  where
    bits :: Int
bits = WordVec -> Int
Dyn.vecBits WordVec
dynvec

{-
-- | For testing purposes only
uncons_naive :: IntVec -> Maybe (Int,IntVec)
uncons_naive vec = if null vec 
  then Nothing
  else Just (head vec, tail vec)
-}

-- | Prepends an element
cons :: Int -> IntVec -> IntVec
cons :: Int -> IntVec -> IntVec
cons Int
k ivec :: IntVec
ivec@(IntVec WordVec
vec) = WordVec -> IntVec
IntVec (WordVec -> IntVec) -> WordVec -> IntVec
forall a b. (a -> b) -> a -> b
$ Shape -> [Word] -> WordVec
Dyn.fromList' Shape
shape' ([Word] -> WordVec) -> [Word] -> WordVec
forall a b. (a -> b) -> a -> b
$ (Int -> Word) -> [Int] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Word
int2word Int
bits') (Int
k Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: IntVec -> [Int]
toList IntVec
ivec) where
  (Shape Int
len Int
bits) = WordVec -> Shape
Dyn.vecShape WordVec
vec
  bits' :: Int
bits'  = Int -> Int
roundBits (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
bits (Int -> Int
bitsNeededFor Int
k)
  shape' :: Shape
shape' = Int -> Int -> Shape
Shape (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
bits'

-- | Appends an element
snoc :: IntVec -> Int -> IntVec
snoc :: IntVec -> Int -> IntVec
snoc ivec :: IntVec
ivec@(IntVec WordVec
vec) Int
k = WordVec -> IntVec
IntVec (WordVec -> IntVec) -> WordVec -> IntVec
forall a b. (a -> b) -> a -> b
$ Shape -> [Word] -> WordVec
Dyn.fromList' Shape
shape' ([Word] -> WordVec) -> [Word] -> WordVec
forall a b. (a -> b) -> a -> b
$ (Int -> Word) -> [Int] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Word
int2word Int
bits') (IntVec -> [Int]
toList IntVec
ivec [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
k]) where
  (Shape Int
len Int
bits) = WordVec -> Shape
Dyn.vecShape WordVec
vec
  bits' :: Int
bits'  = Int -> Int
roundBits (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
bits (Int -> Int
bitsNeededFor Int
k)
  shape' :: Shape
shape' = Int -> Int -> Shape
Shape (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
bits'

concat :: IntVec -> IntVec -> IntVec
concat :: IntVec -> IntVec -> IntVec
concat IntVec
u IntVec
v = Shape -> [Int] -> IntVec
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)) (IntVec -> [Int]
toList IntVec
u [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ IntVec -> [Int]
toList IntVec
v) where
  Shape Int
lu Int
bu = IntVec -> Shape
vecShape IntVec
u
  Shape Int
lv Int
bv = IntVec -> Shape
vecShape IntVec
v

--------------------------------------------------------------------------------
-- * Generic operations

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

naiveMap :: (Int -> Int) -> IntVec -> IntVec
naiveMap :: (Int -> Int) -> IntVec -> IntVec
naiveMap Int -> Int
f IntVec
u = [Int] -> IntVec
fromList ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
f ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ IntVec -> [Int]
toList IntVec
u)

-- | If you have (nearly sharp) lower and upper bounds for the result of your of function
-- on your vector, mapping can be more efficient 
boundedMap :: (Int,Int) -> (Int -> Int) -> IntVec -> IntVec
boundedMap :: (Int, Int) -> (Int -> Int) -> IntVec -> IntVec
boundedMap (Int, Int)
minMax Int -> Int
f IntVec
vec = Shape -> [Int] -> IntVec
fromList'' (Int -> Int -> Shape
Shape Int
l Int
bits) (IntVec -> [Int]
toList IntVec
vec) where
  l :: Int
l    = IntVec -> Int
vecLen IntVec
vec
  bits :: Int
bits = Int -> Int
roundBits (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Int
bitsNeededForMinMax (Int, Int)
minMax

naiveZipWith :: (Int -> Int -> Int) -> IntVec -> IntVec -> IntVec
naiveZipWith :: (Int -> Int -> Int) -> IntVec -> IntVec -> IntVec
naiveZipWith Int -> Int -> Int
f IntVec
u IntVec
v = [Int] -> IntVec
fromList ([Int] -> IntVec) -> [Int] -> IntVec
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
L.zipWith Int -> Int -> Int
f (IntVec -> [Int]
toList IntVec
u) (IntVec -> [Int]
toList IntVec
v)

-- | If you have (nearly sharp) lower and upper bounds for the result of your of function
-- on your vector, zipping can be more efficient 
boundedZipWith :: (Int,Int) -> (Int -> Int -> Int) -> IntVec -> IntVec -> IntVec
boundedZipWith :: (Int, Int) -> (Int -> Int -> Int) -> IntVec -> IntVec -> IntVec
boundedZipWith (Int, Int)
minMax Int -> Int -> Int
f IntVec
vec1 IntVec
vec2  = Shape -> [Int] -> IntVec
fromList'' (Int -> Int -> Shape
Shape Int
l Int
bits) ([Int] -> IntVec) -> [Int] -> IntVec
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
L.zipWith Int -> Int -> Int
f (IntVec -> [Int]
toList IntVec
vec1) (IntVec -> [Int]
toList IntVec
vec2) where
  l :: Int
l    = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (IntVec -> Int
vecLen IntVec
vec1) (IntVec -> Int
vecLen IntVec
vec2)
  bits :: Int
bits = Int -> Int
roundBits (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Int
bitsNeededForMinMax (Int, Int)
minMax

listZipWith :: (Int -> Int -> a) -> IntVec -> IntVec -> [a]
listZipWith :: (Int -> Int -> a) -> IntVec -> IntVec -> [a]
listZipWith Int -> Int -> a
f IntVec
u IntVec
v = (Int -> Int -> a) -> [Int] -> [Int] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
L.zipWith Int -> Int -> a
f (IntVec -> [Int]
toList IntVec
u) (IntVec -> [Int]
toList IntVec
v)
  
--------------------------------------------------------------------------------
-- * helpers for counting the necessary number of bits

-- | usage: @bitsNeededForMinMax (min,max)@
bitsNeededForMinMax :: (Int,Int) -> Int
bitsNeededForMinMax :: (Int, Int) -> Int
bitsNeededForMinMax (Int
p,Int
q) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int
bitsNeededFor Int
p) (Int -> Int
bitsNeededFor Int
q)

-- | Note: this automatically rounds up to multiples of 4
bitsNeededFor :: Int -> Int
bitsNeededFor :: Int -> Int
bitsNeededFor = Int -> Int
roundBits (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
bitsNeededFor'

bitsNeededFor' :: Int -> Int
bitsNeededFor' :: Int -> Int
bitsNeededFor' Int
bound 
  | Int
bound Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0  = Int -> Int
ceilingLog2 (    Int
bound Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1   -- +8 needs 5 bits (-16..+15)
  | Int
bound Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
0  = Int -> Int
ceilingLog2 (Int -> Int
forall a. Num a => a -> a
abs Int
bound    ) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: Int -> Int
ceilingLog2 Int
0 = Int
0
    ceilingLog2 Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall t p. (Num t, Num p, Bits t) => t -> p
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
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)

-- | 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

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