bitarray-0.0.1/0000755000076500000240000000000011216273013013037 5ustar bkomuvesstaffbitarray-0.0.1/bitarray.cabal0000640000076500000240000000207711216273013015642 0ustar bkomuvesstaffName: bitarray Version: 0.0.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 == 6.10.1 Cabal-Version: >= 1.2 Build-Type: Simple Flag splitBase Description: Choose the new smaller, split-up base package. Library if flag(splitBase) Build-Depends: base >= 3 && < 5, array else Build-Depends: base >= 2 && < 3 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/Data/0000755000076500000240000000000011216273013013710 5ustar bkomuvesstaffbitarray-0.0.1/Data/BitArray/0000755000076500000240000000000011216273013015425 5ustar bkomuvesstaffbitarray-0.0.1/Data/BitArray/Immutable.hs0000644000076500000240000000211611216273013017700 0ustar bkomuvesstaff 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 -------------------------------------------------------------------------------- bitarray-0.0.1/Data/BitArray/IO.hs0000644000076500000240000000604511216273013016275 0ustar bkomuvesstaff -- | 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.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/Data/BitArray/ST.hs0000644000076500000240000000620311216273013016310 0ustar bkomuvesstaff -- | 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.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/Data/BitArray.hs0000644000076500000240000000604511216273013015766 0ustar bkomuvesstaff -- | 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/LICENSE0000640000076500000240000000271411216273013014044 0ustar bkomuvesstaffCopyright (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/Setup.lhs0000740000076500000240000000011411216273013014640 0ustar bkomuvesstaff#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain