module Bitmap (
Bitmap, mkBitmap,
intsToBitmap, intsToReverseBitmap,
mAX_SMALL_BITMAP_SIZE,
seqBitmap,
) where
#include "HsVersions.h"
#include "../includes/MachDeps.h"
import SMRep
import Constants
import Util
import Data.Bits
type Bitmap = [StgWord]
mkBitmap :: [Bool] -> Bitmap
mkBitmap [] = []
mkBitmap stuff = chunkToBitmap chunk : mkBitmap rest
where (chunk, rest) = splitAt wORD_SIZE_IN_BITS stuff
chunkToBitmap :: [Bool] -> StgWord
chunkToBitmap chunk =
foldr (.|.) 0 [ 1 `shiftL` n | (True,n) <- zip chunk [0..] ]
intsToBitmap :: Int -> [Int] -> Bitmap
intsToBitmap size slots
| size <= 0 = []
| otherwise =
(foldr (.|.) 0 (map (1 `shiftL`) these)) :
intsToBitmap (size wORD_SIZE_IN_BITS)
(map (\x -> x wORD_SIZE_IN_BITS) rest)
where (these,rest) = span (<wORD_SIZE_IN_BITS) slots
intsToReverseBitmap :: Int -> [Int] -> Bitmap
intsToReverseBitmap size slots
| size <= 0 = []
| otherwise =
(foldr xor init (map (1 `shiftL`) these)) :
intsToReverseBitmap (size wORD_SIZE_IN_BITS)
(map (\x -> x wORD_SIZE_IN_BITS) rest)
where (these,rest) = span (<wORD_SIZE_IN_BITS) slots
init
| size >= wORD_SIZE_IN_BITS = complement 0
| otherwise = (1 `shiftL` size) 1
mAX_SMALL_BITMAP_SIZE :: Int
mAX_SMALL_BITMAP_SIZE | wORD_SIZE == 4 = 27
| otherwise = 58
seqBitmap :: Bitmap -> a -> a
seqBitmap = seqList