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