bitarray-0.0.1.1/0000755000000000000000000000000012372403452011654 5ustar0000000000000000bitarray-0.0.1.1/Setup.lhs0000644000000000000000000000011412372403452013460 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMainbitarray-0.0.1.1/LICENSE0000644000000000000000000000271412372403452012665 0ustar0000000000000000Copyright (c) 2009, Balazs Komuves All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither names of the copyright holders nor the names of the contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. bitarray-0.0.1.1/bitarray.cabal0000644000000000000000000000166112372403452014461 0ustar0000000000000000Name: bitarray Version: 0.0.1.1 Synopsis: Mutable and immutable bit arrays Description: Mutable and immutable bit arrays. License: BSD3 License-file: LICENSE Author: Balazs Komuves Copyright: (c) 2009 Balazs Komuves Maintainer: bkomuves (plus) hackage (at) gmail (dot) com Homepage: http://code.haskell.org/~bkomuves/ Stability: Experimental Category: Data Tested-With: GHC == 7.8.3 Cabal-Version: >= 1.2 Build-Type: Simple Library Build-Depends: base >= 3 && < 5, array >= 0.4 Exposed-Modules: Data.BitArray, Data.BitArray.ST, Data.BitArray.IO Other-Modules: Data.BitArray.Immutable Extensions: CPP Hs-Source-Dirs: . ghc-options: -Wall -fno-warn-unused-matches bitarray-0.0.1.1/Data/0000755000000000000000000000000012372403452012525 5ustar0000000000000000bitarray-0.0.1.1/Data/BitArray.hs0000644000000000000000000000604512372403452014603 0ustar0000000000000000 -- | Immutable one-dimensional packed bit arrays. -- The main advantage should be compactness in memory. module Data.BitArray ( BitArray , bitArrayBounds , lookupBit , unsafeLookupBit -- * Bit array construction \/ deconstruction , bitArray , bitArray' , accumBitArray , listBitArray , bits -- * 0\/1 versions , bits01 , listBitArray01 ) where -------------------------------------------------------------------------------- import Control.Monad import Control.Monad.ST import Data.Bits import Data.Word import Data.Array.Unboxed import Data.BitArray.Immutable import Data.BitArray.ST -------------------------------------------------------------------------------- instance Eq BitArray where ar1 == ar2 = bits ar1 == bits ar2 instance Ord BitArray where compare ar1 ar2 = compare (bits ar1) (bits ar2) instance Show BitArray where show ar@(A s t a) = "listBitArray01 " ++ show (s,t) ++ " " ++ show (bits01 ar) -------------------------------------------------------------------------------- bitArrayBounds :: BitArray -> (Int,Int) bitArrayBounds (A s t _) = (s,t) lookupBit :: BitArray -> Int -> Bool lookupBit ar@(A s t _) j = if jt then error "BitArray/lookupBit: index out of range" else unsafeLookupBit ar j unsafeLookupBit :: BitArray -> Int -> Bool unsafeLookupBit (A s t a) j = testBit w l where (k,l) = ind (j-s) w = a!k -------------------------------------------------------------------------------- -- | Unspecified values become 'False'. bitArray :: (Int,Int) -> [(Int,Bool)] -> BitArray bitArray = accumBitArray (flip const) False -- | The first argument gives the default value (instead of 'False') bitArray' :: Bool -> (Int,Int) -> [(Int,Bool)] -> BitArray bitArray' = accumBitArray (flip const) {-# SPECIALIZE accumBitArray :: (Bool -> Bool -> Bool) -> Bool -> (Int,Int) -> [(Int,Bool)] -> BitArray #-} accumBitArray :: (Bool -> a -> Bool) -> Bool -> (Int,Int) -> [(Int,a)] -> BitArray accumBitArray f e st xs = runST $ do ar <- newBitArray st e forM_ xs $ \(i,x) -> do b <- readBit ar i writeBit ar i (f b x) unsafeFreezeBitArray ar -- | If the list is too short, the rest of the array is filled with 'False'. listBitArray :: (Int,Int) -> [Bool] -> BitArray listBitArray (s,t) bs = A s t a where a = listArray (0,k-1) chunks k = (t-s+64) `shiftR` 6 chunks = take k $ worker (bs ++ repeat False) worker bs = convert (take 64 bs) : worker (drop 64 bs) convert bs = fst $ foldl f (0,1) bs f (x,e) b = if b then (x+e, e+e) else (x, e+e) bits :: BitArray -> [Bool] bits (A s t a) = take (t-s+1) $ concatMap worker (elems a) where worker i = fst $ foldl f ([], i) [(0::Int)..63] f (bs,i) _ = ( (0 /= i .&. 0x8000000000000000) : bs, shiftL i 1) -------------------------------------------------------------------------------- listBitArray01 :: (Int,Int) -> [Int] -> BitArray listBitArray01 st is = listBitArray st (map intToBool is) bits01 :: BitArray -> [Int] bits01 = map boolToInt . bits -------------------------------------------------------------------------------- bitarray-0.0.1.1/Data/BitArray/0000755000000000000000000000000012372403452014242 5ustar0000000000000000bitarray-0.0.1.1/Data/BitArray/ST.hs0000644000000000000000000000623412372403452015131 0ustar0000000000000000 -- | Mutable one-dimensional packed bit arrays in the (strict) ST monad. module Data.BitArray.ST ( STBitArray , getBitArrayBounds , newBitArray , readBit , writeBit , flipBit , unsafeReadBit , unsafeWriteBit , unsafeFlipBit , thawBitArray , unsafeThawBitArray , freezeBitArray , unsafeFreezeBitArray ) where -------------------------------------------------------------------------------- import Control.Monad.ST import Data.Word import Data.Bits import Data.Array.ST import Data.Array.Unsafe import Data.BitArray.Immutable -------------------------------------------------------------------------------- data STBitArray s = STA { _first :: {-# UNPACK #-} !Int , _last :: {-# UNPACK #-} !Int , _words :: {-# UNPACK #-} !(STUArray s Int Word64) } -------------------------------------------------------------------------------- getBitArrayBounds :: STBitArray s -> ST s (Int,Int) getBitArrayBounds (STA s t _) = return (s,t) newBitArray :: (Int,Int) -> Bool -> ST s (STBitArray s) newBitArray (s,t) b = if t 0 True -> 0xFFFFFFFFFFFFFFFF -- fedcba9876543210 readBit :: STBitArray s -> Int -> ST s Bool readBit ar@(STA s t _) j = if jt then error "STBitArray/readBit: index out of range" else unsafeReadBit ar j unsafeReadBit :: STBitArray s -> Int -> ST s Bool unsafeReadBit (STA s t a) j = do let (k,l) = ind (j-s) w <- readArray a k return (w `testBit` l) writeBit :: STBitArray s -> Int -> Bool -> ST s () writeBit ar@(STA s t _) j b = if jt then error "STBitArray/writeBit: index out of range" else unsafeWriteBit ar j b unsafeWriteBit :: STBitArray s -> Int -> Bool -> ST s () unsafeWriteBit (STA s t a) j b = do let (k,l) = ind (j-s) w <- readArray a k if b then writeArray a k (w `setBit` l) else writeArray a k (w `clearBit` l) return () -- | flips the bit and returns the /old/ value flipBit :: STBitArray s -> Int -> ST s Bool flipBit ar@(STA s t _) j = if jt then error "STBitArray/flipBit: index out of range" else unsafeFlipBit ar j unsafeFlipBit :: STBitArray s -> Int -> ST s Bool unsafeFlipBit ar@(STA s t a) j = do let (k,l) = ind (j-s) w <- readArray a k let b = w `testBit` l if b then writeArray a k (w `clearBit` l) else writeArray a k (w `setBit` l) return b -------------------------------------------------------------------------------- thawBitArray :: BitArray -> ST s (STBitArray s) thawBitArray (A s t x) = thaw x >>= \y -> return (STA s t y) unsafeThawBitArray :: BitArray -> ST s (STBitArray s) unsafeThawBitArray (A s t x) = unsafeThaw x >>= \y -> return (STA s t y) freezeBitArray :: STBitArray s -> ST s BitArray freezeBitArray (STA s t x) = freeze x >>= \y -> return (A s t y) unsafeFreezeBitArray :: STBitArray s -> ST s BitArray unsafeFreezeBitArray (STA s t x) = unsafeFreeze x >>= \y -> return (A s t y) -------------------------------------------------------------------------------- bitarray-0.0.1.1/Data/BitArray/IO.hs0000644000000000000000000000607612372403452015116 0ustar0000000000000000 -- | Mutable one-dimensional packed bit arrays in the IO monad. module Data.BitArray.IO ( IOBitArray , getBitArrayBounds , newBitArray , readBit , writeBit , flipBit , unsafeReadBit , unsafeWriteBit , unsafeFlipBit , thawBitArray , unsafeThawBitArray , freezeBitArray , unsafeFreezeBitArray ) where -------------------------------------------------------------------------------- import Data.Word import Data.Bits import Data.Array.IO import Data.Array.Unsafe import Data.BitArray.Immutable -------------------------------------------------------------------------------- data IOBitArray = IOA { _first :: {-# UNPACK #-} !Int , _last :: {-# UNPACK #-} !Int , _words :: {-# UNPACK #-} !(IOUArray Int Word64) } -------------------------------------------------------------------------------- getBitArrayBounds :: IOBitArray -> IO (Int,Int) getBitArrayBounds (IOA s t _) = return (s,t) newBitArray :: (Int,Int) -> Bool -> IO IOBitArray newBitArray (s,t) b = if t 0 True -> 0xFFFFFFFFFFFFFFFF -- fedcba9876543210 readBit :: IOBitArray -> Int -> IO Bool readBit ar@(IOA s t _) j = if jt then error "IOBitArray/readBit: index out of range" else unsafeReadBit ar j unsafeReadBit :: IOBitArray -> Int -> IO Bool unsafeReadBit (IOA s t a) j = do let (k,l) = ind (j-s) w <- readArray a k return (w `testBit` l) writeBit :: IOBitArray -> Int -> Bool -> IO () writeBit ar@(IOA s t _) j b = if jt then error "IOBitArray/writeBit: index out of range" else unsafeWriteBit ar j b unsafeWriteBit :: IOBitArray -> Int -> Bool -> IO () unsafeWriteBit (IOA s t a) j b = do let (k,l) = ind (j-s) w <- readArray a k if b then writeArray a k (w `setBit` l) else writeArray a k (w `clearBit` l) return () -- | flips the bit and returns the /old/ value flipBit :: IOBitArray -> Int -> IO Bool flipBit ar@(IOA s t _) j = if jt then error "IOBitArray/flipBit: index out of range" else unsafeFlipBit ar j unsafeFlipBit :: IOBitArray -> Int -> IO Bool unsafeFlipBit ar@(IOA s t a) j = do let (k,l) = ind (j-s) w <- readArray a k let b = w `testBit` l if b then writeArray a k (w `clearBit` l) else writeArray a k (w `setBit` l) return b -------------------------------------------------------------------------------- thawBitArray :: BitArray -> IO IOBitArray thawBitArray (A s t x) = thaw x >>= \y -> return (IOA s t y) unsafeThawBitArray :: BitArray -> IO IOBitArray unsafeThawBitArray (A s t x) = unsafeThaw x >>= \y -> return (IOA s t y) freezeBitArray :: IOBitArray -> IO BitArray freezeBitArray (IOA s t x) = freeze x >>= \y -> return (A s t y) unsafeFreezeBitArray :: IOBitArray -> IO BitArray unsafeFreezeBitArray (IOA s t x) = unsafeFreeze x >>= \y -> return (A s t y) -------------------------------------------------------------------------------- bitarray-0.0.1.1/Data/BitArray/Immutable.hs0000644000000000000000000000211612372403452016515 0ustar0000000000000000 module Data.BitArray.Immutable where -------------------------------------------------------------------------------- import Data.Word import Data.Bits import Data.Array.Unboxed -------------------------------------------------------------------------------- -- | A packed bit array. -- Internally, it is represented as an unboxed array of 'Word64'-s. data BitArray = A { _first :: {-# UNPACK #-} !Int , _last :: {-# UNPACK #-} !Int , _words :: {-# UNPACK #-} !(UArray Int Word64) } -------------------------------------------------------------------------------- ind :: Int -> (Int,Int) ind i = (k,l) where k = i `shiftR` 6 l = i - k `shiftL` 6 -------------------------------------------------------------------------------- {-# SPECIALIZE intToBool :: Int -> Bool #-} intToBool :: Integral a => a -> Bool intToBool n = case n of 0 -> False _ -> True {-# SPECIALIZE boolToInt :: Bool -> Int #-} boolToInt :: Integral a => Bool -> a boolToInt b = case b of False -> 0 True -> 1 --------------------------------------------------------------------------------