{-# LANGUAGE BangPatterns #-}
module GHC.Data.Bitmap (
        Bitmap, mkBitmap,
        intsToReverseBitmap,
        mAX_SMALL_BITMAP_SIZE,
  ) where
import GHC.Prelude
import GHC.Platform
import GHC.Runtime.Heap.Layout
type Bitmap = [StgWord]
mkBitmap :: Platform -> [Bool] -> Bitmap
mkBitmap :: Platform -> [Bool] -> Bitmap
mkBitmap Platform
_ [] = []
mkBitmap Platform
platform [Bool]
stuff = Platform -> [Bool] -> StgWord
chunkToBitmap Platform
platform [Bool]
chunk StgWord -> Bitmap -> Bitmap
forall a. a -> [a] -> [a]
: Platform -> [Bool] -> Bitmap
mkBitmap Platform
platform [Bool]
rest
  where ([Bool]
chunk, [Bool]
rest) = Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt (Platform -> Int
platformWordSizeInBits Platform
platform) [Bool]
stuff
chunkToBitmap :: Platform -> [Bool] -> StgWord
chunkToBitmap :: Platform -> [Bool] -> StgWord
chunkToBitmap Platform
platform [Bool]
chunk =
  (StgWord -> StgWord -> StgWord) -> StgWord -> Bitmap -> StgWord
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' StgWord -> StgWord -> StgWord
forall a. Bits a => a -> a -> a
(.|.) (Platform -> Integer -> StgWord
toStgWord Platform
platform Integer
0) [ Int -> StgWord
oneAt Int
n | (Bool
True,Int
n) <- [Bool] -> [Int] -> [(Bool, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
chunk [Int
0..] ]
  where
    oneAt :: Int -> StgWord
    oneAt :: Int -> StgWord
oneAt Int
i = Platform -> Integer -> StgWord
toStgWord Platform
platform Integer
1 StgWord -> Int -> StgWord
forall a. Bits a => a -> Int -> a
`shiftL` Int
i
intsToReverseBitmap :: Platform
                    -> Int      
                    -> [Int]    
                    -> Bitmap
intsToReverseBitmap :: Platform -> Int -> [Int] -> Bitmap
intsToReverseBitmap Platform
platform Int
size = Int -> [Int] -> Bitmap
go Int
0
  where
    word_sz :: Int
word_sz = Platform -> Int
platformWordSizeInBits Platform
platform
    oneAt :: Int -> StgWord
    oneAt :: Int -> StgWord
oneAt Int
i = Platform -> Integer -> StgWord
toStgWord Platform
platform Integer
1 StgWord -> Int -> StgWord
forall a. Bits a => a -> Int -> a
`shiftL` Int
i
    
    
    go :: Int -> [Int] -> Bitmap
    go :: Int -> [Int] -> Bitmap
go !Int
pos [Int]
slots
      | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
pos = []
      | Bool
otherwise =
        ((StgWord -> StgWord -> StgWord) -> StgWord -> Bitmap -> StgWord
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' StgWord -> StgWord -> StgWord
forall a. Bits a => a -> a -> a
xor (Platform -> Integer -> StgWord
toStgWord Platform
platform Integer
init) ((Int -> StgWord) -> [Int] -> Bitmap
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i->Int -> StgWord
oneAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos)) [Int]
these)) StgWord -> Bitmap -> Bitmap
forall a. a -> [a] -> [a]
:
          Int -> [Int] -> Bitmap
go (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
word_sz) [Int]
rest
      where
        ([Int]
these,[Int]
rest) = (Int -> Bool) -> [Int] -> ([Int], [Int])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
word_sz)) [Int]
slots
        remain :: Int
remain = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos
        init :: Integer
init
          | Int
remain Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
word_sz = -Integer
1
          | Bool
otherwise         = (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
remain) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
mAX_SMALL_BITMAP_SIZE :: Platform -> Int
mAX_SMALL_BITMAP_SIZE :: Platform -> Int
mAX_SMALL_BITMAP_SIZE Platform
platform =
    case Platform -> PlatformWordSize
platformWordSize Platform
platform of
      PlatformWordSize
PW4 -> Int
27 
      PlatformWordSize
PW8 -> Int
58