-- |
-- Module:      Math.NumberTheory.Utils.BitMask
-- Copyright:   (c) 2020 Andrew Lelechenko
-- Licence:     MIT
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>
--
-- Bit mask utilities.
--

{-# LANGUAGE CPP          #-}
{-# LANGUAGE MagicHash    #-}

module Math.NumberTheory.Utils.BitMask
  ( indexBitSet
  -- , vectorToAddrLiteral
  ) where

#include "MachDeps.h"

import Data.Bits (countTrailingZeros, finiteBitSize, testBit, (.&.))
import GHC.Exts (Int(..), Word(..), Ptr(..), iShiftRL#, indexWordOffAddr#)
#ifdef WORDS_BIGENDIAN
import GHC.Exts (byteSwap#)
#endif

-- import Data.Bits (unsafeShiftL)
-- import Data.List (unfoldr)
-- import Data.Char (chr)

indexBitSet :: Ptr Word -> Int -> Bool
indexBitSet :: Ptr Word -> Int -> Bool
indexBitSet (Ptr Addr#
addr#) i :: Int
i@(I# Int#
i#) = Word
word Word -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` (Int
i Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int
fbs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
  where
    fbs :: Int
fbs = Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word)
    logFbs# :: Int#
logFbs# = case Int -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Int
fbs of
      I# Int#
l# -> Int#
l#
    word# :: Word#
word# = Addr# -> Int# -> Word#
indexWordOffAddr# Addr#
addr# (Int#
i# Int# -> Int# -> Int#
`iShiftRL#` Int#
logFbs#)
#ifdef WORDS_BIGENDIAN
    word = W# (byteSwap# word#)
#else
    word :: Word
word = Word# -> Word
W# Word#
word#
#endif

-- vectorToAddrLiteral :: [Bool] -> String
-- vectorToAddrLiteral = map (chr . toByte . padTo8) . unfoldr go
--   where
--     go :: [a] -> Maybe ([a], [a])
--     go [] = Nothing
--     go xs = Just (take 8 xs, drop 8 xs)

--     padTo8 :: [Bool] -> [Bool]
--     padTo8 xs
--       | length xs >= 8 = xs
--       | otherwise = xs ++ replicate (8 - length xs) False

--     toByte :: [Bool] -> Int
--     toByte xs = sum $ map (\i -> if xs !! i then 1 `unsafeShiftL` i else 0) [0..7]