-- | Manipulation de bits.
module Reloto.Bits where

import Data.Bool
import Data.Eq (Eq(..))
import Data.Int (Int)
import Data.List ((++), foldr, length, splitAt, tail)
import Data.Ord (Ord(..))
import Prelude (Integer, Integral(..), Num(..), error, undefined)
import Text.Show (Show(..))

-- | @bitSize n@ retourne le nombre de bits servant à encoder 'n'.
bitSize :: Integer -> Int
bitSize :: Integer -> Int
bitSize Integer
n | Integer
0Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<=Integer
n      = Integer -> Int
forall t p. (Num p, Integral t) => t -> p
go Integer
n
          | Bool
otherwise = Int
forall a. HasCallStack => a
undefined
          where go :: t -> p
go t
0 = p
0
                go t
i = p
1 p -> p -> p
forall a. Num a => a -> a -> a
+ t -> p
go (t
it -> t -> t
forall a. Integral a => a -> a -> a
`div`t
2)

-- | @integerOfBits bs@ retourne le nombre encodé par les bits 'bs'.
integerOfBits :: [Bool] -> Integer
integerOfBits :: [Bool] -> Integer
integerOfBits []     = Integer
0
integerOfBits (Bool
b:[Bool]
bs) = [Bool] -> Integer
integerOfBits [Bool]
bs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (if Bool
b then Integer
1 else Integer
0)

-- | @bitsOfInteger m n@ retourne les 'm' premiers bits de poids faible
-- encodant le nombre 'n'.
bitsOfInteger :: Int -> Integer -> [Bool]
bitsOfInteger :: Int -> Integer -> [Bool]
bitsOfInteger Int
m Integer
n | Int
0Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
m,Integer
0Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<=Integer
n = Int -> Integer -> [Bool]
forall t t. (Eq t, Num t, Integral t) => t -> t -> [Bool]
go Int
m Integer
n
                  | Bool
otherwise = [Bool]
forall a. HasCallStack => a
undefined
                  where go :: t -> t -> [Bool]
go t
0 t
_ = []
                        go t
i t
j = (t
rt -> t -> Bool
forall a. Eq a => a -> a -> Bool
==t
1) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: t -> t -> [Bool]
go (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1) t
q
                               where (t
q,t
r) = t
jt -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
`divMod`t
2

-- | @interleaveBits bs@ retourne les bits de @bs@
-- en consommant un bit de chaque liste à chaque passe.
interleaveBits :: [[Bool]] -> [Bool]
interleaveBits :: [[Bool]] -> [Bool]
interleaveBits [] = []
interleaveBits [[Bool]]
bss =
  let ([Bool]
hs,[[Bool]]
ts) = [[Bool]] -> ([Bool], [[Bool]])
forall a. [[a]] -> ([a], [[a]])
unzip [[Bool]]
bss in
  [Bool]
hs [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [[Bool]] -> [Bool]
interleaveBits [[Bool]]
ts
  where
  unzip :: [[a]] -> ([a], [[a]])
unzip = ([a] -> ([a], [[a]]) -> ([a], [[a]]))
-> ([a], [[a]]) -> [[a]] -> ([a], [[a]])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\[a]
bits ~([a]
hs,[[a]]
ts) ->
    case [a]
bits of
     [] -> ([a]
hs,[[a]]
ts)
     a
b:[a]
bs -> (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
hs,[a]
bs[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ts)
   ) ([], [])

-- | @randomIntOfBits n bs@ retourne le premier entier 'i' formé par les bits 'bs'
-- qui a le potentiel d’atteindre un entier dans @[0..n-1]@,
-- ou recommence en ignorant le premier bit si @n <= i@.
randomIntegerOfBits :: Integer -> [Bool] -> Integer
randomIntegerOfBits :: Integer -> [Bool] -> Integer
randomIntegerOfBits Integer
n [Bool]
bs | Int
given Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
enough = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
enough Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
given) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" bits missing")
                         | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i         = Integer -> [Bool] -> Integer
randomIntegerOfBits Integer
n ([Bool] -> [Bool]
forall a. [a] -> [a]
tail [Bool]
bits [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool]
bs')
                         | Bool
otherwise      = Integer
i
  where ([Bool]
bits, [Bool]
bs') = Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
enough [Bool]
bs
        i :: Integer
i           = [Bool] -> Integer
integerOfBits [Bool]
bits
        given :: Int
given       = [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
bits
        enough :: Int
enough      = Integer -> Int
bitSize (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)