{-# LANGUAGE BangPatterns #-}
module Bitmap (
Bitmap, mkBitmap,
intsToBitmap, intsToReverseBitmap,
mAX_SMALL_BITMAP_SIZE,
seqBitmap,
) where
import GhcPrelude
import SMRep
import DynFlags
import Util
import Data.Bits
type Bitmap = [StgWord]
mkBitmap :: DynFlags -> [Bool] -> Bitmap
mkBitmap :: DynFlags -> [Bool] -> Bitmap
mkBitmap DynFlags
_ [] = []
mkBitmap DynFlags
dflags [Bool]
stuff = DynFlags -> [Bool] -> StgWord
chunkToBitmap DynFlags
dflags [Bool]
chunk StgWord -> Bitmap -> Bitmap
forall a. a -> [a] -> [a]
: DynFlags -> [Bool] -> Bitmap
mkBitmap DynFlags
dflags [Bool]
rest
where ([Bool]
chunk, [Bool]
rest) = Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt (DynFlags -> Int
wORD_SIZE_IN_BITS DynFlags
dflags) [Bool]
stuff
chunkToBitmap :: DynFlags -> [Bool] -> StgWord
chunkToBitmap :: DynFlags -> [Bool] -> StgWord
chunkToBitmap DynFlags
dflags [Bool]
chunk =
(StgWord -> StgWord -> StgWord) -> StgWord -> Bitmap -> StgWord
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' StgWord -> StgWord -> StgWord
forall a. Bits a => a -> a -> a
(.|.) (DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags 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 = DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags Integer
1 StgWord -> Int -> StgWord
forall a. Bits a => a -> Int -> a
`shiftL` Int
i
intsToBitmap :: DynFlags
-> Int
-> [Int]
-> Bitmap
intsToBitmap :: DynFlags -> Int -> [Int] -> Bitmap
intsToBitmap DynFlags
dflags Int
size = Int -> [Int] -> Bitmap
go Int
0
where
word_sz :: Int
word_sz = DynFlags -> Int
wORD_SIZE_IN_BITS DynFlags
dflags
oneAt :: Int -> StgWord
oneAt :: Int -> StgWord
oneAt Int
i = DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags 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 (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' StgWord -> StgWord -> StgWord
forall a. Bits a => a -> a -> a
(.|.) (DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags Integer
0) ((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
intsToReverseBitmap :: DynFlags
-> Int
-> [Int]
-> Bitmap
intsToReverseBitmap :: DynFlags -> Int -> [Int] -> Bitmap
intsToReverseBitmap DynFlags
dflags Int
size = Int -> [Int] -> Bitmap
go Int
0
where
word_sz :: Int
word_sz = DynFlags -> Int
wORD_SIZE_IN_BITS DynFlags
dflags
oneAt :: Int -> StgWord
oneAt :: Int -> StgWord
oneAt Int
i = DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags 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 (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' StgWord -> StgWord -> StgWord
forall a. Bits a => a -> a -> a
xor (DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags 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 :: DynFlags -> Int
mAX_SMALL_BITMAP_SIZE :: DynFlags -> Int
mAX_SMALL_BITMAP_SIZE DynFlags
dflags
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = Int
27
| Bool
otherwise = Int
58
seqBitmap :: Bitmap -> a -> a
seqBitmap :: Bitmap -> a -> a
seqBitmap = Bitmap -> a -> a
forall a b. [a] -> b -> b
seqList