vector (empty) → 0.1
raw patch · 14 files changed
+1750/−0 lines, 14 filesdep +arraydep +basedep +ghcsetup-changed
Dependencies added: array, base, ghc, ghc-prim
Files
- Data/Vector.hs +56/−0
- Data/Vector/IVector.hs +440/−0
- Data/Vector/MVector.hs +236/−0
- Data/Vector/MVector/Mut.hs +41/−0
- Data/Vector/Mutable.hs +77/−0
- Data/Vector/Stream.hs +543/−0
- Data/Vector/Stream/Size.hs +83/−0
- Data/Vector/Unboxed.hs +56/−0
- Data/Vector/Unboxed/Mutable.hs +63/−0
- Data/Vector/Unboxed/Unbox.hs +73/−0
- LICENSE +31/−0
- Setup.hs +3/−0
- include/phases.h +2/−0
- vector.cabal +46/−0
+ Data/Vector.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE MagicHash, UnboxedTuples, FlexibleInstances, MultiParamTypeClasses #-}++-- |+-- Module : Data.Vector+-- Copyright : (c) Roman Leshchinskiy 2008+-- License : BSD-style+--+-- Maintainer : rl@cse.unsw.edu.au+-- Stability : experimental+-- Portability : non-portable+-- +-- Boxed vectors+--++module Data.Vector (+ Vector(..), module Data.Vector.IVector+) where++import Data.Vector.IVector+import qualified Data.Vector.Mutable as Mut++import Control.Monad.ST ( runST )++import GHC.ST ( ST(..) )+import GHC.Prim ( Array#, unsafeFreezeArray#, indexArray#, (+#) )+import GHC.Base ( Int(..) )++data Vector a = Vector {-# UNPACK #-} !Int+ {-# UNPACK #-} !Int+ (Array# a)++instance IVector Vector a where+ {-# INLINE vnew #-}+ vnew init = runST (do+ Mut.Vector i n marr# <- init+ ST (\s# -> case unsafeFreezeArray# marr# s# of+ (# s2#, arr# #) -> (# s2#, Vector i n arr# #)))++ {-# INLINE vlength #-}+ vlength (Vector _ n _) = n++ {-# INLINE unsafeSlice #-}+ unsafeSlice (Vector i _ arr#) j n = Vector (i+j) n arr#++ {-# INLINE unsafeIndex #-}+ unsafeIndex (Vector (I# i#) _ arr#) (I# j#) f+ = case indexArray# arr# (i# +# j#) of (# x #) -> f x++instance Eq a => Eq (Vector a) where+ {-# INLINE (==) #-}+ (==) = eq++instance Ord a => Ord (Vector a) where+ {-# INLINE compare #-}+ compare = cmp+
+ Data/Vector/IVector.hs view
@@ -0,0 +1,440 @@+{-# LANGUAGE Rank2Types, MultiParamTypeClasses #-}+-- |+-- Module : Data.Vector.IVector+-- Copyright : (c) Roman Leshchinskiy 2008+-- License : BSD-style+--+-- Maintainer : rl@cse.unsw.edu.au+-- Stability : experimental+-- Portability : non-portable+-- +-- Generic interface to pure vectors+--++#include "phases.h"++module Data.Vector.IVector (+ -- * Immutable vectors+ IVector,++ -- * Length information+ length,++ -- * Construction+ empty, singleton, cons, snoc, replicate, (++),++ -- * Accessing individual elements+ (!), head, last,++ -- * Subvectors+ slice, extract, takeSlice, take, dropSlice, drop,++ -- * Permutations+ (//),++ -- * Mapping and zipping+ map, zipWith,++ -- * Comparisons+ eq, cmp,++ -- * Filtering+ filter, takeWhileSlice, takeWhile, dropWhileSlice, dropWhile,++ -- * Searching+ elem, notElem, find, findIndex,++ -- * Folding+ foldl, foldl1, foldl', foldl1', foldr, foldr1,++ -- * Conversion to/from lists+ toList, fromList,++ -- * Conversion to/from Streams+ stream, unstream,++ -- * MVector-based initialisation+ new,++ -- * Unsafe functions+ unsafeSlice, unsafeIndex,++ -- * Utility functions+ vlength, vnew+) where++import qualified Data.Vector.MVector as MVector+import Data.Vector.MVector ( MVector )++import qualified Data.Vector.MVector.Mut as Mut+import Data.Vector.MVector.Mut ( Mut )++import qualified Data.Vector.Stream as Stream+import Data.Vector.Stream ( Stream )+import Data.Vector.Stream.Size++import Control.Exception ( assert )++import Prelude hiding ( length,+ replicate, (++),+ head, last,+ init, tail, take, drop,+ map, zipWith,+ filter, takeWhile, dropWhile,+ elem, notElem,+ foldl, foldl1, foldr, foldr1 )++-- | Class of immutable vectors.+--+class IVector v a where+ -- | Construct a pure vector from a monadic initialiser (not fusible!)+ vnew :: (forall mv m. MVector mv m a => m (mv a)) -> v a++ -- | Length of the vector (not fusible!)+ vlength :: v a -> Int++ -- | Yield a part of the vector without copying it. No range checks!+ unsafeSlice :: v a -> Int -> Int -> v a++ -- | Apply the given function to the element at the given position. This+ -- interface prevents us from being too lazy. Suppose we had+ --+ -- > unsafeIndex' :: v a -> Int -> a+ --+ -- instead. Now, if we wanted to copy a vector, we'd do something like+ --+ -- > copy mv v ... = ... unsafeWrite mv i (unsafeIndex' v i) ...+ --+ -- For lazy vectors, the indexing would not be evaluated which means that we+ -- would retain a reference to the original vector in each element we write.+ -- This would be bad!+ --+ -- With 'unsafeIndex', we can do+ --+ -- > copy mv v ... = ... unsafeIndex v i (unsafeWrite mv i) ...+ --+ -- which does not have this problem.+ --+ unsafeIndex :: v a -> Int -> (a -> b) -> b++-- Fusion+-- ------++-- | Construct a pure vector from a monadic initialiser +new :: IVector v a => Mut a -> v a+{-# INLINE_STREAM new #-}+new m = vnew (Mut.run m)++-- | Convert a vector to a 'Stream'+stream :: IVector v a => v a -> Stream a+{-# INLINE_STREAM stream #-}+stream v = v `seq` (Stream.unfold get 0 `Stream.sized` Exact n)+ where+ n = length v++ {-# INLINE get #-}+ get i | i < n = unsafeIndex v i $ \x -> Just (x, i+1)+ | otherwise = Nothing++-- | Create a vector from a 'Stream'+unstream :: IVector v a => Stream a -> v a+{-# INLINE unstream #-}+unstream s = new (Mut.unstream s)++{-# RULES++"stream/unstream [IVector]" forall s.+ stream (new (Mut.unstream s)) = s++"Mut.unstream/stream/new [IVector]" forall p.+ Mut.unstream (stream (new p)) = p++ #-}++-- Length+-- ------++length :: IVector v a => v a -> Int+{-# INLINE_STREAM length #-}+length v = vlength v++{-# RULES++"length/unstream [IVector]" forall s.+ length (new (Mut.unstream s)) = Stream.length s++ #-}++-- Construction+-- ------------++-- | Empty vector+empty :: IVector v a => v a+{-# INLINE empty #-}+empty = unstream Stream.empty++-- | Vector with exaclty one element+singleton :: IVector v a => a -> v a+{-# INLINE singleton #-}+singleton x = unstream (Stream.singleton x)++-- | Vector of the given length with the given value in each position+replicate :: IVector v a => Int -> a -> v a+{-# INLINE replicate #-}+replicate n = unstream . Stream.replicate n++-- | Prepend an element+cons :: IVector v a => a -> v a -> v a+{-# INLINE cons #-}+cons x = unstream . Stream.cons x . stream++-- | Append an element+snoc :: IVector v a => v a -> a -> v a+{-# INLINE snoc #-}+snoc v = unstream . Stream.snoc (stream v)++infixr 5 +++-- | Concatenate two vectors+(++) :: IVector v a => v a -> v a -> v a+{-# INLINE (++) #-}+v ++ w = unstream (stream v Stream.++ stream w)++-- Accessing individual elements+-- -----------------------------++-- | Indexing+(!) :: IVector v a => v a -> Int -> a+{-# INLINE_STREAM (!) #-}+v ! i = assert (i >= 0 && i < length v)+ $ unsafeIndex v i id++-- | First element+head :: IVector v a => v a -> a+{-# INLINE_STREAM head #-}+head v = v ! 0++-- | Last element+last :: IVector v a => v a -> a+{-# INLINE_STREAM last #-}+last v = v ! (length v - 1)++{-# RULES++"(!)/unstream [IVector]" forall i s.+ new (Mut.unstream s) ! i = s Stream.!! i++"head/unstream [IVector]" forall s.+ head (new (Mut.unstream s)) = Stream.head s++"last/unstream [IVector]" forall s.+ last (new (Mut.unstream s)) = Stream.last s++ #-}++-- Subarrays+-- ---------++-- | Yield a part of the vector without copying it. Safer version of+-- 'unsafeSlice'.+slice :: IVector v a => v a -> Int -- ^ starting index+ -> Int -- ^ length+ -> v a+{-# INLINE slice #-}+slice v i n = assert (i >= 0 && n >= 0 && i+n <= length v)+ $ unsafeSlice v i n++-- | Copy @n@ elements starting at the given position to a new vector.+extract :: IVector v a => v a -> Int -- ^ starting index+ -> Int -- ^ length+ -> v a+{-# INLINE extract #-}+extract v i n = unstream (Stream.extract (stream v) i n)++-- | Yield the first @n@ elements without copying.+takeSlice :: IVector v a => Int -> v a -> v a+{-# INLINE takeSlice #-}+takeSlice n v = slice v 0 n++-- | Copy the first @n@ elements to a new vector.+take :: IVector v a => Int -> v a -> v a+{-# INLINE take #-}+take n = unstream . Stream.take n . stream++-- | Yield all but the first @n@ elements without copying.+dropSlice :: IVector v a => Int -> v a -> v a+{-# INLINE dropSlice #-}+dropSlice n v = slice v n (length v - n)++-- | Copy all but the first @n@ elements to a new vectors.+drop :: IVector v a => Int -> v a -> v a+{-# INLINE drop #-}+drop n = unstream . Stream.drop n . stream++{-# RULES++"slice/extract [IVector]" forall i n s.+ slice (new (Mut.unstream s)) i n = extract (new (Mut.unstream s)) i n++"takeSlice/unstream [IVector]" forall n s.+ takeSlice n (new (Mut.unstream s)) = take n (new (Mut.unstream s))++"dropSlice/unstream [IVector]" forall n s.+ dropSlice n (new (Mut.unstream s)) = drop n (new (Mut.unstream s))++ #-}++-- Permutations+-- ------------++(//) :: IVector v a => v a -> [(Int, a)] -> v a+{-# INLINE (//) #-}+v // us = new (Mut.update (Mut.unstream (stream v))+ (Stream.fromList us))++-- Mapping/zipping+-- ---------------++-- | Map a function over a vector+map :: (IVector v a, IVector v b) => (a -> b) -> v a -> v b+{-# INLINE map #-}+map f = unstream . Stream.map f . stream++{-# RULES++"in-place map [IVector]" forall f m.+ Mut.unstream (Stream.map f (stream (new m))) = Mut.map f m++ #-}++-- | Zip two vectors with the given function.+zipWith :: (IVector v a, IVector v b, IVector v c) => (a -> b -> c) -> v a -> v b -> v c+{-# INLINE zipWith #-}+zipWith f xs ys = unstream (Stream.zipWith f (stream xs) (stream ys))++-- Comparisons+-- -----------++eq :: (IVector v a, Eq a) => v a -> v a -> Bool+{-# INLINE eq #-}+xs `eq` ys = stream xs == stream ys++cmp :: (IVector v a, Ord a) => v a -> v a -> Ordering+{-# INLINE cmp #-}+cmp xs ys = compare (stream xs) (stream ys)++-- Filtering+-- ---------++-- | Drop elements which do not satisfy the predicate+filter :: IVector v a => (a -> Bool) -> v a -> v a+{-# INLINE filter #-}+filter f = unstream . Stream.filter f . stream++-- | Yield the longest prefix of elements satisfying the predicate without+-- copying.+takeWhileSlice :: IVector v a => (a -> Bool) -> v a -> v a+{-# INLINE takeWhileSlice #-}+takeWhileSlice f v = case findIndex (not . f) v of+ Just n -> takeSlice n v+ Nothing -> v++-- | Copy the longest prefix of elements satisfying the predicate to a new+-- vector+takeWhile :: IVector v a => (a -> Bool) -> v a -> v a+{-# INLINE takeWhile #-}+takeWhile f = unstream . Stream.takeWhile f . stream++-- | Drop the longest prefix of elements that satisfy the predicate without+-- copying+dropWhileSlice :: IVector v a => (a -> Bool) -> v a -> v a+{-# INLINE dropWhileSlice #-}+dropWhileSlice f v = case findIndex (not . f) v of+ Just n -> dropSlice n v+ Nothing -> v++-- | Drop the longest prefix of elements that satisfy the predicate and copy+-- the rest to a new vector.+dropWhile :: IVector v a => (a -> Bool) -> v a -> v a+{-# INLINE dropWhile #-}+dropWhile f = unstream . Stream.dropWhile f . stream++{-# RULES++"takeWhileSlice/unstream" forall f s.+ takeWhileSlice f (new (Mut.unstream s)) = takeWhile f (new (Mut.unstream s))++"dropWhileSlice/unstream" forall f s.+ dropWhileSlice f (new (Mut.unstream s)) = dropWhile f (new (Mut.unstream s))++ #-}++-- Searching+-- ---------++infix 4 `elem`+-- | Check whether the vector contains an element+elem :: (IVector v a, Eq a) => a -> v a -> Bool+{-# INLINE elem #-}+elem x = Stream.elem x . stream++infix 4 `notElem`+-- | Inverse of `elem`+notElem :: (IVector v a, Eq a) => a -> v a -> Bool+{-# INLINE notElem #-}+notElem x = Stream.notElem x . stream++-- | Yield 'Just' the first element matching the predicate or 'Nothing' if no+-- such element exists.+find :: IVector v a => (a -> Bool) -> v a -> Maybe a+{-# INLINE find #-}+find f = Stream.find f . stream++-- | Yield 'Just' the index of the first element matching the predicate or+-- 'Nothing' if no such element exists.+findIndex :: IVector v a => (a -> Bool) -> v a -> Maybe Int+{-# INLINE findIndex #-}+findIndex f = Stream.findIndex f . stream++-- Folding+-- -------++-- | Left fold+foldl :: IVector v b => (a -> b -> a) -> a -> v b -> a+{-# INLINE foldl #-}+foldl f z = Stream.foldl f z . stream++-- | Lefgt fold on non-empty vectors+foldl1 :: IVector v a => (a -> a -> a) -> v a -> a+{-# INLINE foldl1 #-}+foldl1 f = Stream.foldl1 f . stream++-- | Left fold with strict accumulator+foldl' :: IVector v b => (a -> b -> a) -> a -> v b -> a+{-# INLINE foldl' #-}+foldl' f z = Stream.foldl' f z . stream++-- | Left fold on non-empty vectors with strict accumulator+foldl1' :: IVector v a => (a -> a -> a) -> v a -> a+{-# INLINE foldl1' #-}+foldl1' f = Stream.foldl1' f . stream++-- | Right fold+foldr :: IVector v a => (a -> b -> b) -> b -> v a -> b+{-# INLINE foldr #-}+foldr f z = Stream.foldr f z . stream++-- | Right fold on non-empty vectors+foldr1 :: IVector v a => (a -> a -> a) -> v a -> a+{-# INLINE foldr1 #-}+foldr1 f = Stream.foldr1 f . stream++-- | Convert a vector to a list+toList :: IVector v a => v a -> [a]+{-# INLINE toList #-}+toList = Stream.toList . stream++-- | Convert a list to a vector+fromList :: IVector v a => [a] -> v a+{-# INLINE fromList #-}+fromList = unstream . Stream.fromList+
+ Data/Vector/MVector.hs view
@@ -0,0 +1,236 @@+{-# LANGUAGE MultiParamTypeClasses #-}+-- |+-- Module : Data.Vector.MVector+-- Copyright : (c) Roman Leshchinskiy 2008+-- License : BSD-style+--+-- Maintainer : rl@cse.unsw.edu.au+-- Stability : experimental+-- Portability : non-portable+-- +-- Generic interface to mutable vectors+--++#include "phases.h"++module Data.Vector.MVector (+ MVectorPure(..), MVector(..),++ slice, new, newWith, read, write, copy, grow, unstream, update, reverse, map+) where++import qualified Data.Vector.Stream as Stream+import Data.Vector.Stream ( Stream )+import Data.Vector.Stream.Size++import Control.Monad.ST ( ST )+import Control.Exception ( assert )++import GHC.Float (+ double2Int, int2Double+ )++import Prelude hiding ( length, reverse, map, read )++gROWTH_FACTOR :: Double+gROWTH_FACTOR = 1.5++-- | Basic pure functions on mutable vectors+class MVectorPure v a where+ -- | Length of the mutable vector+ length :: v a -> Int++ -- | Yield a part of the mutable vector without copying it. No range checks!+ unsafeSlice :: v a -> Int -- ^ starting index+ -> Int -- ^ length of the slice+ -> v a++ -- Check whether two vectors overlap.+ overlaps :: v a -> v a -> Bool++-- | Class of mutable vectors. The type @m@ is the monad in which the mutable+-- vector can be transformed and @a@ is the type of elements.+--+class (Monad m, MVectorPure v a) => MVector v m a where+ -- | Create a mutable vector of the given length. Length is not checked!+ unsafeNew :: Int -> m (v a)++ -- | Create a mutable vector of the given length and fill it with an+ -- initial value. Length is not checked!+ unsafeNewWith :: Int -> a -> m (v a)++ -- | Yield the element at the given position. Index is not checked!+ unsafeRead :: v a -> Int -> m a++ -- | Replace the element at the given position. Index is not checked!+ unsafeWrite :: v a -> Int -> a -> m ()++ -- | Clear all references to external objects+ clear :: v a -> m ()++ -- | Write the value at each position.+ set :: v a -> a -> m ()++ -- | Copy a vector. The two vectors may not overlap. This is not checked!+ unsafeCopy :: v a -- ^ target+ -> v a -- ^ source+ -> m ()++ -- | Grow a vector by the given number of elements. The length is not+ -- checked!+ unsafeGrow :: v a -> Int -> m (v a)++ {-# INLINE unsafeNewWith #-}+ unsafeNewWith n x = do+ v <- unsafeNew n+ set v x+ return v++ {-# INLINE set #-}+ set v x = do_set 0+ where+ n = length v++ do_set i | i < n = do+ unsafeWrite v i x+ do_set (i+1)+ | otherwise = return ()++ {-# INLINE unsafeCopy #-}+ unsafeCopy dst src = do_copy 0+ where+ n = length src++ do_copy i | i < n = do+ x <- unsafeRead src i+ unsafeWrite dst i x+ do_copy (i+1)+ | otherwise = return ()++ {-# INLINE unsafeGrow #-}+ unsafeGrow v by = do+ v' <- unsafeNew (n+by)+ unsafeCopy (unsafeSlice v' 0 n) v+ return v'+ where+ n = length v++-- | Test whether the index is valid for the vector+inBounds :: MVectorPure v a => v a -> Int -> Bool+{-# INLINE inBounds #-}+inBounds v i = i >= 0 && i < length v++-- | Yield a part of the mutable vector without copying it. Safer version of+-- 'unsafeSlice'.+slice :: MVectorPure v a => v a -> Int -> Int -> v a+{-# INLINE slice #-}+slice v i n = assert (i >=0 && n >= 0 && i+n <= length v)+ $ unsafeSlice v i n++-- | Create a mutable vector of the given length. Safer version of+-- 'unsafeNew'.+new :: MVector v m a => Int -> m (v a)+{-# INLINE new #-}+new n = assert (n >= 0) $ unsafeNew n++-- | Create a mutable vector of the given length and fill it with an+-- initial value. Safer version of 'unsafeNewWith'.+newWith :: MVector v m a => Int -> a -> m (v a)+{-# INLINE newWith #-}+newWith n x = assert (n >= 0) $ unsafeNewWith n x++-- | Yield the element at the given position. Safer version of 'unsafeRead'.+read :: MVector v m a => v a -> Int -> m a+{-# INLINE read #-}+read v i = assert (inBounds v i) $ unsafeRead v i++-- | Replace the element at the given position. Safer version of+-- 'unsafeWrite'.+write :: MVector v m a => v a -> Int -> a -> m ()+{-# INLINE write #-}+write v i x = assert (inBounds v i) $ unsafeWrite v i x++-- | Copy a vector. The two vectors may not overlap. Safer version of+-- 'unsafeCopy'.+copy :: MVector v m a => v a -> v a -> m ()+{-# INLINE copy #-}+copy dst src = assert (not (dst `overlaps` src) && length dst == length src)+ $ unsafeCopy dst src++-- | Grow a vector by the given number of elements. Safer version of+-- 'unsafeGrow'.+grow :: MVector v m a => v a -> Int -> m (v a)+{-# INLINE grow #-}+grow v by = assert (by >= 0)+ $ unsafeGrow v by+++-- | Create a new mutable vector and fill it with elements from the 'Stream'.+-- The vector will grow logarithmically if the 'Size' hint of the 'Stream' is+-- inexact.+unstream :: MVector v m a => Stream a -> m (v a)+{-# INLINE_STREAM unstream #-}+unstream s = case upperBound (Stream.size s) of+ Just n -> unstreamMax s n+ Nothing -> unstreamUnknown s++unstreamMax :: MVector v m a => Stream a -> Int -> m (v a)+{-# INLINE unstreamMax #-}+unstreamMax s n+ = do+ v <- new n+ let put i x = do { write v i x; return (i+1) }+ n' <- Stream.foldM put 0 s+ return $ slice v 0 n'++unstreamUnknown :: MVector v m a => Stream a -> m (v a)+{-# INLINE unstreamUnknown #-}+unstreamUnknown s+ = do+ v <- new 0+ (v', n) <- Stream.foldM put (v, 0) s+ return $ slice v' 0 n+ where+ {-# INLINE put #-}+ put (v, i) x = do+ v' <- enlarge v i+ unsafeWrite v' i x+ return (v', i+1)++ {-# INLINE enlarge #-}+ enlarge v i | i < length v = return v+ | otherwise = unsafeGrow v+ . max 1+ . double2Int+ $ int2Double (length v) * gROWTH_FACTOR++update :: MVector v m a => v a -> Stream (Int, a) -> m ()+{-# INLINE update #-}+update v s = Stream.mapM_ put s+ where+ {-# INLINE put #-}+ put (i, x) = write v i x++reverse :: MVector v m a => v a -> m ()+{-# INLINE reverse #-}+reverse v = reverse_loop 0 (length v - 1)+ where+ reverse_loop i j | i < j = do+ x <- unsafeRead v i+ y <- unsafeRead v j+ unsafeWrite v i y+ unsafeWrite v j x+ reverse_loop _ _ = return ()+++map :: MVector v m a => (a -> a) -> v a -> m ()+{-# INLINE map #-}+map f v = map_loop 0+ where+ n = length v++ map_loop i | i <= n = do+ x <- read v i+ write v i (f x)+ | otherwise = return ()+
+ Data/Vector/MVector/Mut.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE Rank2Types #-}++#include "phases.h"++module Data.Vector.MVector.Mut (+ Mut(..), run, unstream, update, reverse, map+) where++import qualified Data.Vector.MVector as MVector+import Data.Vector.MVector ( MVector )++import Data.Vector.Stream ( Stream )++import Prelude hiding ( reverse, map )++data Mut a = Mut (forall m mv. MVector mv m a => m (mv a))++run :: MVector mv m a => Mut a -> m (mv a)+{-# INLINE run #-}+run (Mut p) = p++trans :: Mut a -> (forall m mv. MVector mv m a => mv a -> m ()) -> Mut a+{-# INLINE trans #-}+trans (Mut p) q = Mut (do { v <- p; q v; return v })++unstream :: Stream a -> Mut a+{-# INLINE_STREAM unstream #-}+unstream s = Mut (MVector.unstream s)++update :: Mut a -> Stream (Int, a) -> Mut a+{-# INLINE_STREAM update #-}+update m s = trans m (\v -> MVector.update v s)++reverse :: Mut a -> Mut a+{-# INLINE_STREAM reverse #-}+reverse m = trans m (MVector.reverse)++map :: (a -> a) -> Mut a -> Mut a+{-# INLINE_STREAM map #-}+map f m = trans m (MVector.map f)+
+ Data/Vector/Mutable.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances #-}++-- |+-- Module : Data.Vector.Mutable+-- Copyright : (c) Roman Leshchinskiy 2008+-- License : BSD-style+--+-- Maintainer : rl@cse.unsw.edu.au+-- Stability : experimental+-- Portability : non-portable+-- +-- Mutable boxed vectors.+--++module Data.Vector.Mutable ( Vector(..) )+where++import qualified Data.Vector.MVector as MVector+import Data.Vector.MVector ( MVector, MVectorPure )++import GHC.Prim ( MutableArray#,+ newArray#, readArray#, writeArray#, sameMutableArray#, (+#) )++import GHC.ST ( ST(..) )++import GHC.Base ( Int(..) )++-- | Mutable boxed vectors. They live in the 'ST' monad.+data Vector s a = Vector {-# UNPACK #-} !Int+ {-# UNPACK #-} !Int+ (MutableArray# s a)++instance MVectorPure (Vector s) a where+ length (Vector _ n _) = n+ unsafeSlice (Vector i _ arr#) j m = Vector (i+j) m arr#++ {-# INLINE overlaps #-}+ overlaps (Vector i m arr1#) (Vector j n arr2#)+ = sameMutableArray# arr1# arr2#+ && (between i j (j+n) || between j i (i+m))+ where+ between x y z = x >= y && x < z+++instance MVector (Vector s) (ST s) a where+ {-# INLINE unsafeNew #-}+ unsafeNew = unsafeNew++ {-# INLINE unsafeNewWith #-}+ unsafeNewWith = unsafeNewWith++ {-# INLINE unsafeRead #-}+ unsafeRead (Vector (I# i#) _ arr#) (I# j#) = ST (readArray# arr# (i# +# j#))++ {-# INLINE unsafeWrite #-}+ unsafeWrite (Vector (I# i#) _ arr#) (I# j#) x = ST (\s# ->+ case writeArray# arr# (i# +# j#) x s# of s2# -> (# s2#, () #)+ )++ {-# INLINE clear #-}+ clear v = MVector.set v uninitialised+++uninitialised :: a+uninitialised = error "Data.Vector.Mutable: uninitialised elemen t"++unsafeNew :: Int -> ST s (Vector s a)+{-# INLINE unsafeNew #-}+unsafeNew n = unsafeNewWith n uninitialised++unsafeNewWith :: Int -> a -> ST s (Vector s a)+{-# INLINE unsafeNewWith #-}+unsafeNewWith (I# n#) x = ST (\s# ->+ case newArray# n# x s# of+ (# s2#, arr# #) -> (# s2#, Vector 0 (I# n#) arr# #)+ )+
+ Data/Vector/Stream.hs view
@@ -0,0 +1,543 @@+{-# LANGUAGE ExistentialQuantification #-}++-- |+-- Module : Data.Vector.Stream.Size+-- Copyright : (c) Roman Leshchinskiy 2008+-- License : BSD-style+--+-- Maintainer : rl@cse.unsw.edu.au+-- Stability : experimental+-- Portability : non-portable+-- +-- Fusible streams+--++#include "phases.h"++module Data.Vector.Stream (+ -- * Types+ Step(..), Stream(..),++ -- * Size hints+ size, sized,++ -- * Length information+ length, null,++ -- * Construction+ empty, singleton, cons, snoc, replicate, (++),++ -- * Accessing individual elements+ head, last, (!!),++ -- * Substreams+ extract, init, tail, take, drop,++ -- * Mapping and zipping+ map, zipWith,++ -- * Filtering+ filter, takeWhile, dropWhile,++ -- * Searching+ elem, notElem, find, findIndex,++ -- * Folding+ foldl, foldl1, foldl', foldl1', foldr, foldr1,++ -- * Unfolding+ unfold,++ -- * Conversion to/from lists+ toList, fromList,++ -- * Monadic combinators+ mapM_, foldM+) where++import Data.Vector.Stream.Size++import Prelude hiding ( length, null,+ replicate, (++),+ head, last, (!!),+ init, tail, take, drop,+ map, zipWith,+ filter, takeWhile, dropWhile,+ elem, notElem,+ foldl, foldl1, foldr, foldr1,+ mapM_ )++data Step s a = Yield a s+ | Skip s+ | Done++-- | The type of fusible streams+data Stream a = forall s. Stream (s -> Step s a) s Size++-- | 'Size' hint of a 'Stream'+size :: Stream a -> Size+{-# INLINE size #-}+size (Stream _ _ sz) = sz++-- | Attach a 'Size' hint to a 'Stream'+sized :: Stream a -> Size -> Stream a+{-# INLINE_STREAM sized #-}+sized (Stream step s _) sz = Stream step s sz++-- | Unfold+unfold :: (s -> Maybe (a, s)) -> s -> Stream a+{-# INLINE_STREAM unfold #-}+unfold f s = Stream step s Unknown+ where+ {-# INLINE step #-}+ step s = case f s of+ Just (x, s') -> Yield x s'+ Nothing -> Done++-- | Convert a 'Stream' to a list+toList :: Stream a -> [a]+{-# INLINE toList #-}+toList s = foldr (:) [] s++-- | Create a 'Stream' from a list+fromList :: [a] -> Stream a+{-# INLINE_STREAM fromList #-}+fromList xs = Stream step xs Unknown+ where+ step (x:xs) = Yield x xs+ step [] = Done++-- Length+-- ------++-- | Length of a 'Stream'+length :: Stream a -> Int+{-# INLINE_STREAM length #-}+length s = foldl' (\n _ -> n+1) 0 s++-- | Check if a 'Stream' is empty+null :: Stream a -> Bool+{-# INLINE_STREAM null #-}+null s = foldr (\_ _ -> False) True s++-- Construction+-- ------------++-- | Empty 'Stream'+empty :: Stream a+{-# INLINE_STREAM empty #-}+empty = Stream (const Done) () (Exact 0)++-- | Singleton 'Stream'+singleton :: a -> Stream a+{-# INLINE_STREAM singleton #-}+singleton x = Stream step True (Exact 1)+ where+ {-# INLINE step #-}+ step True = Yield x False+ step False = Done++-- | Replicate a value to a given length+replicate :: Int -> a -> Stream a+{-# INLINE_STREAM replicate #-}+replicate n x = Stream step n (Exact (max n 0))+ where+ {-# INLINE step #-}+ step i | i > 0 = Yield x (i-1)+ | otherwise = Done++-- | Prepend an element+cons :: a -> Stream a -> Stream a+{-# INLINE cons #-}+cons x s = singleton x ++ s++-- | Append an element+snoc :: Stream a -> a -> Stream a+{-# INLINE snoc #-}+snoc s x = s ++ singleton x++infixr 5 +++-- | Concatenate two 'Stream's+(++) :: Stream a -> Stream a -> Stream a+{-# INLINE_STREAM (++) #-}+Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)+ where+ step (Left sa) = case stepa sa of+ Yield x sa' -> Yield x (Left sa')+ Skip sa' -> Skip (Left sa')+ Done -> Skip (Right sb)+ step (Right sb) = case stepb sb of+ Yield x sb' -> Yield x (Right sb')+ Skip sb' -> Skip (Right sb')+ Done -> Done++-- Accessing elements+-- ------------------++-- | First element of the 'Stream' or error if empty+head :: Stream a -> a+{-# INLINE_STREAM head #-}+head (Stream step s _) = head_loop s+ where+ head_loop s = case step s of+ Yield x _ -> x+ Skip s' -> head_loop s'+ Done -> error "Data.Vector.Stream.head: empty stream"++-- | Last element of the 'Stream' or error if empty+last :: Stream a -> a+{-# INLINE_STREAM last #-}+last (Stream step s _) = last_loop0 s+ where+ last_loop0 s = case step s of+ Yield x s' -> last_loop1 x s'+ Skip s' -> last_loop0 s'+ Done -> error "Data.Vector.Stream.last: empty stream"++ last_loop1 x s = case step s of+ Yield y s' -> last_loop1 y s'+ Skip s' -> last_loop1 x s'+ Done -> x++-- | Element at the given position+(!!) :: Stream a -> Int -> a+{-# INLINE (!!) #-}+s !! i = head (drop i s)++-- Substreams+-- ----------++-- | Extract a substream of the given length starting at the given position.+extract :: Stream a -> Int -- ^ starting index+ -> Int -- ^ length+ -> Stream a+{-# INLINE extract #-}+extract s i n = take n (drop i s)++-- | All but the last element+init :: Stream a -> Stream a+{-# INLINE_STREAM init #-}+init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1)+ where+ {-# INLINE step' #-}+ step' (Nothing, s) = case step s of+ Yield x s' -> Skip (Just x, s')+ Skip s' -> Skip (Nothing, s')+ Done -> Done -- FIXME: should be an error++ step' (Just x, s) = case step s of+ Yield y s' -> Yield x (Just y, s')+ Skip s' -> Skip (Just x, s')+ Done -> Done++-- | All but the first element+tail :: Stream a -> Stream a+{-# INLINE_STREAM tail #-}+tail (Stream step s sz) = Stream step' (Left s) (sz - 1)+ where+ {-# INLINE step' #-}+ step' (Left s) = case step s of+ Yield x s' -> Skip (Right s')+ Skip s' -> Skip (Left s')+ Done -> Done -- FIXME: should be error?++ step' (Right s) = case step s of+ Yield x s' -> Yield x (Right s')+ Skip s' -> Skip (Right s')+ Done -> Done++-- | The first @n@ elements+take :: Int -> Stream a -> Stream a+{-# INLINE_STREAM take #-}+take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz)+ where+ {-# INLINE step' #-}+ step' (s, i) | i < n = case step s of+ Yield x s' -> Yield x (s', i+1)+ Skip s' -> Skip (s', i)+ Done -> Done+ step' (s, i) = Done++data Drop s = Drop_Drop s Int | Drop_Keep s++-- | All but the first @n@ elements+drop :: Int -> Stream a -> Stream a+{-# INLINE_STREAM drop #-}+drop n (Stream step s sz) = Stream step' (Drop_Drop s 0) (sz - Exact n)+ where+ {-# INLINE step' #-}+ step' (Drop_Drop s i) | i < n = case step s of+ Yield x s' -> Skip (Drop_Drop s' (i+1))+ Skip s' -> Skip (Drop_Drop s' i)+ Done -> Done+ | otherwise = Skip (Drop_Keep s)++ step' (Drop_Keep s) = case step s of+ Yield x s' -> Yield x (Drop_Keep s')+ Skip s' -> Skip (Drop_Keep s')+ Done -> Done+ ++-- Mapping/zipping+-- ---------------++instance Functor Stream where+ {-# INLINE_STREAM fmap #-}+ fmap = map++-- | Map a function over a 'Stream'+map :: (a -> b) -> Stream a -> Stream b+{-# INLINE_STREAM map #-}+map f (Stream step s n) = Stream step' s n+ where+ {-# INLINE step' #-}+ step' s = case step s of+ Yield x s' -> Yield (f x) s'+ Skip s' -> Skip s'+ Done -> Done++-- | Zip two 'Stream's with the given function+zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c+{-# INLINE_STREAM zipWith #-}+zipWith f (Stream stepa sa na) (Stream stepb sb nb)+ = Stream step (sa, sb, Nothing) (smaller na nb)+ where+ {-# INLINE step #-}+ step (sa, sb, Nothing) = case stepa sa of+ Yield x sa' -> Skip (sa', sb, Just x)+ Skip sa' -> Skip (sa', sb, Nothing)+ Done -> Done++ step (sa, sb, Just x) = case stepb sb of+ Yield y sb' -> Yield (f x y) (sa, sb', Nothing)+ Skip sb' -> Skip (sa, sb', Just x)+ Done -> Done++-- Filtering+-- ---------++-- | Drop elements which do not satisfy the predicate+filter :: (a -> Bool) -> Stream a -> Stream a+{-# INLINE_STREAM filter #-}+filter f (Stream step s n) = Stream step' s (toMax n)+ where+ {-# INLINE step' #-}+ step' s = case step s of+ Yield x s' | f x -> Yield x s'+ | otherwise -> Skip s'+ Skip s' -> Skip s'+ Done -> Done++-- | Longest prefix of elements that satisfy the predicate+takeWhile :: (a -> Bool) -> Stream a -> Stream a+{-# INLINE_STREAM takeWhile #-}+takeWhile f (Stream step s n) = Stream step' s (toMax n)+ where+ {-# INLINE step' #-}+ step' s = case step s of+ Yield x s' | f x -> Yield x s'+ | otherwise -> Done+ Skip s' -> Skip s'+ Done -> Done+++data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s++-- | Drop the longest prefix of elements that satisfy the predicate+dropWhile :: (a -> Bool) -> Stream a -> Stream a+{-# INLINE_STREAM dropWhile #-}+dropWhile f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n)+ where+ -- NOTE: we jump through hoops here to have only one Yield; local data+ -- declarations would be nice!++ {-# INLINE step' #-}+ step' (DropWhile_Drop s)+ = case step s of+ Yield x s' | f x -> Skip (DropWhile_Drop s')+ | otherwise -> Skip (DropWhile_Yield x s')+ Skip s' -> Skip (DropWhile_Drop s')+ Done -> Done++ step' (DropWhile_Yield x s) = Yield x (DropWhile_Next s)++ step' (DropWhile_Next s) = case step s of+ Yield x s' -> Skip (DropWhile_Yield x s')+ Skip s' -> Skip (DropWhile_Next s')+ Done -> Done++-- Searching+-- ---------++infix 4 `elem`+-- | Check whether the 'Stream' contains an element+elem :: Eq a => a -> Stream a -> Bool+{-# INLINE_STREAM elem #-}+elem x (Stream step s _) = elem_loop s+ where+ elem_loop s = case step s of+ Yield y s' | x == y -> True+ | otherwise -> elem_loop s'+ Skip s' -> elem_loop s'+ Done -> False++infix 4 `notElem`+-- | Inverse of `elem`+notElem :: Eq a => a -> Stream a -> Bool+{-# INLINE notElem #-}+notElem x = not . elem x++-- | Yield 'Just' the first element matching the predicate or 'Nothing' if no+-- such element exists.+find :: (a -> Bool) -> Stream a -> Maybe a+{-# INLINE_STREAM find #-}+find f (Stream step s _) = find_loop s+ where+ find_loop s = case step s of+ Yield x s' | f x -> Just x+ | otherwise -> find_loop s'+ Skip s' -> find_loop s'+ Done -> Nothing++-- | Yield 'Just' the index of the first element matching the predicate or+-- 'Nothing' if no such element exists.+findIndex :: (a -> Bool) -> Stream a -> Maybe Int+{-# INLINE_STREAM findIndex #-}+findIndex f (Stream step s _) = findIndex_loop s 0+ where+ findIndex_loop s i = case step s of+ Yield x s' | f x -> Just i+ | otherwise -> findIndex_loop s' (i+1)+ Skip s' -> findIndex_loop s' i+ Done -> Nothing++-- Folding+-- -------++-- | Left fold+foldl :: (a -> b -> a) -> a -> Stream b -> a+{-# INLINE_STREAM foldl #-}+foldl f z (Stream step s _) = foldl_go z s+ where+ foldl_go z s = case step s of+ Yield x s' -> foldl_go (f z x) s'+ Skip s' -> foldl_go z s'+ Done -> z++-- | Left fold on non-empty 'Stream's+foldl1 :: (a -> a -> a) -> Stream a -> a+{-# INLINE_STREAM foldl1 #-}+foldl1 f (Stream step s sz) = foldl1_loop s+ where+ foldl1_loop s = case step s of+ Yield x s' -> foldl f x (Stream step s' (sz - 1))+ Skip s' -> foldl1_loop s'+ Done -> error "Data.Vector.Stream.foldl1: empty stream"++-- | Left fold with strict accumulator+foldl' :: (a -> b -> a) -> a -> Stream b -> a+{-# INLINE_STREAM foldl' #-}+foldl' f z (Stream step s _) = foldl_go z s+ where+ foldl_go z s = z `seq`+ case step s of+ Yield x s' -> foldl_go (f z x) s'+ Skip s' -> foldl_go z s'+ Done -> z++-- | Left fold on non-empty 'Stream's with strict accumulator+foldl1' :: (a -> a -> a) -> Stream a -> a+{-# INLINE_STREAM foldl1' #-}+foldl1' f (Stream step s sz) = foldl1'_loop s+ where+ foldl1'_loop s = case step s of+ Yield x s' -> foldl' f x (Stream step s' (sz - 1))+ Skip s' -> foldl1'_loop s'+ Done -> error "Data.Vector.Stream.foldl1': empty stream"++-- | Right fold+foldr :: (a -> b -> b) -> b -> Stream a -> b+{-# INLINE_STREAM foldr #-}+foldr f z (Stream step s _) = foldr_go s+ where+ foldr_go s = case step s of+ Yield x s' -> f x (foldr_go s')+ Skip s' -> foldr_go s'+ Done -> z++-- | Right fold on non-empty 'Stream's+foldr1 :: (a -> a -> a) -> Stream a -> a+{-# INLINE_STREAM foldr1 #-}+foldr1 f (Stream step s sz) = foldr1_loop s+ where+ foldr1_loop s = case step s of+ Yield x s' -> foldr f x (Stream step s' (sz - 1))+ Skip s' -> foldr1_loop s'+ Done -> error "Data.Vector.Stream.foldr1: empty stream"++-- Comparisons+-- -----------++eq :: Eq a => Stream a -> Stream a -> Bool+{-# INLINE_STREAM eq #-}+eq (Stream step1 s1 _) (Stream step2 s2 _) = eq_loop0 s1 s2+ where+ eq_loop0 s1 s2 = case step1 s1 of+ Yield x s1' -> eq_loop1 x s1' s2+ Skip s1' -> eq_loop0 s1' s2+ Done -> null (Stream step2 s2 Unknown)++ eq_loop1 x s1 s2 = case step2 s2 of+ Yield y s2' -> x == y && eq_loop0 s1 s2'+ Skip s2' -> eq_loop1 x s1 s2'+ Done -> False++cmp :: Ord a => Stream a -> Stream a -> Ordering+{-# INLINE_STREAM cmp #-}+cmp (Stream step1 s1 _) (Stream step2 s2 _) = cmp_loop0 s1 s2+ where+ cmp_loop0 s1 s2 = case step1 s1 of+ Yield x s1' -> cmp_loop1 x s1' s2+ Skip s1' -> cmp_loop0 s1' s2+ Done -> if null (Stream step2 s2 Unknown)+ then EQ else LT++ cmp_loop1 x s1 s2 = case step2 s2 of+ Yield y s2' -> case x `compare` y of+ EQ -> cmp_loop0 s1 s2'+ c -> c+ Skip s2' -> cmp_loop1 x s1 s2'+ Done -> GT++instance Eq a => Eq (Stream a) where+ {-# INLINE (==) #-}+ (==) = eq++instance Ord a => Ord (Stream a) where+ {-# INLINE compare #-}+ compare = cmp++-- Monadic combinators+-- -------------------++-- | Apply a monadic action to each element of the stream+mapM_ :: Monad m => (a -> m ()) -> Stream a -> m ()+{-# INLINE_STREAM mapM_ #-}+mapM_ m (Stream step s _) = mapM_go s+ where+ mapM_go s = case step s of+ Yield x s' -> do { m x; mapM_go s' }+ Skip s' -> mapM_go s'+ Done -> return ()++-- | Monadic fold+foldM :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a+{-# INLINE_STREAM foldM #-}+foldM m z (Stream step s _) = foldM_go z s+ where+ foldM_go z s = case step s of+ Yield x s' -> do { z' <- m z x; foldM_go z' s' }+ Skip s' -> foldM_go z s'+ Done -> return z++
+ Data/Vector/Stream/Size.hs view
@@ -0,0 +1,83 @@+-- |+-- Module : Data.Vector.Stream.Size+-- Copyright : (c) Roman Leshchinskiy 2008+-- License : BSD-style+--+-- Maintainer : rl@cse.unsw.edu.au+-- Stability : experimental+-- Portability : portable+-- +-- Size hints+--++module Data.Vector.Stream.Size (+ Size(..), smaller, larger, toMax, upperBound+) where++-- | Size hint+data Size = Exact Int -- ^ Exact size+ | Max Int -- ^ Upper bound on the size+ | Unknown -- ^ Unknown size+ deriving( Eq, Show )++instance Num Size where+ Exact m + Exact n = Exact (m+n)+ Exact m + Max n = Max (m+n)++ Max m + Exact n = Max (m+n)+ Max m + Max n = Max (m+n)++ _ + _ = Unknown+++ Exact m - Exact n = Exact (m-n)+ Exact m - Max n = Max m++ Max m - Exact n = Max (m-n)+ Max m - Max n = Max m+ Max m - Unknown = Max m++ _ - _ = Unknown+++ fromInteger n = Exact (fromInteger n)++-- | Minimum of two size hints+smaller :: Size -> Size -> Size+smaller (Exact m) (Exact n) = Exact (m `min` n)+smaller (Exact m) (Max n) = Max (m `min` n)+smaller (Exact m) Unknown = Max m+smaller (Max m) (Exact n) = Max (m `min` n)+smaller (Max m) (Max n) = Max (m `min` n)+smaller (Max m) Unknown = Max m+smaller Unknown (Exact n) = Max n+smaller Unknown (Max n) = Max n+smaller Unknown Unknown = Unknown++-- | Maximum of two size hints+larger :: Size -> Size -> Size+larger (Exact m) (Exact n) = Exact (m `max` n)+larger (Exact m) (Max n) | m >= n = Exact m+ | otherwise = Max n+larger (Max m) (Exact n) | n >= m = Exact n+ | otherwise = Max m+larger (Max m) (Max n) = Max (m `max` n)+larger _ _ = Unknown++-- | Convert a size hint to an upper bound+toMax :: Size -> Size+toMax (Exact n) = Max n+toMax (Max n) = Max n+toMax Unknown = Unknown++-- | Compute the minimum size from a size hint+lowerBound :: Size -> Int+lowerBound (Exact n) = n+lowerBound _ = 0++-- | Compute the maximum size from a size hint if possible+upperBound :: Size -> Maybe Int+upperBound (Exact n) = Just n+upperBound (Max n) = Just n+upperBound Unknown = Nothing+
+ Data/Vector/Unboxed.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE MagicHash, UnboxedTuples, FlexibleInstances, MultiParamTypeClasses #-}++-- |+-- Module : Data.Vector.Unboxed+-- Copyright : (c) Roman Leshchinskiy 2008+-- License : BSD-style+--+-- Maintainer : rl@cse.unsw.edu.au+-- Stability : experimental+-- Portability : non-portable+-- +-- Unboxed vectors based on 'Unbox'.+--++module Data.Vector.Unboxed (+ Vector(..), module Data.Vector.IVector+) where++import Data.Vector.IVector+import qualified Data.Vector.Unboxed.Mutable as Mut+import Data.Vector.Unboxed.Unbox++import Control.Monad.ST ( runST )++import GHC.ST ( ST(..) )+import GHC.Prim ( ByteArray#, unsafeFreezeByteArray#, (+#) )+import GHC.Base ( Int(..) )++data Vector a = Vector {-# UNPACK #-} !Int+ {-# UNPACK #-} !Int+ ByteArray#++instance Unbox a => IVector Vector a where+ {-# INLINE vnew #-}+ vnew init = runST (do+ Mut.Vector i n marr# <- init+ ST (\s# -> case unsafeFreezeByteArray# marr# s# of+ (# s2#, arr# #) -> (# s2#, Vector i n arr# #)))++ {-# INLINE vlength #-}+ vlength (Vector _ n _) = n++ {-# INLINE unsafeSlice #-}+ unsafeSlice (Vector i _ arr#) j n = Vector (i+j) n arr#++ {-# INLINE unsafeIndex #-}+ unsafeIndex (Vector (I# i#) _ arr#) (I# j#) f = f (at# arr# (i# +# j#))++instance (Unbox a, Eq a) => Eq (Vector a) where+ {-# INLINE (==) #-}+ (==) = eq++instance (Unbox a, Ord a) => Ord (Vector a) where+ {-# INLINE compare #-}+ compare = cmp+
+ Data/Vector/Unboxed/Mutable.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}++-- |+-- Module : Data.Vector.Unboxed.Mutable+-- Copyright : (c) Roman Leshchinskiy 2008+-- License : BSD-style+--+-- Maintainer : rl@cse.unsw.edu.au+-- Stability : experimental+-- Portability : non-portable+-- +-- Mutable unboxed vectors based on 'Unbox'.+--++module Data.Vector.Unboxed.Mutable ( Vector(..) )+where++import qualified Data.Vector.MVector as MVector+import Data.Vector.MVector ( MVector, MVectorPure )+import Data.Vector.Unboxed.Unbox++import GHC.Prim ( MutableByteArray#,+ newByteArray#, sameMutableByteArray#, (+#) )++import GHC.ST ( ST(..) )++import GHC.Base ( Int(..) )++-- | Mutable unboxed vectors. They live in the 'ST' monad.+data Vector s a = Vector {-# UNPACK #-} !Int+ {-# UNPACK #-} !Int+ (MutableByteArray# s)++instance Unbox a => MVectorPure (Vector s) a where+ length (Vector _ n _) = n+ unsafeSlice (Vector i _ arr#) j m = Vector (i+j) m arr#++ {-# INLINE overlaps #-}+ overlaps (Vector i m arr1#) (Vector j n arr2#)+ = sameMutableByteArray# arr1# arr2#+ && (between i j (j+n) || between j i (i+m))+ where+ between x y z = x >= y && x < z+++instance Unbox a => MVector (Vector s) (ST s) a where+ {-# INLINE unsafeNew #-}+ unsafeNew (I# n#) = ST (\s# ->+ case newByteArray# (size# (undefined :: a) n#) s# of+ (# s2#, arr# #) -> (# s2#, Vector 0 (I# n#) arr# #)+ )++ {-# INLINE unsafeRead #-}+ unsafeRead (Vector (I# i#) _ arr#) (I# j#) = ST (read# arr# (i# +# j#))++ {-# INLINE unsafeWrite #-}+ unsafeWrite (Vector (I# i#) _ arr#) (I# j#) x = ST (\s# ->+ case write# arr# (i# +# j#) x s# of s2# -> (# s2#, () #)+ )++ {-# INLINE clear #-}+ clear _ = return ()+
+ Data/Vector/Unboxed/Unbox.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE MagicHash, UnboxedTuples #-}++-- |+-- Module : Data.Vector.Unboxed.Unbox+-- Copyright : (c) Roman Leshchinskiy 2008+-- License : BSD-style+--+-- Maintainer : rl@cse.unsw.edu.au+-- Stability : experimental+-- Portability : non-portable+-- +-- Primitives for manipulating unboxed arrays+--++module Data.Vector.Unboxed.Unbox (+ Unbox(..)+) where++import GHC.Base (+ Int(..)+ )+import GHC.Float (+ Float(..), Double(..)+ )++import GHC.Prim (+ ByteArray#, MutableByteArray#, State#,++ Int#, indexIntArray#, readIntArray#, writeIntArray#,+ indexFloatArray#, readFloatArray#, writeFloatArray#,+ indexDoubleArray#, readDoubleArray#, writeDoubleArray#+ )+import Data.Array.Base (+ wORD_SCALE, fLOAT_SCALE, dOUBLE_SCALE+ )++-- | Class of types which can be stored in unboxed arrays+class Unbox a where+ -- | Yield the size in bytes of a 'ByteArray#' which can store @n@ elements+ size# :: a -- ^ Dummy type parameter, never evaluated+ -> Int# -- ^ Number of elements+ -> Int#++ -- | Indexing+ at# :: ByteArray# -> Int# -> a++ -- | Yield the element at the given position+ read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)++ -- | Store the given element at the given position+ write# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s++instance Unbox Int where+ size# _ = wORD_SCALE+ at# arr# i# = I# (indexIntArray# arr# i#)+ read# arr# i# s# = case readIntArray# arr# i# s# of+ (# s1#, n# #) -> (# s1#, I# n# #)+ write# arr# i# (I# n#) s# = writeIntArray# arr# i# n# s#++instance Unbox Float where+ size# _ = fLOAT_SCALE+ at# arr# i# = F# (indexFloatArray# arr# i#)+ read# arr# i# s# = case readFloatArray# arr# i# s# of+ (# s1#, x# #) -> (# s1#, F# x# #)+ write# arr# i# (F# x#) s# = writeFloatArray# arr# i# x# s#++instance Unbox Double where+ size# _ = dOUBLE_SCALE+ at# arr# i# = D# (indexDoubleArray# arr# i#)+ read# arr# i# s# = case readDoubleArray# arr# i# s# of+ (# s1#, x# #) -> (# s1#, D# x# #)+ write# arr# i# (D# x#) s# = writeDoubleArray# arr# i# x# s#+
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2001-2002, Manuel M T Chakravarty & Gabriele Keller+Copyright (c) 2006-2007, Manuel M T Chakravarty & Roman Leshchinskiy+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 name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE 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+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+
+ include/phases.h view
@@ -0,0 +1,2 @@+#define INLINE_STREAM INLINE [1]+
+ vector.cabal view
@@ -0,0 +1,46 @@+Name: vector+Version: 0.1+License: BSD3+License-File: LICENSE+Author: Roman Leshchinskiy+Maintainer: Roman Leshchinskiy <rl@cse.unsw.edu.au>+Copyright: (c) Roman Leshchinskiy 2008+Homepage: http://darcs.haskell.org/vector+Category: Data Structures+Synopsis: Efficient Arrays+Description:+ .+ An efficient implementation of Int-indexed arrays with a powerful+ loop fusion framework.+ .+ This code is highly experimental and for the most part untested. Use+ at your own risk!++Cabal-Version: >= 1.2+Build-Type: Simple++Library+ Extensions: CPP+ Exposed-Modules:+ Data.Vector.Stream.Size+ Data.Vector.Stream++ Data.Vector.MVector+ Data.Vector.MVector.Mut+ Data.Vector.IVector++ Data.Vector.Unboxed.Unbox+ Data.Vector.Unboxed.Mutable+ Data.Vector.Unboxed++ Data.Vector.Mutable+ Data.Vector+ Include-Dirs:+ include++ Install-Includes:+ phases.h++ Build-Depends: base, array, ghc-prim,+ ghc >= 6.9+