bitarray (empty) → 0.0.1
raw patch · 7 files changed
+449/−0 lines, 7 filesdep +arraydep +basesetup-changed
Dependencies added: array, base
Files
- Data/BitArray.hs +103/−0
- Data/BitArray/IO.hs +117/−0
- Data/BitArray/Immutable.hs +42/−0
- Data/BitArray/ST.hs +118/−0
- LICENSE +29/−0
- Setup.lhs +3/−0
- bitarray.cabal +37/−0
+ Data/BitArray.hs view
@@ -0,0 +1,103 @@++-- | 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 j<s || j>t + 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+ +--------------------------------------------------------------------------------
+ Data/BitArray/IO.hs view
@@ -0,0 +1,117 @@++-- | 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<s+ then error "IOBitArray/newBitArray: empty range"+ else do+ words <- newArray (0,k-1) w+ return (IOA s t words) + where+ k = (t-s+64) `shiftR` 6+ w = case b of+ False -> 0+ True -> 0xFFFFFFFFFFFFFFFF+-- fedcba9876543210 ++readBit :: IOBitArray -> Int -> IO Bool+readBit ar@(IOA s t _) j = if j<s || j>t + 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 j<s || j>t + 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 j<s || j>t + 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)++--------------------------------------------------------------------------------+
+ Data/BitArray/Immutable.hs view
@@ -0,0 +1,42 @@++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++--------------------------------------------------------------------------------
+ Data/BitArray/ST.hs view
@@ -0,0 +1,118 @@++-- | 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<s+ then error "STBitArray/newBitArray: empty range"+ else do+ words <- newArray (0,k-1) w+ return (STA s t words) + where+ k = (t-s+64) `shiftR` 6+ w = case b of+ False -> 0+ True -> 0xFFFFFFFFFFFFFFFF+-- fedcba9876543210 ++readBit :: STBitArray s -> Int -> ST s Bool+readBit ar@(STA s t _) j = if j<s || j>t + 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 j<s || j>t + 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 j<s || j>t + 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)++--------------------------------------------------------------------------------
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (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.+
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ bitarray.cabal view
@@ -0,0 +1,37 @@+Name: 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+