fixed-vector (empty) → 0.1
raw patch · 10 files changed
+1540/−0 lines, 10 filesdep +basedep +primitivesetup-changed
Dependencies added: base, primitive
Files
- Data/Vector/Fixed.hs +436/−0
- Data/Vector/Fixed/Boxed.hs +87/−0
- Data/Vector/Fixed/Internal.hs +211/−0
- Data/Vector/Fixed/Mutable.hs +162/−0
- Data/Vector/Fixed/Primitive.hs +88/−0
- Data/Vector/Fixed/Storable.hs +151/−0
- Data/Vector/Fixed/Unboxed.hs +317/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- fixed-vector.cabal +56/−0
+ Data/Vector/Fixed.hs view
@@ -0,0 +1,436 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Generic API for vectors with fixed length.+--+-- For encoding of vector size library uses Peano naturals defined in+-- the library. At come point in the future it would make sense to+-- switch to new GHC type level numerals.+module Data.Vector.Fixed (+ -- * Vector type class+ -- ** Vector size+ Dim+ , Z+ , S+ -- ** Type class+ , Vector(..)+ , Arity+ , length+ -- * Generic functions+ -- ** Literal vectors+ , New+ , vec+ , con+ , (|>)+ -- ** Construction+ , replicate+ , replicateM+ , basis+ , generate+ , generateM+ -- ** Element access+ , head+ , tail+ , (!)+ -- ** Map+ , map+ , mapM+ , mapM_+ -- ** Folding+ , foldl+ , foldl1+ , sum+ , maximum+ , minimum+ -- ** Zips+ , zipWith+ , izipWith+ -- ** Conversion+ , convert+ , toList+ , fromList+ -- * Special types+ , VecList(..)+ ) where++import Data.Vector.Fixed.Internal++import qualified Prelude as P+import Prelude hiding ( replicate,map,zipWith,maximum,minimum+ , foldl,foldl1,length,sum+ , head,tail,mapM,mapM_+ )++++----------------------------------------------------------------+-- Generic functions+----------------------------------------------------------------++-- TODO: does not fuse!+-- | Newtype wrapper for partially constructed vectors. /n/ is number+-- of uninitialized elements.+--+-- Example of use:+--+-- >>> vec $ con |> 1 |> 3 :: Complex Double+-- > 1 :+ 3+newtype New n v a = New (Fn n a (v a))++-- | Convert fully applied constructor to vector+vec :: New Z v a -> v a+{-# INLINE vec #-}+vec (New v) = v++-- | Seed constructor+con :: Vector v a => New (Dim v) v a+{-# INLINE con #-}+con = f2n construct++-- | Apply another element to vector+(|>) :: New (S n) v a -> a -> New n v a+{-# INLINE (|>) #-}+New f |> a = New (f a)+infixl 1 |>++f2n :: Fun n a (v a) -> New n v a+{-# INLINE f2n #-}+f2n (Fun f) = New f+++----------------------------------------------------------------++-- | Replicate value /n/ times.+replicate :: Vector v a => a -> v a+{-# INLINE replicate #-}+replicate x = create $ Cont+ $ replicateF x++data T_replicate n = T_replicate++replicateF :: forall n a b. Arity n => a -> Fun n a b -> b+replicateF x (Fun h)+ = apply (\T_replicate -> (x, T_replicate))+ (T_replicate :: T_replicate n)+ h++-- | Execute monadic action for every element of vector.+replicateM :: (Vector v a, Monad m) => m a -> m (v a)+{-# INLINE replicateM #-}+replicateM x = replicateFM x construct++replicateFM :: forall m n a b. (Monad m, Arity n) => m a -> Fun n a b -> m b+replicateFM act (Fun h)+ = applyM (\T_replicate -> do { a <- act; return (a, T_replicate) } )+ (T_replicate :: T_replicate n)+ h+++----------------------------------------------------------------++-- | Unit vector along Nth axis,+basis :: forall v a. (Vector v a, Num a) => Int -> v a+{-# INLINE basis #-}+basis n = create $ Cont+ $ basisF n++newtype T_basis n = T_basis Int++basisF :: forall n a b. (Num a, Arity n) => Int -> Fun n a b -> b+basisF n0 (Fun f)+ = apply (\(T_basis n) -> ((if n == 0 then 1 else 0) :: a, T_basis (n - 1)))+ (T_basis n0 :: T_basis n)+ f+++----------------------------------------------------------------++-- | Generate vector.+generate :: forall v a. (Vector v a) => (Int -> a) -> v a+{-# INLINE generate #-}+generate f = create $ Cont+ $ generateF f++newtype T_generate n = T_generate Int++generateF :: forall n a b. (Arity n) => (Int -> a) -> Fun n a b -> b+generateF g (Fun f)+ = apply (\(T_generate n) -> (g n, T_generate (n + 1)))+ (T_generate 0 :: T_generate n)+ f++-- | Monadic generation+generateM :: forall m v a. (Monad m, Vector v a) => (Int -> m a) -> m (v a)+{-# INLINE generateM #-}+generateM f = generateFM f construct++generateFM :: forall m n a b. (Monad m, Arity n) => (Int -> m a) -> Fun n a b -> m b+generateFM g (Fun f)+ = applyM (\(T_generate n) -> do { a <- g n; return (a, T_generate (n + 1)) } )+ (T_generate 0 :: T_generate n)+ f+++----------------------------------------------------------------++-- | First element of vector.+head :: (Vector v a, Dim v ~ S n) => v a -> a+{-# INLINE head #-}+head v = inspectV v+ $ headF++data T_head a n = T_head (Maybe a)++headF :: forall n a. Arity (S n) => Fun (S n) a a+headF = Fun $ accum (\(T_head m) a -> T_head $ case m of { Nothing -> Just a; x -> x })+ (\(T_head (Just x)) -> x)+ (T_head Nothing :: T_head a (S n))+++----------------------------------------------------------------++-- | Tail of vector.+tail :: (Vector v a, Vector w a, Dim v ~ S (Dim w))+ => v a -> w a+{-# INLINE tail #-}+tail v = create $ Cont+ $ inspectV v+ . tailF++tailF :: Arity n => Fun n a b -> Fun (S n) a b+{-# INLINE tailF #-}+tailF (Fun f) = Fun (\_ -> f)+++----------------------------------------------------------------++-- | /O(n)/ Get vector's element at index i.+(!) :: (Vector v a) => v a -> Int -> a+{-# INLINE (!) #-}+v ! i = inspectV v+ $ elemF i++newtype T_Elem a n = T_Elem (Either Int a)++elemF :: forall n a. Arity n => Int -> Fun n a a+elemF n+ -- This is needed because of possible underflow during subtraction+ | n < 0 = error "Data.Vector.Fixed.!: index out of range"+ | otherwise = Fun $ accum+ (\(T_Elem x) a -> T_Elem $ case x of+ Left 0 -> Right a+ Left i -> Left (i - 1)+ r -> r+ )+ (\(T_Elem x) -> case x of+ Left _ -> error "Data.Vector.Fixed.!: index out of range"+ Right a -> a+ )+ ( T_Elem (Left n) :: T_Elem a n)+++----------------------------------------------------------------++-- | Left fold over vector+foldl :: Vector v a => (b -> a -> b) -> b -> v a -> b+{-# INLINE foldl #-}+foldl f z v = inspectV v+ $ foldlF f z++-- | Monadic fold over vector.+foldM :: (Vector v a, Monad m) => (b -> a -> m b) -> b -> v a -> m b+{-# INLINE foldM #-}+foldM f x v = foldl go (return x) v+ where+ go m a = do b <- m+ f b a+++newtype T_foldl b n = T_foldl b++foldlF :: forall n a b. Arity n => (b -> a -> b) -> b -> Fun n a b+{-# INLINE foldlF #-}+foldlF f b = Fun $ accum (\(T_foldl r) a -> T_foldl (f r a))+ (\(T_foldl r) -> r)+ (T_foldl b :: T_foldl b n)++-- | Left fold over vector+foldl1 :: (Vector v a, Dim v ~ S n) => (a -> a -> a) -> v a -> a+{-# INLINE foldl1 #-}+foldl1 f v = inspectV v+ $ foldl1F f+++-- Implementation of foldl1F is particularly ugly. It could be+-- expressed in terms of foldlF:+--+-- > foldl1F f = Fun $ \a -> case foldlF f a :: Fun n a a of Fun g -> g+--+-- But it require constraint `Arity n` whereas foldl1 provide+-- Arity (S n). Latter imply former but GHC cannot infer it. So it+-- 'Arity n' begin to propagate through contexts. It's not acceptable.++newtype T_foldl1 a n = T_foldl1 (Maybe a)++foldl1F :: forall n a. (Arity (S n)) => (a -> a -> a) -> Fun (S n) a a+{-# INLINE foldl1F #-}+foldl1F f = Fun $ accum (\(T_foldl1 r) a -> T_foldl1 $ Just $ maybe a (flip f a) r)+ (\(T_foldl1 (Just x)) -> x)+ (T_foldl1 Nothing :: T_foldl1 a (S n))+++++----------------------------------------------------------------++-- | Sum all elements in the vector+sum :: (Vector v a, Num a) => v a -> a+{-# INLINE sum #-}+sum = foldl (+) 0++-- | Maximum element of vector+maximum :: (Vector v a, Dim v ~ S n, Ord a) => v a -> a+{-# INLINE maximum #-}+maximum = foldl1 max++-- | Minimum element of vector+minimum :: (Vector v a, Dim v ~ S n, Ord a) => v a -> a+{-# INLINE minimum #-}+minimum = foldl1 max++++----------------------------------------------------------------++-- | Map over vector+map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b+{-# INLINE map #-}+map f v = create $ Cont+ $ inspectV v+ . mapF f++-- | Monadic map over vector.+mapM :: (Vector v a, Vector v b, Monad m) => (a -> m b) -> v a -> m (v b)+{-# INLINE mapM #-}+mapM f v = inspectV v+ $ mapFM f+ $ construct++-- | Apply monadic action to each element of vector and ignore result.+mapM_ :: (Vector v a, Monad m) => (a -> m b) -> v a -> m ()+{-# INLINE mapM_ #-}+mapM_ f = foldl (\m a -> m >> f a >> return ()) (return ())++newtype T_map b c n = T_map (Fn n b c)++mapF :: forall n a b c. Arity n => (a -> b) -> Fun n b c -> Fun n a c+mapF f (Fun h) = Fun $ accum (\(T_map g) a -> T_map (g (f a)))+ (\(T_map g) -> g)+ (T_map h :: T_map b c n)++mapFM :: forall m n a b c. (Arity n, Monad m) => (a -> m b) -> Fun n b c -> Fun n a (m c)+mapFM f (Fun h) = Fun $ accumM (\(T_map g) a -> do { b <- f a; return (T_map (g b)) })+ (\(T_map g) -> return g)+ (return $ T_map h :: m (T_map b c n))++----------------------------------------------------------------++-- | Zip two vector together.+zipWith :: (Vector v a, Vector v b, Vector v c)+ => (a -> b -> c) -> v a -> v b -> v c+{-# INLINE zipWith #-}+zipWith f v u = create $ Cont+ $ inspectV u+ . inspectV v+ . zipWithF f++data T_zip a c r n = T_zip (VecList n a) (Fn n c r)++zipWithF :: forall n a b c d. Arity n+ => (a -> b -> c) -> Fun n c d -> Fun n a (Fun n b d)+zipWithF f (Fun g0) =+ fmap (\v -> Fun $ accum+ (\(T_zip (VecList (a:as)) g) b -> T_zip (VecList as) (g (f a b)))+ (\(T_zip _ x) -> x)+ (T_zip v g0 :: T_zip a c d n)+ ) construct+++-- | Zip two vector together.+izipWith :: (Vector v a, Vector v b, Vector v c)+ => (Int -> a -> b -> c) -> v a -> v b -> v c+{-# INLINE izipWith #-}+izipWith f v u = create $ Cont+ $ inspectV u+ . inspectV v+ . izipWithF f++data T_izip a c r n = T_izip Int (VecList n a) (Fn n c r)++izipWithF :: forall n a b c d. Arity n+ => (Int -> a -> b -> c) -> Fun n c d -> Fun n a (Fun n b d)+izipWithF f (Fun g0) =+ fmap (\v -> Fun $ accum+ (\(T_izip i (VecList (a:as)) g) b -> T_izip (i+1) (VecList as) (g (f i a b)))+ (\(T_izip _ _ x) -> x)+ (T_izip 0 v g0 :: T_izip a c d n)+ ) construct+++----------------------------------------------------------------++-- | Convert between different vector types+convert :: (Vector v a, Vector w a, Dim v ~ Dim w) => v a -> w a+{-# INLINE convert #-}+convert v = inspectV v construct+-- FIXME: check for fusion rules!++-- | Convert vector to the list+toList :: (Vector v a) => v a -> [a]+toList v+ = case inspectV v construct of VecList xs -> xs++-- | Create vector form list. List must have same length as the+-- vector.+fromList :: forall v a. (Vector v a) => [a] -> v a+{-# INLINE fromList #-}+fromList xs+ | length r == P.length xs = convert r+ | otherwise = error "Data.Vector.Fixed.fromList: bad list length"+ where+ r = VecList xs :: VecList (Dim v) a+++----------------------------------------------------------------+-- Data types+----------------------------------------------------------------++-- | Vector based on the lists. Not very useful by itself but is+-- necessary for implementation.+newtype VecList n a = VecList [a]+ deriving (Show,Eq)++type instance Dim (VecList n) = n++newtype Flip f a n = Flip (f n a)++newtype T_list a n = T_list ([a] -> [a])++-- It's vital to avoid 'reverse' and build list using [a]->[a]+-- functions. Reverse is recursive and interferes with inlining.+instance Arity n => Vector (VecList n) a where+ construct = Fun $ accum+ (\(T_list xs) x -> T_list (xs . (x:)))+ (\(T_list xs) -> VecList (xs []) :: VecList n a)+ (T_list id :: T_list a n)+ inspect v (Fun f) = apply+ (\(Flip (VecList (x:xs))) -> (x, Flip (VecList xs)))+ (Flip v)+ f+ {-# INLINE construct #-}+ {-# INLINE inspect #-}
+ Data/Vector/Fixed/Boxed.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Boxed vector.+module Data.Vector.Fixed.Boxed (+ -- * Immutable+ Vec+ , Vec2+ , Vec3+ -- * Mutable+ , MVec+ ) where++import Control.Monad+import Data.Primitive.Array+import Prelude hiding (length,replicate,zipWith,map,foldl)++import Data.Vector.Fixed+import Data.Vector.Fixed.Internal+import Data.Vector.Fixed.Mutable++++----------------------------------------------------------------+-- Data type+----------------------------------------------------------------++-- | Unboxed vector with fixed length+newtype Vec n a = Vec (Array a)++-- | Mutable unboxed vector with fixed length+newtype MVec n s a = MVec (MutableArray s a)++type Vec2 = Vec (S (S Z))+type Vec3 = Vec (S (S (S Z)))++++----------------------------------------------------------------+-- Instances+----------------------------------------------------------------++instance (Arity n, Show a) => Show (Vec n a) where+ show v = "fromList " ++ show (toList v)+++type instance Mutable (Vec n) = MVec n++instance (Arity n) => MVector (MVec n) a where+ overlaps (MVec v) (MVec u) = sameMutableArray v u+ {-# INLINE overlaps #-}+ new = do+ v <- newArray (arity (undefined :: n)) uninitialised+ return $ MVec v+ {-# INLINE new #-}+ copy = move+ {-# INLINE copy #-}+ move (MVec dst) (MVec src) = copyMutableArray dst 0 src 0 (arity (undefined :: n))+ {-# INLINE move #-}+ unsafeRead (MVec v) i = readArray v i+ {-# INLINE unsafeRead #-}+ unsafeWrite (MVec v) i x = writeArray v i x+ {-# INLINE unsafeWrite #-}++instance (Arity n) => IVector (Vec n) a where+ unsafeFreeze (MVec v) = do { a <- unsafeFreezeArray v; return $! Vec a }+ unsafeThaw (Vec v) = do { a <- unsafeThawArray v; return $! MVec a }+ unsafeIndex (Vec v) i = indexArray v i+ {-# INLINE unsafeFreeze #-}+ {-# INLINE unsafeThaw #-}+ {-# INLINE unsafeIndex #-}++++type instance Dim (Vec n) = n+type instance DimM (MVec n) = n++instance (Arity n) => Vector (Vec n) a where+ construct = constructVec+ inspect = inspectVec+ {-# INLINE construct #-}+ {-# INLINE inspect #-}++uninitialised :: a+uninitialised = error "Data.Vector.Fixed.Boxed: uninitialised element"
+ Data/Vector/Fixed/Internal.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Type classes for generic vectors. This module exposes type classes+-- and auxiliary functions needed to write generic functions not+-- present in the module "Data.Vector.Fixed".+--+-- Implementation is based on+-- <http://unlines.wordpress.com/2010/11/15/generics-for-small-fixed-size-vectors/>+module Data.Vector.Fixed.Internal (+ -- * Type-level naturals+ Z+ , S+ -- * N-ary functions+ , Fn+ , Fun(..)+ , Arity(..)+ -- * Vector type class+ , Dim+ , Vector(..)+ , length+ -- * Deforestation+ -- $deforestation+ , Cont(..)+ , create+ , inspectV+ ) where++import Data.Complex+import Prelude hiding (length)+++----------------------------------------------------------------+-- Naturals+----------------------------------------------------------------++-- | Type level zero+data Z+-- | Successor of n+data S n+++----------------------------------------------------------------+-- N-ary functions+----------------------------------------------------------------++-- | Type family for n-ary functions.+type family Fn n a b+type instance Fn Z a b = b+type instance Fn (S n) a b = a -> Fn n a b++-- | Newtype wrapper which is used to make 'Fn' injective.+newtype Fun n a b = Fun (Fn n a b)++newtype T_fmap a b n = T_fmap (Fn n a b)++instance Arity n => Functor (Fun n a) where+ fmap (f :: b -> c) (Fun g0 :: Fun n a b)+ = Fun $ accum+ (\(T_fmap g) a -> T_fmap (g a))+ (\(T_fmap x) -> f x)+ (T_fmap g0 :: T_fmap a b n)+ {-# INLINE fmap #-}+++-- | Type class for handling /n/-ary functions.+class Arity n where+ -- | Left fold over /n/ elements exposed as n-ary function.+ accum :: (forall k. t (S k) -> a -> t k) -- ^ Fold function+ -> (t Z -> b) -- ^ Extract result of fold+ -> t n -- ^ Initial value+ -> Fn n a b -- ^ Reduction function++ -- | Monadic left fold.+ accumM :: Monad m+ => (forall k. t (S k) -> a -> m (t k)) -- ^ Fold function+ -> (t Z -> m b) -- ^ Extract result of fold+ -> m (t n) -- ^ Initial value+ -> Fn n a (m b) -- ^ Reduction function++ -- | Apply all parameters to the function.+ apply :: (forall k. t (S k) -> (a, t k)) -- ^ Get value to apply to function+ -> t n -- ^ Initial value+ -> Fn n a b -- ^ N-ary function+ -> b++ -- | Monadic apply+ applyM :: Monad m+ => (forall k. t (S k) -> m (a, t k)) -- ^ Get value to apply to function+ -> t n -- ^ Initial value+ -> Fn n a b -- ^ N-ary function+ -> m b+ -- | Arity of function.+ arity :: n -> Int++instance Arity Z where+ accum _ g t = g t+ accumM _ g t = g =<< t+ apply _ _ h = h+ applyM _ _ h = return h+ arity _ = 0+ {-# INLINE accum #-}+ {-# INLINE accumM #-}+ {-# INLINE apply #-}+ {-# INLINE arity #-}++instance Arity n => Arity (S n) where+ accum f g t = \a -> accum f g (f t a)+ accumM f g t = \a -> accumM f g $ flip f a =<< t+ apply f t h = case f t of (a,u) -> apply f u (h a)+ applyM f t h = do (a,u) <- f t+ applyM f u (h a)+ arity n = 1 + arity (prevN n)+ where+ prevN :: S n -> n+ prevN _ = undefined+ {-# INLINE accum #-}+ {-# INLINE accumM #-}+ {-# INLINE apply #-}+ {-# INLINE arity #-}++++----------------------------------------------------------------+-- Type class for vectors+----------------------------------------------------------------++-- | Size of vector expressed as type-level natural.+type family Dim (v :: * -> *)++-- | Type class for vectors with fixed length.+class Arity (Dim v) => Vector v a where+ -- | N-ary function for creation of vectors.+ construct :: Fun (Dim v) a (v a)+ -- | Deconstruction of vector.+ inspect :: v a -> Fun (Dim v) a b -> b++-- | Length of vector. Function doesn't evaluate its argument.+length :: forall v a. Arity (Dim v) => v a -> Int+{-# INLINE length #-}+length _ = arity (undefined :: Dim v)++++----------------------------------------------------------------+-- Fusion+----------------------------------------------------------------++-- $deforestation+--+-- Explicit deforestation is less important for ADT based vectors+-- since GHC is able to eliminate intermediate data structures. But it+-- cannot do so for array-based ones so intermediate vector have to be+-- removed with RULES. Following identity is used. Of course @f@ must+-- be polymorphic in continuation result type.+--+-- > inspect (f construct) g = f g+--+-- But 'construct' function is located somewhere deep in function+-- application stack so it cannot be matched using rule. Function+-- 'create' is needed to move 'construct' to the top.+--+-- As a rule function which are subject to deforestation should be+-- written using 'create' and 'inspectV' functions.+++-- | Continuation with arbitrary result.+newtype Cont n a = Cont (forall r. Fun n a r -> r)++-- | Construct vector. It should be used instead of 'construct' to get+-- deforestation. Example of usage:+--+-- > cont1 $ cont2 $ construct+--+-- becomes+--+-- > create $ Cont $ cont1 . cont2+create :: (Arity (Dim v), Vector v a) => Cont (Dim v) a -> v a+{-# INLINE[1] create #-}+create (Cont f) = f construct++-- | Wrapper for 'inspect'. It's inlined later and is needed in order+-- to give deforestation rule chance to fire.+inspectV :: (Arity (Dim v), Vector v a) => v a -> Fun (Dim v) a b -> b+{-# INLINE[1] inspectV #-}+inspectV = inspect++app :: Cont n a -> Fun n a b -> b+{-# INLINE app #-}+app (Cont f) g = f g++{-# RULES "inspect/construct"+ forall f g. inspectV (create f) g = app f g+ #-}++++----------------------------------------------------------------+-- Instances+----------------------------------------------------------------++type instance Dim Complex = S (S Z)++instance RealFloat a => Vector Complex a where+ construct = Fun (:+)+ inspect (x :+ y) (Fun f) = f x y
+ Data/Vector/Fixed/Mutable.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Rank2Types #-}+-- |+-- Type classes for array based vector. They are quite similar to ones+-- from @vector@ package but those only suitable for vectors with+-- variable length.+module Data.Vector.Fixed.Mutable (+ -- * Mutable vectors+ Mutable+ , DimM+ , MVector(..)+ , lengthM+ , read+ , write+ , clone+ -- * Immutable vectors+ , IVector(..)+ , index+ , lengthI+ , freeze+ , thaw+ -- * Vector API+ , constructVec+ , inspectVec+ ) where++import Control.Monad.ST+import Control.Monad.Primitive+import Data.Vector.Fixed.Internal+import Prelude hiding (read)+++----------------------------------------------------------------+-- Type classes+----------------------------------------------------------------++-- | Mutable counterpart of fixed-length vector+type family Mutable (v :: * -> *) :: * -> * -> *++-- | Dimension for mutable vector+type family DimM (v :: * -> * -> *) :: *++-- | Type class for mutable vectors+class (Arity (DimM v)) => MVector v a where+ -- | Checks whether vectors' buffers overlaps+ overlaps :: v s a -> v s a -> Bool+ -- | Copy vector. The two vectors may not overlap. Since vectors'+ -- length is encoded in the type there is no need in runtime checks.+ copy :: PrimMonad m+ => v (PrimState m) a -- ^ Target+ -> v (PrimState m) a -- ^ Source+ -> m ()+ -- | Copy vector. The two vectors may overlap. Since vectors' length+ -- is encoded in the type there is no need in runtime checks.+ move :: PrimMonad m+ => v (PrimState m) a -- ^ Target+ -> v (PrimState m) a -- ^ Source+ -> m ()+ -- | Allocate new vector+ new :: PrimMonad m => m (v (PrimState m) a)+ -- | Read value at index without bound checks.+ unsafeRead :: PrimMonad m => v (PrimState m) a -> Int -> m a+ -- | Write value at index without bound checks.+ unsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m ()+++-- | Length of mutable vector+lengthM :: forall v s a. (Arity (DimM v)) => v s a -> Int+lengthM _ = arity (undefined :: DimM v)++-- | Clone vector+clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a)+{-# INLINE clone #-}+clone v = do+ u <- new+ move v u+ return u++-- | Read value at index with bound checks.+read :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a+{-# INLINE read #-}+read v i+ | i < 0 || i >= lengthM v = error "Data.Vector.Fixed.Mutable.read: index out of range"+ | otherwise = unsafeRead v i++-- | Write value at index with bound checks.+write :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m ()+{-# INLINE write #-}+write v i x+ | i < 0 || i >= lengthM v = error "Data.Vector.Fixed.Mutable.write: index out of range"+ | otherwise = unsafeWrite v i x+++-- | Type class for immutable vectors+class (Dim v ~ DimM (Mutable v), MVector (Mutable v) a) => IVector v a where+ -- | Convert vector to immutable state. Mutable vector must not be+ -- modified afterwards.+ unsafeFreeze :: PrimMonad m => Mutable v (PrimState m) a -> m (v a)+ -- | Convert immutable vector to mutable. Immutable vector must not+ -- be used afterwards.+ unsafeThaw :: PrimMonad m => v a -> m (Mutable v (PrimState m) a)+ -- | Get element at specified index+ unsafeIndex :: v a -> Int -> a++-- | Length of immutable vector+lengthI :: IVector v a => v a -> Int+lengthI = lengthM . cast+ where+ cast :: v a -> Mutable v () a+ cast _ = undefined++index :: IVector v a => v a -> Int -> a+{-# INLINE index #-}+index v i | i < 0 || i >= lengthI v = error "Data.Vector.Fixed.Mutable.!: index out of bounds"+ | otherwise = unsafeIndex v i+++-- | Safely convert mutable vector to immutable.+freeze :: (PrimMonad m, IVector v a) => Mutable v (PrimState m) a -> m (v a)+{-# INLINE freeze #-}+freeze v = unsafeFreeze =<< clone v++-- | Safely convert immutable vector to mutable.+thaw :: (PrimMonad m, IVector v a) => v a -> m (Mutable v (PrimState m) a)+{-# INLINE thaw #-}+thaw v = clone =<< unsafeThaw v++++----------------------------------------------------------------+-- Vector API+----------------------------------------------------------------++-- | Generic inspect+inspectVec :: forall v a b. (Arity (Dim v), IVector v a) => v a -> Fun (Dim v) a b -> b+{-# INLINE inspectVec #-}+inspectVec v (Fun f)+ = apply (\(T_idx i) -> (unsafeIndex v i, T_idx (i+1)))+ (T_idx 0 :: T_idx (Dim v))+ f++newtype T_idx n = T_idx Int+++-- | Generic construct+constructVec :: forall v a. (Arity (Dim v), IVector v a) => Fun (Dim v) a (v a)+{-# INLINE constructVec #-}+constructVec = Fun $+ accum step+ (\(T_new _ st) -> runST $ unsafeFreeze =<< st :: v a)+ (T_new 0 new :: T_new v a (Dim v))++data T_new v a n = T_new Int (forall s. ST s (Mutable v s a))++step :: (IVector v a) => T_new v a (S n) -> a -> T_new v a n+step (T_new i st) x = T_new (i+1) $ do+ mv <- st+ unsafeWrite mv i x+ return mv
+ Data/Vector/Fixed/Primitive.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Unboxed vectors with fixed length. Vectors from+-- "Data.Vector.Fixed.Unboxed" provide more flexibility at no+-- performeance cost.+module Data.Vector.Fixed.Primitive (+ -- * Immutable+ Vec+ , Vec2+ , Vec3+ -- * Mutable+ , MVec+ ) where++import Control.Monad+import Data.Primitive.ByteArray+import Data.Primitive+import Prelude hiding (length,replicate,zipWith,map,foldl)++import Data.Vector.Fixed+import Data.Vector.Fixed.Internal+import Data.Vector.Fixed.Mutable++++----------------------------------------------------------------+-- Data type+----------------------------------------------------------------++-- | Unboxed vector with fixed length+newtype Vec n a = Vec ByteArray++-- | Mutable unboxed vector with fixed length+newtype MVec n s a = MVec (MutableByteArray s)++type Vec2 = Vec (S (S Z))+type Vec3 = Vec (S (S (S Z)))++++----------------------------------------------------------------+-- Instances+----------------------------------------------------------------++instance (Arity n, Prim a, Show a) => Show (Vec n a) where+ show v = "fromList " ++ show (toList v)++++type instance Mutable (Vec n) = MVec n++instance (Arity n, Prim a) => MVector (MVec n) a where+ overlaps (MVec v) (MVec u) = sameMutableByteArray v u+ {-# INLINE overlaps #-}+ new = do+ v <- newByteArray $! arity (undefined :: n) * sizeOf (undefined :: a)+ return $ MVec v+ {-# INLINE new #-}+ copy = move+ {-# INLINE copy #-}+ move (MVec dst) (MVec src) = copyMutableByteArray dst 0 src 0 (arity (undefined :: n))+ {-# INLINE move #-}+ unsafeRead (MVec v) i = readByteArray v i+ {-# INLINE unsafeRead #-}+ unsafeWrite (MVec v) i x = writeByteArray v i x+ {-# INLINE unsafeWrite #-}++instance (Arity n, Prim a) => IVector (Vec n) a where+ unsafeFreeze (MVec v) = do { a <- unsafeFreezeByteArray v; return $! Vec a }+ unsafeThaw (Vec v) = do { a <- unsafeThawByteArray v; return $! MVec a }+ unsafeIndex (Vec v) i = indexByteArray v i+ {-# INLINE unsafeFreeze #-}+ {-# INLINE unsafeThaw #-}+ {-# INLINE unsafeIndex #-}++++type instance Dim (Vec n) = n+type instance DimM (MVec n) = n++instance (Arity n, Prim a) => Vector (Vec n) a where+ construct = constructVec+ inspect = inspectVec+ {-# INLINE construct #-}+ {-# INLINE inspect #-}
+ Data/Vector/Fixed/Storable.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Storable-based unboxed vectors.+module Data.Vector.Fixed.Storable (+ -- * Immutable+ Vec+ , Vec2+ , Vec3+ -- * Raw pointers+ , unsafeFromForeignPtr+ , unsafeToForeignPtr+ , unsafeWith+ -- * Mutable+ , MVec(..)+ ) where++import Control.Monad.Primitive+import Foreign.Storable+import Foreign.ForeignPtr+import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray )+import GHC.ForeignPtr ( ForeignPtr(..), mallocPlainForeignPtrBytes )+import GHC.Ptr ( Ptr(..) )++import Prelude hiding (length,replicate,zipWith,map,foldl)++import Data.Vector.Fixed+import Data.Vector.Fixed.Internal+import Data.Vector.Fixed.Mutable++++----------------------------------------------------------------+-- Data types+----------------------------------------------------------------++-- | Storable-based vector with fixed length+newtype Vec n a = Vec (ForeignPtr a)++-- | Storable-based mutable vector with fixed length+newtype MVec n s a = MVec (ForeignPtr a)++type Vec2 = Vec (S (S Z))+type Vec3 = Vec (S (S (S Z)))++++----------------------------------------------------------------+-- Raw Ptrs+----------------------------------------------------------------++-- | Get underlying pointer. Data may not be modified through pointer.+unsafeToForeignPtr :: Storable a => Vec n a -> ForeignPtr a+{-# INLINE unsafeToForeignPtr #-}+unsafeToForeignPtr (Vec fp) = fp++-- | Construct vector from foreign pointer.+unsafeFromForeignPtr :: Storable a => ForeignPtr a -> Vec n a+{-# INLINE unsafeFromForeignPtr #-}+unsafeFromForeignPtr = Vec++unsafeWith :: Storable a => (Ptr a -> IO b) -> Vec n a -> IO b+{-# INLINE unsafeWith #-}+unsafeWith f (Vec fp) = f (getPtr fp)++++----------------------------------------------------------------+-- Instances+----------------------------------------------------------------++instance (Arity n, Storable a, Show a) => Show (Vec n a) where+ show v = "fromList " ++ show (toList v)++++type instance Mutable (Vec n) = MVec n++instance (Arity n, Storable a) => MVector (MVec n) a where+ overlaps (MVec fp) (MVec fq)+ = between p q (q `advancePtr` n) || between q p (p `advancePtr` n)+ where+ between x y z = x >= y && x < z+ p = getPtr fp+ q = getPtr fq+ n = arity (undefined :: n)+ {-# INLINE overlaps #-}+ new = unsafePrimToPrim $ do+ fp <- mallocVector $ arity (undefined :: n)+ return $ MVec fp+ {-# INLINE new #-}+ copy (MVec fp) (MVec fq)+ = unsafePrimToPrim+ $ withForeignPtr fp $ \p ->+ withForeignPtr fq $ \q ->+ copyArray p q (arity (undefined :: n))+ {-# INLINE copy #-}+ move (MVec fp) (MVec fq)+ = unsafePrimToPrim+ $ withForeignPtr fp $ \p ->+ withForeignPtr fq $ \q ->+ moveArray p q (arity (undefined :: n))+ {-# INLINE move #-}+ unsafeRead (MVec fp) i+ = unsafePrimToPrim+ $ withForeignPtr fp (`peekElemOff` i)+ {-# INLINE unsafeRead #-}+ unsafeWrite (MVec fp) i x+ = unsafePrimToPrim+ $ withForeignPtr fp $ \p -> pokeElemOff p i x+ {-# INLINE unsafeWrite #-}+++instance (Arity n, Storable a) => IVector (Vec n) a where+ unsafeFreeze (MVec fp) = return $ Vec fp+ unsafeThaw (Vec fp) = return $ MVec fp+ unsafeIndex (Vec fp) i+ = unsafeInlineIO+ $ withForeignPtr fp (`peekElemOff` i)+ {-# INLINE unsafeFreeze #-}+ {-# INLINE unsafeThaw #-}+ {-# INLINE unsafeIndex #-}+++type instance Dim (Vec n) = n+type instance DimM (MVec n) = n++instance (Arity n, Storable a) => Vector (Vec n) a where+ construct = constructVec+ inspect = inspectVec+ {-# INLINE construct #-}+ {-# INLINE inspect #-}++++----------------------------------------------------------------+-- Helpers+----------------------------------------------------------------++-- Code copied verbatim from vector package++mallocVector :: forall a. Storable a => Int -> IO (ForeignPtr a)+{-# INLINE mallocVector #-}+mallocVector size+ = mallocPlainForeignPtrBytes (size * sizeOf (undefined :: a))++getPtr :: ForeignPtr a -> Ptr a+{-# INLINE getPtr #-}+getPtr (ForeignPtr addr _) = Ptr addr
+ Data/Vector/Fixed/Unboxed.hs view
@@ -0,0 +1,317 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+-- |+-- Unboxed vectors with fixed length.+module Data.Vector.Fixed.Unboxed(+ -- * Immutable+ Vec+ , Vec2+ , Vec3+ -- * Mutable+ , MVec+ -- * Type classes+ , Unbox+ ) where++import Control.Monad+import Data.Complex+import Data.Int ( Int8, Int16, Int32, Int64 )+import Data.Word (Word,Word8,Word16,Word32,Word64)+import Prelude hiding (length,replicate,zipWith,map,foldl)++import Data.Vector.Fixed+import Data.Vector.Fixed.Mutable+import qualified Data.Vector.Fixed.Primitive as P+++----------------------------------------------------------------+-- Data type+----------------------------------------------------------------++data family Vec n a+data family MVec n s a++type Vec2 = Vec (S (S Z))+type Vec3 = Vec (S (S (S Z)))++class (IVector (Vec n) a, MVector (MVec n) a) => Unbox n a+++----------------------------------------------------------------+-- Generic instances+----------------------------------------------------------------++instance (Arity n, Show a, Unbox n a) => Show (Vec n a) where+ show v = "fromList " ++ show (toList v)++type instance Mutable (Vec n) = MVec n++type instance Dim (Vec n) = n+type instance DimM (MVec n) = n++instance (Unbox n a) => Vector (Vec n) a where+ construct = constructVec+ inspect = inspectVec+ {-# INLINE construct #-}+ {-# INLINE inspect #-}+++----------------------------------------------------------------+-- Data instances+----------------------------------------------------------------++-- Unit type+data instance MVec n s () = MV_Unit+data instance Vec n () = V_Unit++instance Arity n => Unbox n ()++instance Arity n => MVector (MVec n) () where+ overlaps _ _ = False+ {-# INLINE overlaps #-}+ new = return MV_Unit+ {-# INLINE new #-}+ copy _ _ = return ()+ {-# INLINE move #-}+ move _ _ = return ()+ {-# INLINE copy #-}+ unsafeRead _ _ = return ()+ {-# INLINE unsafeRead #-}+ unsafeWrite _ _ _ = return ()+ {-# INLINE unsafeWrite #-}++instance Arity n => IVector (Vec n) () where+ unsafeFreeze _ = return V_Unit+ unsafeThaw _ = return MV_Unit+ unsafeIndex _ _ = ()+ {-# INLINE unsafeFreeze #-}+ {-# INLINE unsafeThaw #-}+ {-# INLINE unsafeIndex #-}++++----------------------------------------------------------------+-- Boolean++newtype instance MVec n s Bool = MV_Bool (P.MVec n s Word8)+newtype instance Vec n Bool = V_Bool (P.Vec n Word8)++instance Arity n => Unbox n Bool++instance Arity n => MVector (MVec n) Bool where+ overlaps (MV_Bool v) (MV_Bool w) = overlaps v w+ {-# INLINE overlaps #-}+ new = MV_Bool `liftM` new+ {-# INLINE new #-}+ copy (MV_Bool v) (MV_Bool w) = copy v w+ {-# INLINE copy #-}+ move (MV_Bool v) (MV_Bool w) = move v w+ {-# INLINE move #-}+ unsafeRead (MV_Bool v) i = toBool `liftM` unsafeRead v i+ {-# INLINE unsafeRead #-}+ unsafeWrite (MV_Bool v) i b = unsafeWrite v i (fromBool b)+ {-# INLINE unsafeWrite #-}++instance Arity n => IVector (Vec n) Bool where+ unsafeFreeze (MV_Bool v) = V_Bool `liftM` unsafeFreeze v+ unsafeThaw (V_Bool v) = MV_Bool `liftM` unsafeThaw v+ unsafeIndex (V_Bool v) = toBool . unsafeIndex v+ {-# INLINE unsafeFreeze #-}+ {-# INLINE unsafeThaw #-}+ {-# INLINE unsafeIndex #-}+++fromBool :: Bool -> Word8+{-# INLINE fromBool #-}+fromBool True = 1+fromBool False = 0++toBool :: Word8 -> Bool+{-# INLINE toBool #-}+toBool 0 = False+toBool _ = True+++----------------------------------------------------------------+-- Primitive wrappers+#define primMV(ty,con) \+instance Arity n => MVector (MVec n) ty where { \+; overlaps (con v) (con w) = overlaps v w \+; new = con `liftM` new \+; copy (con v) (con w) = copy v w \+; move (con v) (con w) = move v w \+; unsafeRead (con v) i = unsafeRead v i \+; unsafeWrite (con v) i x = unsafeWrite v i x \+; {-# INLINE overlaps #-} \+; {-# INLINE new #-} \+; {-# INLINE move #-} \+; {-# INLINE copy #-} \+; {-# INLINE unsafeRead #-} \+; {-# INLINE unsafeWrite #-} \+}++#define primIV(ty,con,mcon) \+instance Arity n => IVector (Vec n) ty where { \+; unsafeFreeze (mcon v) = con `liftM` unsafeFreeze v \+; unsafeThaw (con v) = mcon `liftM` unsafeThaw v \+; unsafeIndex (con v) i = unsafeIndex v i \+; {-# INLINE unsafeFreeze #-} \+; {-# INLINE unsafeThaw #-} \+; {-# INLINE unsafeIndex #-} \+}++#define primWrap(ty,con,mcon) \+newtype instance MVec n s ty = mcon (P.MVec n s ty) ; \+newtype instance Vec n ty = con (P.Vec n ty) ; \+instance Arity n => Unbox n ty ; \+primMV(ty, mcon ) ; \+primIV(ty, con, mcon)++++primWrap(Int, V_Int, MV_Int )+primWrap(Int8, V_Int8, MV_Int8 )+primWrap(Int16, V_Int16, MV_Int16)+primWrap(Int32, V_Int32, MV_Int32)+primWrap(Int64, V_Int64, MV_Int64)++primWrap(Word, V_Word, MV_Word )+primWrap(Word8, V_Word8, MV_Word8 )+primWrap(Word16, V_Word16, MV_Word16)+primWrap(Word32, V_Word32, MV_Word32)+primWrap(Word64, V_Word64, MV_Word64)++primWrap(Char, V_Char, MV_Char )+primWrap(Float, V_Float, MV_Float )+primWrap(Double, V_Double, MV_Double)++++----------------------------------------------------------------+-- Complex+newtype instance MVec n s (Complex a) = MV_Complex (MVec n s (a,a))+newtype instance Vec n (Complex a) = V_Complex (Vec n (a,a))++instance (Unbox n a) => Unbox n (Complex a)++instance (Arity n, MVector (MVec n) a) => MVector (MVec n) (Complex a) where+ overlaps (MV_Complex v) (MV_Complex w) = overlaps v w+ {-# INLINE overlaps #-}+ new = MV_Complex `liftM` new+ {-# INLINE new #-}+ copy (MV_Complex v) (MV_Complex w) = copy v w+ {-# INLINE copy #-}+ move (MV_Complex v) (MV_Complex w) = move v w+ {-# INLINE move #-}+ unsafeRead (MV_Complex v) i = do (a,b) <- unsafeRead v i+ return (a :+ b)+ {-# INLINE unsafeRead #-}+ unsafeWrite (MV_Complex v) i (a :+ b) = unsafeWrite v i (a,b)+ {-# INLINE unsafeWrite #-}++instance (Arity n, IVector (Vec n) a) => IVector (Vec n) (Complex a) where+ unsafeFreeze (MV_Complex v) = V_Complex `liftM` unsafeFreeze v + {-# INLINE unsafeFreeze #-}+ unsafeThaw (V_Complex v) = MV_Complex `liftM` unsafeThaw v+ {-# INLINE unsafeThaw #-}+ unsafeIndex (V_Complex v) i =+ case unsafeIndex v i of (a,b) -> a :+ b+ {-# INLINE unsafeIndex #-}++++----------------------------------------------------------------+-- Tuples+data instance MVec n s (a,b) = MV_2 !(MVec n s a) !(MVec n s b)+data instance Vec n (a,b) = V_2 !(Vec n a) !(Vec n b)++instance (Unbox n a, Unbox n b) => Unbox n (a,b)++instance (Arity n, MVector (MVec n) a, MVector (MVec n) b) => MVector (MVec n) (a,b) where+ overlaps (MV_2 va vb) (MV_2 wa wb) = overlaps va wa || overlaps vb wb+ {-# INLINE overlaps #-}+ new = do as <- new+ bs <- new+ return $ MV_2 as bs+ {-# INLINE new #-}+ copy (MV_2 va vb) (MV_2 wa wb) = copy va wa >> copy vb wb+ {-# INLINE copy #-}+ move (MV_2 va vb) (MV_2 wa wb) = move va wa >> move vb wb+ {-# INLINE move #-}+ unsafeRead (MV_2 v w) i = do a <- unsafeRead v i+ b <- unsafeRead w i+ return (a,b)+ {-# INLINE unsafeRead #-}+ unsafeWrite (MV_2 v w) i (a,b) = unsafeWrite v i a >> unsafeWrite w i b+ {-# INLINE unsafeWrite #-}+++instance ( Arity n+ , IVector (Vec n) a, IVector (Vec n) b+ ) => IVector (Vec n) (a,b) where+ unsafeFreeze (MV_2 v w) = do as <- unsafeFreeze v+ bs <- unsafeFreeze w+ return $ V_2 as bs+ {-# INLINE unsafeFreeze #-}+ unsafeThaw (V_2 v w) = do as <- unsafeThaw v+ bs <- unsafeThaw w+ return $ MV_2 as bs+ {-# INLINE unsafeThaw #-}+ unsafeIndex (V_2 v w) i = (unsafeIndex v i, unsafeIndex w i)+ {-# INLINE unsafeIndex #-}+++++data instance MVec n s (a,b,c) = MV_3 !(MVec n s a) !(MVec n s b) !(MVec n s c)+data instance Vec n (a,b,c) = V_3 !(Vec n a) !(Vec n b) !(Vec n c)++instance (Unbox n a, Unbox n b, Unbox n c) => Unbox n (a,b,c)++instance (Arity n, MVector (MVec n) a, MVector (MVec n) b, MVector (MVec n) c+ ) => MVector (MVec n) (a,b,c) where+ overlaps (MV_3 va vb vc) (MV_3 wa wb wc)+ = overlaps va wa || overlaps vb wb || overlaps vc wc+ {-# INLINE overlaps #-}+ new = do as <- new+ bs <- new+ cs <- new+ return $ MV_3 as bs cs+ {-# INLINE new #-}+ copy (MV_3 va vb vc) (MV_3 wa wb wc)+ = copy va wa >> copy vb wb >> copy vc wc+ {-# INLINE copy #-}+ move (MV_3 va vb vc) (MV_3 wa wb wc)+ = move va wa >> move vb wb >> move vc wc+ {-# INLINE move #-}+ unsafeRead (MV_3 v w u) i = do a <- unsafeRead v i+ b <- unsafeRead w i+ c <- unsafeRead u i+ return (a,b,c)+ {-# INLINE unsafeRead #-}+ unsafeWrite (MV_3 v w u) i (a,b,c)+ = unsafeWrite v i a >> unsafeWrite w i b >> unsafeWrite u i c+ {-# INLINE unsafeWrite #-}++instance ( Arity n+ , Vector (Vec n) a, Vector (Vec n) b, Vector (Vec n) c+ , IVector (Vec n) a, IVector (Vec n) b, IVector (Vec n) c+ ) => IVector (Vec n) (a,b,c) where+ unsafeFreeze (MV_3 v w u) = do as <- unsafeFreeze v+ bs <- unsafeFreeze w+ cs <- unsafeFreeze u+ return $ V_3 as bs cs+ {-# INLINE unsafeFreeze #-}+ unsafeThaw (V_3 v w u) = do as <- unsafeThaw v+ bs <- unsafeThaw w+ cs <- unsafeThaw u+ return $ MV_3 as bs cs+ {-# INLINE unsafeThaw #-}+ unsafeIndex (V_3 v w u) i+ = (unsafeIndex v i, unsafeIndex w i, unsafeIndex u i)+ {-# INLINE unsafeIndex #-}
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) Aleksey Khudyakov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY 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 AUTHORS 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.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fixed-vector.cabal view
@@ -0,0 +1,56 @@+Name: fixed-vector+Version: 0.1+Synopsis: Generic vectors with fixed length+Description:+ Generic vectors with fixed length. Package is structured as follows:+ .+ [@Data.Vector.Fixed@]+ Generic API. It's suitable for both ADT-based vector like @Complex@+ and array-based ones.+ .+ [@Data.Vector.Fixed.Mutable@]+ Type classes for array-based implementation.+ .+ [@Data.Vector.Fixed.Unboxed@]+ Unboxed vectors.+ .+ [@Data.Vector.Fixed.Boxed@]+ Boxed vector which can hold elements of any type.+ .+ [@Data.Vector.Fixed.Storable@]+ Unboxed vectors of @Storable@ types.+ .+ [@Data.Vector.Fixed.Primitive@]+ Unboxed vectors based on pritimive package.++Cabal-Version: >= 1.6+License: BSD3+License-File: LICENSE+Author: Aleksey Khudyakov <alexey.skladnoy@gmail.com>+Maintainer: Aleksey Khudyakov <alexey.skladnoy@gmail.com>+Bug-reports: https://github.com/Shimuuar/fixed-vector/issues+Category: Data+Build-Type: Simple++source-repository head+ type: hg+ location: http://bitbucket.org/Shimuuar/fixed-vector+source-repository head+ type: git+ location: http://github.com/Shimuuar/fixed-vector++Library+ Ghc-options: -Wall+ Build-Depends:+ base >=3 && <5,+ primitive+ Exposed-modules:+ -- API+ Data.Vector.Fixed+ Data.Vector.Fixed.Internal+ -- Arrays+ Data.Vector.Fixed.Mutable+ Data.Vector.Fixed.Boxed+ Data.Vector.Fixed.Primitive+ Data.Vector.Fixed.Unboxed+ Data.Vector.Fixed.Storable