diff --git a/Data/Vector/Fixed.hs b/Data/Vector/Fixed.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Fixed.hs
@@ -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 #-}
diff --git a/Data/Vector/Fixed/Boxed.hs b/Data/Vector/Fixed/Boxed.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Fixed/Boxed.hs
@@ -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"
diff --git a/Data/Vector/Fixed/Internal.hs b/Data/Vector/Fixed/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Fixed/Internal.hs
@@ -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
+--
+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
diff --git a/Data/Vector/Fixed/Mutable.hs b/Data/Vector/Fixed/Mutable.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Fixed/Mutable.hs
@@ -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
diff --git a/Data/Vector/Fixed/Primitive.hs b/Data/Vector/Fixed/Primitive.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Fixed/Primitive.hs
@@ -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 #-}
diff --git a/Data/Vector/Fixed/Storable.hs b/Data/Vector/Fixed/Storable.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Fixed/Storable.hs
@@ -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
diff --git a/Data/Vector/Fixed/Unboxed.hs b/Data/Vector/Fixed/Unboxed.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Fixed/Unboxed.hs
@@ -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 #-}
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/fixed-vector.cabal b/fixed-vector.cabal
new file mode 100644
--- /dev/null
+++ b/fixed-vector.cabal
@@ -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
+Maintainer: Aleksey Khudyakov
+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