fixed-vector 0.4.4.0 → 0.5.0.0

raw patch · 13 files changed

+908/−566 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Vector/Fixed.hs +66/−17
• Data/Vector/Fixed/Boxed.hs +6/−3
• Data/Vector/Fixed/Cont.hs +509/−204
• Data/Vector/Fixed/Generic.hs +86/−0
• Data/Vector/Fixed/Internal.hs +147/−94
• Data/Vector/Fixed/Internal/Arity.hs +0/−167
• Data/Vector/Fixed/Internal/Id.hs +0/−27
• Data/Vector/Fixed/Monomorphic.hs +17/−3
• Data/Vector/Fixed/Mutable.hs +16/−15
• Data/Vector/Fixed/Primitive.hs +5/−2
• Data/Vector/Fixed/Storable.hs +4/−2
• Data/Vector/Fixed/Unboxed.hs +5/−1
• fixed-vector.cabal +47/−31

@@ -18,12 +18,12 @@   , Z   , S     -- ** Synonyms for small numerals-  , C.N1-  , C.N2-  , C.N3-  , C.N4-  , C.N5-  , C.N6+  , N1+  , N2+  , N3+  , N4+  , N5+  , N6     -- ** Type class   , Vector(..)   , VectorN@@ -39,11 +39,14 @@   , mk3   , mk4   , mk5-    -- ** Generic constructor-  , New-  , vec-  , con-  , (|>)+    -- ** Consing+  , ContVec+  , empty+  , vector+  , (<|)+    -- ** Variadic function+  , Make+  , mkN     -- ** Functions   , replicate   , replicateM@@ -56,9 +59,17 @@   , head   , tail   , cons+  , snoc+  , reverse+    -- ** Indexing & lenses+  , C.Index   , (!)+  , index+  , element+  , elementTy     -- ** Comparison   , eq+  , ord     -- ** Maps   , map   , mapM@@ -74,6 +85,8 @@   , foldl   , foldr   , foldl1+  , fold+  , foldMap   , ifoldl   , ifoldr   , foldM@@ -101,6 +114,11 @@     -- * Data types   , VecList(..)   , Only(..)+    -- ** Tuple synonyms+  , Tuple2+  , Tuple3+  , Tuple4+  , Tuple5   ) where  import Control.Applicative (Applicative(..),(<$>))@@ -108,32 +126,55 @@ import qualified Data.Foldable    as F import qualified Data.Traversable as T -import Data.Vector.Fixed.Internal.Arity-import Data.Vector.Fixed.Cont     (Vector(..),VectorN,Dim,length)+import Data.Vector.Fixed.Cont     (Vector(..),VectorN,Dim,length,ContVec,vector,+                                   empty,S,Z,Arity,Fun(..),accum,apply,+                                   N1,N2,N3,N4,N5,N6,vector) import qualified Data.Vector.Fixed.Cont as C import Data.Vector.Fixed.Internal  import qualified Prelude as P import Prelude hiding ( replicate,map,zipWith,maximum,minimum,and,or,all,any-                      , foldl,foldr,foldl1,length,sum+                      , foldl,foldr,foldl1,length,sum,reverse                       , head,tail,mapM,mapM_,sequence,sequence_                       )   -- $construction ----- In addition to functions list above it's possible to use tuples in--- conjunction with 'convert' function to create vectors. For example:+-- There are several ways to construct fixed vectors except using+-- their constructor if it's available. For small ones it's possible+-- to use functions 'mk1', 'mk2', etc.+-- +-- >>> mk3 'a' 'b' 'c' :: (Char,Char,Char)+-- ('a','b','c') ----- v = convert (x,y,z)+-- Another option is to create tuple and 'convert' it to desired+-- vector type. For example: --+-- > v = convert (x,y,z)+-- -- It will work on if type of @v@ is know from elsewhere. Same trick -- could be used to pattern match on the vector with opaque -- representation using view patterns -- -- > function :: Vec N3 Double -> ... -- > function (convert -> (x,y,z)) = ...+--+-- Third way is to use variadic function 'mkN'. It works similarly to+-- 'Text.Printf.printf' except it produces result of type 'ContVec'+-- which should be converted to vector of desired type by 'vector':+--+-- >>> vector $ mkN 'a' 'b' 'c' :: (Char,Char,Char)+-- ('a','b','c')+--+-- Probably most generic way is to cons values to the @ContVec@ and+-- convert it vector of desired type using 'vector':+--+-- >>> vector $ 'a' <| 'b' <| 'c' <| empty :: (Char,Char,Char)+-- ('a','b','c') ++ -- $smallDim -- -- Constructors for vectors with small dimensions.@@ -197,6 +238,8 @@   show = show . foldr (:) [] instance (Eq a, Arity n) => Eq (VecList n a) where   (==) = eq+instance (Ord a, Arity n) => Ord (VecList n a) where+  compare = ord instance Arity n => Functor (VecList n) where   fmap = map instance Arity n => Applicative (VecList n) where@@ -228,3 +271,9 @@   inspect (Only a) (Fun f) = f a   {-# INLINE construct #-}   {-# INLINE inspect   #-}+++type Tuple2 a = (a,a)+type Tuple3 a = (a,a,a)+type Tuple4 a = (a,a,a,a)+type Tuple5 a = (a,a,a,a,a)

@@ -4,7 +4,7 @@ {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE DeriveDataTypeable    #-} -- |--- Boxed vector.+-- Vector which could hold any value. module Data.Vector.Fixed.Boxed (     -- * Immutable     Vec@@ -23,8 +23,7 @@ import qualified Data.Traversable as T import Prelude hiding (length,replicate,zipWith,map,foldl,foldr) -import Data.Vector.Fixed-import Data.Vector.Fixed.Internal.Arity+import Data.Vector.Fixed hiding (index) import Data.Vector.Fixed.Mutable  @@ -99,6 +98,10 @@ instance (Arity n, Eq a) => Eq (Vec n a) where   (==) = eq   {-# INLINE (==) #-}+instance (Arity n, Ord a) => Ord (Vec n a) where+  compare = ord+  {-# INLINE compare #-}+  instance Arity n => Functor (Vec n) where   {-# INLINE fmap #-}

@@ -1,3 +1,5 @@+{-# LANGUAGE EmptyDataDecls        #-}+{-# LANGUAGE DeriveDataTypeable    #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE FlexibleContexts      #-}@@ -5,16 +7,13 @@ {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE Rank2Types            #-} -- |--- Continuations-based API+-- API for Church-encoded vectors. Implementation of function from+-- "Data.Vector.Fixed" module uses these function internally in order+-- to provide shortcut fusion. module Data.Vector.Fixed.Cont (-    -- * Vector type class-    Dim-  , Vector(..)-  , VectorN-  , length-    -- * Vector as continuation-  , ContVecT(..)-  , ContVec+    -- * Type-level numbers+    S+  , Z     -- ** Synonyms for small numerals   , N1   , N2@@ -22,12 +21,32 @@   , N4   , N5   , N6+    -- * N-ary functions+  , Fn+  , Fun(..)+  , Arity(..)+  , apply+  , applyM+    -- ** Combinators+  , apFun+  , apLast+  , constFun+  , hideLast+  , shuffleFun+    -- * Vector type class+  , Dim+  , Vector(..)+  , VectorN+  , length+  , Index(..)+    -- * Vector as continuation+  , ContVec(..)     -- * Construction of ContVec   , cvec-  , empty   , fromList   , fromList'   , fromListM+  , toList   , replicate   , replicateM   , generate@@ -35,6 +54,10 @@   , unfoldr   , basis     -- ** Constructors+  , empty+  , cons+  , consV+  , snoc   , mk1   , mk2   , mk3@@ -45,25 +68,26 @@   , imap   , mapM   , imapM+  , mapM_+  , imapM_+  , sequence+  , sequence_   , tail-  , cons-  , changeMonad+  , reverse     -- ** Zips   , zipWith   , izipWith   , zipWithM   , izipWithM     -- * Running ContVec-    -- $running-  , runContVecT-  , runContVecM   , runContVec     -- ** Getters   , head   , index+  , element+  , elementTy     -- ** Vector construction   , vector-  , vectorM     -- ** Folds   , foldl   , foldl1@@ -82,17 +106,208 @@   , any   ) where -import Control.Applicative (Applicative(..))+import Control.Applicative (Applicative(..),(<$>)) import Data.Complex        (Complex(..))-import Data.Vector.Fixed.Internal.Arity-import Data.Vector.Fixed.Internal.Id+import Data.Typeable       (Typeable(..))+import qualified Data.Foldable    as F+import qualified Data.Traversable as F+ import Prelude hiding ( replicate,map,zipWith,maximum,minimum,and,or,any,all-                      , foldl,foldr,foldl1,length,sum+                      , foldl,foldr,foldl1,length,sum,reverse                       , head,tail,mapM,mapM_,sequence,sequence_                       ) +----------------------------------------------------------------+-- Naturals+---------------------------------------------------------------- +-- | Type level zero+data Z   deriving Typeable+-- | Successor of n+data S n deriving Typeable++type N1 = S Z+type N2 = S N1+type N3 = S N2+type N4 = S N3+type N5 = S N4+type N6 = S N5+++ ----------------------------------------------------------------+-- 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. It's also a+--   reader monad.+newtype Fun n a b = Fun { unFun :: 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 #-}++instance Arity n => Applicative (Fun n a) where+  pure (x :: x) = Fun $ accum (\(T_pure r) (_::a) -> T_pure r)+                              (\(T_pure r)        -> r)+                              (T_pure x :: T_pure x n)+  (Fun f0 :: Fun n a (p -> q)) <*> (Fun g0 :: Fun n a p)+    = Fun $ accum (\(T_ap f g) a -> T_ap (f a) (g a))+                  (\(T_ap f g)   -> f g)+                  (T_ap f0 g0 :: T_ap a (p -> q) p n)+  {-# INLINE pure  #-}+  {-# INLINE (<*>) #-}++instance Arity n => Monad (Fun n a) where+  return  = pure+  f >>= g = shuffleFun g <*> f+  {-# INLINE return #-}+  {-# INLINE (>>=)  #-}+++newtype T_fmap a b   n = T_fmap (Fn n a b)+data    T_pure a     n = T_pure a+data    T_ap   a b c n = T_ap (Fn n a b) (Fn n a c)++++----------------------------------------------------------------+-- Generic operations of N-ary functions+----------------------------------------------------------------++-- | Type class for handling /n/-ary functions.+class Arity n where+  -- | Left fold over /n/ elements exposed as n-ary function. These+  --   elements are supplied as arguments to the 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++  -- | Apply all parameters to the function.+  applyFun :: (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, t Z)++  -- | Apply all parameters to the function using monadic+  --   actions. Note that for identity monad it's same as+  --   applyFun. Ignoring newtypes:+  --+  -- > forall b. Fn n a b -> b  ~ ContVecn n a+  applyFunM :: Monad m+              => (forall k. t (S k) -> m (a, t k)) -- ^ Get value to apply to function+              -> t n                               -- ^ Initial value+              -> m (ContVec n a, t Z)+  -- | Arity of function.+  arity :: n -> Int++  -- | Reverse order of parameters.+  reverseF :: Fun n a b -> Fun n a b++++-- | Apply all parameters to the function.+apply :: Arity n+      => (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+{-# INLINE apply #-}+apply step z f = fst $ applyFun step z f++-- | Apply all parameters to the function using monadic actions.+applyM :: (Monad m, Arity n)+         => (forall k. t (S k) -> m (a, t k)) -- ^ Get value to apply to function+         -> t n                               -- ^ Initial value+         -> m (ContVec n a)+{-# INLINE applyM #-}+applyM f t = do (v,_) <- applyFunM f t+                return v++instance Arity Z where+  accum     _ g t = g t+  applyFun  _ t h = (h,t)+  applyFunM _ t   = return (empty, t)+  arity  _ = 0+  reverseF = id+  {-# INLINE accum     #-}+  {-# INLINE applyFun  #-}+  {-# INLINE applyFunM #-}+  {-# INLINE arity     #-}+  {-# INLINE reverseF  #-}+++instance Arity n => Arity (S n) where+  accum     f g t = \a -> accum  f g (f t a)+  applyFun  f t h = case f t of (a,u) -> applyFun f u (h a)+  applyFunM f t   = do (a,t') <- f t+                       (ContVec cont, tZ) <- applyFunM f t'+                       return (ContVec $ \g -> cont (apFun g a) , tZ)+  arity    _ = 1 + arity (undefined :: n)+  reverseF f = Fun $ \a -> unFun (reverseF $ fmap ($ a) $ hideLast f) +  {-# INLINE accum     #-}+  {-# INLINE applyFun  #-}+  {-# INLINE applyFunM #-}+  {-# INLINE arity     #-}+  {-# INLINE reverseF  #-}++++----------------------------------------------------------------+-- Combinators+----------------------------------------------------------------++-- | Apply single parameter to function+apFun :: Fun (S n) a b -> a -> Fun n a b+apFun (Fun f) x = Fun (f x)+{-# INLINE apFun #-}++-- | Apply last parameter to function. Unlike 'apFun' we need to+--   traverse all parameters but last hence 'Arity' constraint.+apLast :: Arity n => Fun (S n) a b -> a -> Fun n a b+apLast f x = fmap ($ x) $ hideLast f+{-# INLINE apLast #-}++-- | Add one parameter to function which is ignored.+constFun :: Fun n a b -> Fun (S n) a b+constFun (Fun f) = Fun $ \_ -> f+{-# INLINE constFun #-}++-- | Move last parameter into function result+hideLast :: forall n a b. Arity n => Fun (S n) a b -> Fun n a (a -> b)+{-# INLINE hideLast #-}+hideLast (Fun f0) = Fun $ accum (\(T_fun f) a -> T_fun (f a))+                                (\(T_fun f)   -> f)+                                (T_fun f0 :: T_fun a b n)+  +newtype T_fun a b n = T_fun (Fn (S n) a b)+++-- | Move function parameter to the result of N-ary function.+shuffleFun :: forall n a b r. Arity n+           => (b -> Fun n a r) -> Fun n a (b -> r)+{-# INLINE shuffleFun #-}+shuffleFun f0+  = Fun $ accum (\(T_shuffle f) a -> T_shuffle $ \x -> f x a)+                (\(T_shuffle f)   -> f)+                (T_shuffle (fmap unFun f0) :: T_shuffle b a r n)++newtype T_shuffle x a r n = T_shuffle (x -> Fn n a r)++++---------------------------------------------------------------- -- Type class for fixed vectors ---------------------------------------------------------------- @@ -112,7 +327,7 @@   -- | Optional more efficient implementation of indexing. Shouldn't   --   be used directly, use 'Data.Vector.Fixed.!' instead.   basicIndex :: v a -> Int -> a-  basicIndex v i = runContVec (index i) (cvec v)+  basicIndex v i = index i (cvec v)   {-# INLINE basicIndex #-}  -- | Vector parametrized by length. In ideal world it should be:@@ -130,16 +345,21 @@ -- | Type class for indexing of vector when index value is known at --   compile time. class Index k n where-  getF :: k -> Fun n a a-  putF :: k -> a -> Fun n a a -> Fun n a a+  getF  :: k -> Fun n a a+  lensF :: Functor f => k -> (a -> f a) -> Fun n a r -> Fun n a (f r)  instance Arity n => Index Z (S n) where-  getF _           = Fun $ \(a :: a) -> unFun (pure a :: Fun n a a)-  putF _ x (Fun f) = Fun $ \_ -> f x+  getF  _       = Fun $ \(a :: a) -> unFun (pure a :: Fun n a a)+  lensF _ f fun = Fun $ \(a :: a) -> unFun $+    (\g -> g <$> f a) <$> shuffleFun (apFun fun)+  {-# INLINE getF  #-}+  {-# INLINE lensF #-}  instance Index k n => Index (S k) (S n) where-  getF _           = Fun $ \(_::a) -> unFun (getF (undefined :: k) :: Fun n a a)-  putF _ x (Fun f) = Fun $ \(a::a) -> unFun $ putF (undefined :: k) x (Fun (f a) :: Fun n a a)+  getF  _       = Fun $ \(_::a) -> unFun (getF  (undefined :: k) :: Fun n a a)+  lensF _ f fun = Fun $ \a      -> unFun (lensF (undefined :: k) f (apFun fun a))+  {-# INLINE getF  #-}+  {-# INLINE lensF #-}   @@ -147,60 +367,76 @@ -- Cont. vectors and their instances ---------------------------------------------------------------- --- | Vector represented as continuation.-newtype ContVecT m n a = ContVecT (forall r. Fun n a (m r) -> m r)+-- | Vector represented as continuation. Alternative wording: it's+--   Church encoded N-element vector.+newtype ContVec n a = ContVec (forall r. Fun n a r -> r) --- | Vector as continuation without monadic context.-type ContVec = ContVecT Id+type instance Dim (ContVec n) = n -instance (Arity n) => Functor (ContVecT m n) where+instance Arity n => Vector (ContVec n) a where+  construct = Fun $+    accum (\(T_mkN f) a -> T_mkN (f . cons a))+          (\(T_mkN f)   -> f empty)+          (T_mkN id :: T_mkN n a n)+  inspect (ContVec c) f = c f+  {-# INLINE construct #-}+  {-# INLINE inspect   #-}++newtype T_mkN n_tot a n = T_mkN (ContVec n a -> ContVec n_tot a)++instance Arity n => VectorN ContVec n a+++instance (Arity n) => Functor (ContVec n) where   fmap = map   {-# INLINE fmap #-} -instance (Arity n) => Applicative (ContVecT m n) where+instance (Arity n) => Applicative (ContVec n) where   pure  = replicate   (<*>) = zipWith ($)   {-# INLINE pure  #-}   {-# INLINE (<*>) #-} --- | Change monad type for the continuation vector.-changeMonad :: (Monad p, Arity n)-            => (forall x. p x -> x) -- ^ Function to extract result from monad-            -> ContVecT p n a -> ContVecT m n a-{-# INLINE changeMonad #-}-changeMonad run (ContVecT cont)-  = ContVecT $ convertCont run return cont+instance (Arity n) => F.Foldable (ContVec n) where+  foldr = foldr+  {-# INLINE foldr #-} -convertCont :: (Arity n)-            => (b -> c)-            -> (c -> b)-            -> (Fun n a b -> b)-            -> (Fun n a c -> c)-{-# INLINE convertCont #-}-convertCont fB2C fC2B cont = \funC ->-  fB2C $ cont (fmap fC2B funC)+instance (Arity n) => F.Traversable (ContVec n) where+  sequenceA v = inspect v $ sequenceAF construct+  {-# INLINE sequenceA #-} +sequenceAF :: forall f n a b. (Applicative f, Arity n)+     => Fun n a b -> Fun n (f a) (f b)+{-# INLINE sequenceAF #-}+sequenceAF (Fun f0)+  = Fun $ accum (\(T_sequenceA f) a -> T_sequenceA (f <*> a))+                (\(T_sequenceA f)   -> f)+                (T_sequenceA (pure f0) :: T_sequenceA f a b n) +newtype T_sequenceA f a b n = T_sequenceA (f (Fn n a b)) ++ ---------------------------------------------------------------- -- Construction ---------------------------------------------------------------- --- | Convert regular vector to continuation-cvec :: (Vector v a, Dim v ~ n, Monad m) => v a -> ContVecT m n a-cvec v = ContVecT (inspect v)+-- | Convert regular vector to continuation based one.+cvec :: (Vector v a, Dim v ~ n) => v a -> ContVec n a+cvec v = ContVec (inspect v) {-# INLINE[0] cvec #-}  -- | Create empty vector.-empty :: ContVecT m Z a+empty :: ContVec Z a {-# INLINE empty #-}-empty = ContVecT (\(Fun r) -> r)+empty = ContVec (\(Fun r) -> r) + -- | Convert list to continuation-based vector. Will throw error if --   list is shorter than resulting vector.-fromList :: forall m n a. Arity n => [a] -> ContVecT m n a+fromList :: forall n a. Arity n => [a] -> ContVec n a {-# INLINE fromList #-}-fromList xs = ContVecT $ \(Fun fun) ->+fromList xs = ContVec $ \(Fun fun) ->   apply step         (T_flist xs :: T_flist a n)         fun@@ -210,9 +446,9 @@  -- | Same as 'fromList' bu throws error is list doesn't have same --   length as vector.-fromList' :: forall m n a. Arity n => [a] -> ContVecT m n a+fromList' :: forall n a. Arity n => [a] -> ContVec n a {-# INLINE fromList' #-}-fromList' xs = ContVecT $ \(Fun fun) ->+fromList' xs = ContVec $ \(Fun fun) ->   let (r,rest) = applyFun step (T_flist xs :: T_flist a n) fun       step (T_flist []    ) = error "Data.Vector.Fixed.Cont.fromList': too few elements"       step (T_flist (a:as)) = (a, T_flist as)@@ -222,47 +458,51 @@  -- | Convert list to continuation-based vector. Will fail with --   'Nothing' if list doesn't have right length.-fromListM :: forall n a. Arity n => [a] -> ContVecT Maybe n a+fromListM :: forall n a. Arity n => [a] -> Maybe (ContVec n a) {-# INLINE fromListM #-}-fromListM xs = ContVecT $ \(Fun fun) -> do-  (r,rest) <- applyFunM step (T_flist xs :: T_flist a n) fun+fromListM xs = do+  (v,rest) <- applyFunM step (T_flist xs :: T_flist a n)   case rest of-    T_flist [] -> return r+    T_flist [] -> return v     _          -> Nothing   where     step (T_flist []    ) = Nothing     step (T_flist (a:as)) = return (a, T_flist as) - data T_flist a n = T_flist [a]  +-- | Convert vector to the list+toList :: (Arity n) => ContVec n a -> [a]+toList = foldr (:) []+{-# INLINE toList #-} + -- | Execute monadic action for every element of vector. Synonym for 'pure'.-replicate :: forall m n a. (Arity n)-          => a -> ContVecT m n a+replicate :: forall n a. (Arity n)+          => a -> ContVec n a {-# INLINE replicate #-}-replicate a = ContVecT $ \(Fun fun) ->+replicate a = ContVec $ \(Fun fun) ->   apply (\T_replicate -> (a, T_replicate))         (T_replicate :: T_replicate n)         fun  -- | Execute monadic action for every element of vector. replicateM :: forall m n a. (Arity n, Monad m)-           => m a -> ContVecT m n a+           => m a -> m (ContVec n a) {-# INLINE replicateM #-}-replicateM act = ContVecT $ \(Fun fun) ->+replicateM act =   applyM (\T_replicate -> do { a <- act; return (a, T_replicate) } )          (T_replicate :: T_replicate n)-         fun + data T_replicate n = T_replicate   -- | Generate vector from function which maps element's index to its value.-generate :: forall m n a. (Arity n) => (Int -> a) -> ContVecT m n a+generate :: forall n a. (Arity n) => (Int -> a) -> ContVec n a {-# INLINE generate #-}-generate f = ContVecT $ \(Fun fun) ->+generate f = ContVec $ \(Fun fun) ->   apply (\(T_generate n) -> (f n, T_generate (n + 1)))         (T_generate 0 :: T_generate n)          fun@@ -270,19 +510,19 @@ -- | Generate vector from monadic function which maps element's index --   to its value. generateM :: forall m n a. (Monad m, Arity n)-           => (Int -> m a) -> ContVecT m n a+           => (Int -> m a) -> m (ContVec n a) {-# INLINE generateM #-}-generateM f = ContVecT $ \(Fun fun) ->+generateM f =   applyM (\(T_generate n) -> do { a <- f n; return (a, T_generate (n + 1)) } )          (T_generate 0 :: T_generate n)-          fun + newtype T_generate n = T_generate Int  -- | Unfold vector.-unfoldr :: forall m n b a. Arity n => (b -> (a,b)) -> b -> ContVecT m n a+unfoldr :: forall n b a. Arity n => (b -> (a,b)) -> b -> ContVec n a {-# INLINE unfoldr #-}-unfoldr f b0 = ContVecT $ \(Fun fun) ->+unfoldr f b0 = ContVec $ \(Fun fun) ->   apply (\(T_unfoldr b) -> let (a,b') = f b in (a, T_unfoldr b'))         (T_unfoldr b0 :: T_unfoldr b n)          fun@@ -291,9 +531,9 @@   -- | Unit vector along Nth axis.-basis :: forall m n a. (Num a, Arity n) => Int -> ContVecT m n a+basis :: forall n a. (Num a, Arity n) => Int -> ContVec n a {-# INLINE basis #-}-basis n0 = ContVecT $ \(Fun fun) ->+basis n0 = ContVec $ \(Fun fun) ->   apply (\(T_basis n) -> ((if n == 0 then 1 else 0) :: a, T_basis (n - 1)))         (T_basis n0 :: T_basis n)         fun@@ -301,54 +541,81 @@ newtype T_basis n = T_basis Int  -mk1 :: a -> ContVecT m N1 a-mk1 a1 = ContVecT $ \(Fun f) -> f a1+mk1 :: a -> ContVec N1 a+mk1 a1 = ContVec $ \(Fun f) -> f a1 {-# INLINE mk1 #-} -mk2 :: a -> a -> ContVecT m N2 a-mk2 a1 a2 = ContVecT $ \(Fun f) -> f a1 a2+mk2 :: a -> a -> ContVec N2 a+mk2 a1 a2 = ContVec $ \(Fun f) -> f a1 a2 {-# INLINE mk2 #-} -mk3 :: a -> a -> a -> ContVecT m N3 a-mk3 a1 a2 a3 = ContVecT $ \(Fun f) -> f a1 a2 a3+mk3 :: a -> a -> a -> ContVec N3 a+mk3 a1 a2 a3 = ContVec $ \(Fun f) -> f a1 a2 a3 {-# INLINE mk3 #-} -mk4 :: a -> a -> a -> a -> ContVecT m N4 a-mk4 a1 a2 a3 a4 = ContVecT $ \(Fun f) -> f a1 a2 a3 a4+mk4 :: a -> a -> a -> a -> ContVec N4 a+mk4 a1 a2 a3 a4 = ContVec $ \(Fun f) -> f a1 a2 a3 a4 {-# INLINE mk4 #-} -mk5 :: a -> a -> a -> a -> a -> ContVecT m N5 a-mk5 a1 a2 a3 a4 a5 = ContVecT $ \(Fun f) -> f a1 a2 a3 a4 a5+mk5 :: a -> a -> a -> a -> a -> ContVec N5 a+mk5 a1 a2 a3 a4 a5 = ContVec $ \(Fun f) -> f a1 a2 a3 a4 a5 {-# INLINE mk5 #-}  + ---------------------------------------------------------------- -- Transforming vectors ----------------------------------------------------------------  -- | Map over vector. Synonym for 'fmap'-map :: (Arity n) => (a -> b) -> ContVecT m n a -> ContVecT m n b+map :: (Arity n) => (a -> b) -> ContVec n a -> ContVec n b {-# INLINE map #-} map = imap . const  -- | Apply function to every element of the vector and its index.-imap :: (Arity n) => (Int -> a -> b) -> ContVecT m n a -> ContVecT m n b+imap :: (Arity n) => (Int -> a -> b) -> ContVec n a -> ContVec n b {-# INLINE imap #-}-imap f (ContVecT contA) = ContVecT $+imap f (ContVec contA) = ContVec $   contA . imapF f  -- | Monadic map over vector.-mapM :: (Arity n, Monad m) => (a -> m b) -> ContVecT m n a -> ContVecT m n b+mapM :: (Arity n, Monad m) => (a -> m b) -> ContVec n a -> m (ContVec n b) {-# INLINE mapM #-} mapM = imapM . const +-- {- -- | Apply monadic function to every element of the vector and its index.-imapM :: (Arity n, Monad m) => (Int -> a -> m b) -> ContVecT m n a -> ContVecT m n b+imapM :: (Arity n, Monad m) => (Int -> a -> m b) -> ContVec n a -> m (ContVec n b) {-# INLINE imapM #-}-imapM f (ContVecT contA) = ContVecT $-  contA . imapFM f+imapM f v+  = inspect v+  $ imapMF f construct   +-- | Apply monadic action to each element of vector and ignore result.+mapM_ :: (Arity n, Monad m) => (a -> m b) -> ContVec n a -> m ()+{-# INLINE mapM_ #-}+mapM_ f = foldl (\m a -> m >> f a >> return ()) (return ()) +-- | Apply monadic action to each element of vector and its index and+--   ignore result.+imapM_ :: (Arity n, Monad m) => (Int -> a -> m b) -> ContVec n a -> m ()+{-# INLINE imapM_ #-}+imapM_ f = ifoldl (\m i a -> m >> f i a >> return ()) (return ())+++imapMF :: forall m n a b r. (Arity n, Monad m)+       => (Int -> a -> m b) -> Fun n b r -> Fun n a (m r)+{-# INLINE imapMF #-}+imapMF f (Fun funB) = Fun $+  accum (\(T_mapM i m) a -> T_mapM (i+1) $ do b   <- f i a+                                              fun <- m+                                              return $ fun b+                           )+        (\(T_mapM _ m) -> m)+        (T_mapM 0 (return funB) :: T_mapM b m r n)++data T_mapM a m r n = T_mapM Int (m (Fn n a r))+     imapF :: forall n a b r. Arity n       => (Int -> a -> b) -> Fun n b r -> Fun n a r {-# INLINE imapF #-}@@ -357,57 +624,73 @@         (\(T_map _ r)   -> r)         (  T_map 0 funB :: T_map b r n) -imapFM :: forall m n a b r. (Arity n, Monad m)-       => (Int -> a -> m b) -> Fun n b (m r) -> Fun n a (m r)-{-# INLINE imapFM #-}-imapFM f (Fun h) = Fun $-  accumM (\(T_map i g) a -> do b <- f i a-                               return $ T_map (i + 1) (g b))-         (\(T_map _ g)   -> g)-         (return $ T_map 0 h :: m (T_map b (m r) n))- data T_map a r n = T_map Int (Fn n a r) +-- | Evaluate every action in the vector from left to right.+sequence :: (Arity n, Monad m) => ContVec n (m a) -> m (ContVec n a)+sequence = mapM id+{-# INLINE sequence #-} +-- | Evaluate every action in the vector from left to right and ignore result.+sequence_ :: (Arity n, Monad m) => ContVec n (m a) -> m ()+sequence_ = mapM_ id+{-# INLINE sequence_ #-}+ -- | /O(1)/ Tail of vector.-tail :: ContVecT m (S n) a-     -> ContVecT m n a-tail (ContVecT cont) = ContVecT $ \(Fun f) -> cont (Fun $ \_ -> f)+tail :: ContVec (S n) a -> ContVec n a+tail (ContVec cont) = ContVec $ \f -> cont $ constFun f {-# INLINE tail #-}  -- | /O(1)/ Prepend element to vector-cons :: a -> ContVecT m n a -> ContVecT m (S n) a-cons a (ContVecT cont) = ContVecT $ \(Fun f) -> cont $ Fun $ f a+cons :: a -> ContVec n a -> ContVec (S n) a+cons a (ContVec cont) = ContVec $ \f -> cont $ apFun f a {-# INLINE cons #-} +-- | Prepend single element to vector.+consV :: forall n a. ContVec (S Z) a -> ContVec n a -> ContVec (S n) a+{-# INLINE consV #-}+consV (ContVec cont1) (ContVec cont)+  = ContVec $ \f -> cont $ apFun f $ cont1 $ Fun id+++-- | /O(1)/ Append element to vector+snoc :: Arity n => a -> ContVec n a -> ContVec (S n) a+snoc a (ContVec cont) = ContVec $ \f -> cont $ apLast f a+{-# INLINE snoc #-}++-- | Reverse order of elements in the vector+reverse :: Arity n => ContVec n a -> ContVec n a+reverse (ContVec cont) = ContVec $ cont . reverseF+{-# INLINE reverse #-}+ -- | Zip two vector together using function. zipWith :: (Arity n) => (a -> b -> c)-        -> ContVecT m n a -> ContVecT m n b -> ContVecT m n c+        -> ContVec n a -> ContVec n b -> ContVec n c {-# INLINE zipWith #-} zipWith = izipWith . const  -- | Zip two vector together using function which takes element index --   as well. izipWith :: (Arity n) => (Int -> a -> b -> c)-         -> ContVecT m n a -> ContVecT m n b -> ContVecT m n c+         -> ContVec n a -> ContVec n b -> ContVec n c {-# INLINE izipWith #-}-izipWith f (ContVecT contA) (ContVecT contB) = ContVecT $ \funC ->-  contA $ fmap contB $ izipWithF f funC+izipWith f vecA vecB = ContVec $ \funC ->+    inspect vecB+  $ inspect vecA+  $ izipWithF f funC  -- | Zip two vector together using monadic function. zipWithM :: (Arity n, Monad m) => (a -> b -> m c)-         -> ContVecT m n a -> ContVecT m n b -> ContVecT m n c+         -> ContVec n a -> ContVec n b -> m (ContVec n c) {-# INLINE zipWithM #-}-zipWithM = izipWithM . const+zipWithM f v w = sequence $ zipWith f v w  -- | Zip two vector together using monadic function which takes element --   index as well.. izipWithM :: (Arity n, Monad m) => (Int -> a -> b -> m c)-          -> ContVecT m n a -> ContVecT m n b -> ContVecT m n c+          -> ContVec n a -> ContVec n b -> m (ContVec n c) {-# INLINE izipWithM #-}-izipWithM f (ContVecT contA) (ContVecT contB) = ContVecT $ \funC ->-  contA $ fmap contB $ izipWithFM f funC-+izipWithM f v w = sequence $ izipWith f v w   izipWithF :: forall n a b c r. (Arity n)@@ -415,25 +698,12 @@ {-# INLINE izipWithF #-} izipWithF f (Fun g0) =   fmap (\v -> Fun $ accum-              (\(T_izip i (a:as) g) b -> T_izip (i+1) as (g $ f i a b)-              )-              (\(T_izip _ _ x) -> x)+              (\(T_izip i (a:as) g) b -> T_izip (i+1) as (g $ f i a b))+              (\(T_izip _ _      x)   -> x)               (T_izip 0 v g0 :: (T_izip a c r n))        ) makeList -izipWithFM :: forall m n a b c r. (Arity n, Monad m)-           => (Int -> a -> b -> m c) -> Fun n c (m r) -> Fun n a (Fun n b (m r))-{-# INLINE izipWithFM #-}-izipWithFM f (Fun g0) =-  fmap (\v -> Fun $ accumM-              (\(T_izip i (a:as) g) b -> do x <- f i a b-                                            return $ T_izip (i+1) as (g x)-              )-              (\(T_izip _ _ x) -> x)-              (return $ T_izip 0 v g0 :: m (T_izip a c (m r) n))-       ) makeList - makeList :: forall n a. Arity n => Fun n a [a] {-# INLINE makeList #-} makeList = Fun $ accum@@ -451,36 +721,13 @@ -- Running vector ---------------------------------------------------------------- --- $running------ Only way to get result from continuation vector is to apply--- finalizer function to them using 'runContVecT', 'runContVecM' or--- 'runContVec'. Getters and folds are defined as such finalizer--- functions.----- | Run continuation vector using non-monadic finalizer.-runContVecT :: (Monad m, Arity n)-            => Fun n a r        -- ^ finalizer function-            -> ContVecT m n a   -- ^ vector-            -> m r-runContVecT f (ContVecT c) = c $ fmap return f-{-# INLINE runContVecT #-}---- | Run continuation vector using monadic finalizer.-runContVecM :: Arity n-            => Fun n a (m r)    -- ^ finalizer function-            -> ContVecT m n a   -- ^ vector-            -> m r-runContVecM f (ContVecT c) = c f-{-# INLINE runContVecM #-}---- | Run continuation vector.+-- | Run continuation vector. It's same as 'inspect' but with+--   arguments flipped. runContVec :: Arity n            => Fun n a r            -> ContVec n a            -> r-runContVec f (ContVecT c) = runID $ c (fmap return f)+runContVec f (ContVec c) = c f {-# INLINE runContVec #-}  -- | Convert continuation to the vector.@@ -488,25 +735,24 @@ vector = runContVec construct {-# INLINE[1] vector #-} --- | Convert continuation to the vector.-vectorM :: (Vector v a, Dim v ~ n, Monad m) => ContVecT m n a -> m (v a)-vectorM = runContVecT construct-{-# INLINE[1] vectorM #-}- -- | Finalizer function for getting head of the vector.-head :: forall n a. Arity (S n) => Fun (S n) a a+head :: forall n a. Arity (S n) => ContVec (S n) a -> a {-# INLINE head #-}-head = 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))+head+  = runContVec $ 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))  data T_head a n = T_head (Maybe a) + -- | /O(n)/ Get value at specified index.-index :: forall n a. Arity n => Int -> Fun n a a+index :: forall n a. Arity n => Int -> ContVec n a -> a+{-# INLINE index #-} index n   | n < 0     = error "Data.Vector.Fixed.Cont.index: index out of range"-  | otherwise = Fun $ accum+  | otherwise = runContVec $ Fun $ accum      (\(T_Index x) a -> T_Index $ case x of                           Left  0 -> Right a                           Left  i -> Left (i - 1)@@ -521,109 +767,150 @@ newtype T_Index a n = T_Index (Either Int a)  +-- | Twan van Laarhoven lens for continuation based vector+element :: (Arity n, Functor f)+        => Int -> (a -> f a) -> ContVec n a -> f (ContVec n a)+{-# INLINE element #-}+element i f v = inspect v+              $ elementF i f construct++-- | Twan van Laarhoven's lens for element of vector with statically+--   known index.+elementTy :: (Arity n, Index k n, Functor f)+          => k -> (a -> f a) -> ContVec n a -> f (ContVec n a)+{-# INLINE elementTy #-}+elementTy k f v = inspect v+                $ lensF k f construct+++-- | Helper for implementation of Twan van Laarhoven lens.+elementF :: forall a n f r. (Arity n, Functor f)+         => Int -> (a -> f a) -> Fun n a r -> Fun n a (f r)+{-# INLINE elementF #-}+elementF n f (Fun fun0) = Fun $ accum step fini start+  where+    step :: forall k. T_lens f a r (S k) -> a -> T_lens f a r k+    step (T_lens (Left (0,fun))) a = T_lens $ Right $ fmap fun $ f a+    step (T_lens (Left (i,fun))) a = T_lens $ Left (i-1, fun a)+    step (T_lens (Right fun))    a = T_lens $ Right $ fmap ($ a) fun+    --+    fini :: T_lens f a r Z -> f r+    fini (T_lens (Left  _)) = error "Data.Vector.Fixed.lensF: Index out of range"+    fini (T_lens (Right r)) = r +    --+    start :: T_lens f a r n+    start = T_lens $ Left (n,fun0)++data T_lens f a r n = T_lens (Either (Int,(Fn n a r)) (f (Fn n a r)))+++ -- | Left fold over continuation vector.-foldl :: forall n a b. Arity n-      => (b -> a -> b) -> b -> Fun n a b+foldl :: Arity n => (b -> a -> b) -> b -> ContVec n a -> b {-# INLINE foldl #-} foldl f = ifoldl (\b _ a -> f b a)  -- | Left fold over continuation vector. ifoldl :: forall n a b. Arity n-       => (b -> Int -> a -> b) -> b -> Fun n a b+       => (b -> Int -> a -> b) -> b -> ContVec n a -> b {-# INLINE ifoldl #-}-ifoldl f b = Fun $ accum (\(T_ifoldl i r) a -> T_ifoldl (i+1) (f r i a))-                         (\(T_ifoldl _ r) -> r)-                         (T_ifoldl 0 b :: T_ifoldl b n)+ifoldl f b v+  = inspect v $ Fun+  $ accum (\(T_ifoldl i r) a -> T_ifoldl (i+1) (f r i a))+          (\(T_ifoldl _ r) -> r)+          (T_ifoldl 0 b :: T_ifoldl b n)  -- | Monadic left fold over continuation vector.-foldM :: forall n m a b. (Arity n, Monad m)-      => (b -> a -> m b) -> b -> Fun n a (m b)+foldM :: (Arity n, Monad m)+      => (b -> a -> m b) -> b -> ContVec n a -> m b {-# INLINE foldM #-} foldM f x   = foldl (\m a -> do{ b <- m; f b a}) (return x)  -- | Monadic left fold over continuation vector.-ifoldM :: forall n m a b. (Arity n, Monad m)-      => (b -> Int -> a -> m b) -> b -> Fun n a (m b)+ifoldM :: (Arity n, Monad m)+       => (b -> Int -> a -> m b) -> b -> ContVec n a -> m b {-# INLINE ifoldM #-} ifoldM f x   = ifoldl (\m i a -> do{ b <- m; f b i a}) (return x)  data T_ifoldl b n = T_ifoldl !Int b --- Implementation of foldl1F is particularly ugly. It could be--- expressed in terms of foldlF:+-- Implementation of foldl1 is quite ugly. It could be expressed in+-- terms of foldlF (worker function for foldl) -- -- > 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--- 'Arity n' begin to propagate through contexts. It's not acceptable.+-- But it require constraint `Arity n` whereas `Vector v a` gives+-- `Arity (S n)`.  Latter imply former but GHC cannot infer it.  newtype T_foldl1 a n = T_foldl1 (Maybe a)  -- | Left fold. foldl1 :: forall n a. (Arity (S n))-       => (a -> a -> a) -> Fun (S n) a a+       => (a -> a -> a) -> ContVec (S n) a -> a {-# INLINE foldl1 #-}-foldl1 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))+foldl1 f+  = runContVec $ 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))  -- | Right fold over continuation vector-foldr :: forall n a b. Arity n-      => (a -> b -> b) -> b -> Fun n a b+foldr :: Arity n => (a -> b -> b) -> b -> ContVec n a -> b {-# INLINE foldr #-} foldr = ifoldr . const  -- | Right fold over continuation vector ifoldr :: forall n a b. Arity n-      => (Int -> a -> b -> b) -> b -> Fun n a b+      => (Int -> a -> b -> b) -> b -> ContVec n a -> b {-# INLINE ifoldr #-}-ifoldr f z = Fun $-  accum (\(T_ifoldr i g) a -> T_ifoldr (i+1) (g . f i a))-        (\(T_ifoldr _ g)   -> g z)-        (T_ifoldr 0 id :: T_ifoldr b n)+ifoldr f z+  = runContVec $ Fun+  $ accum (\(T_ifoldr i g) a -> T_ifoldr (i+1) (g . f i a))+          (\(T_ifoldr _ g)   -> g z)+          (T_ifoldr 0 id :: T_ifoldr b n)   data T_ifoldr b n = T_ifoldr Int (b -> b)  -- | Sum all elements in the vector.-sum :: (Num a, Arity n) => Fun n a a+sum :: (Num a, Arity n) => ContVec n a -> a sum = foldl (+) 0 {-# INLINE sum #-}  -- | Minimal element of vector.-minimum :: (Ord a, Arity (S n)) => Fun (S n) a a+minimum :: (Ord a, Arity (S n)) => ContVec (S n) a -> a minimum = foldl1 min {-# INLINE minimum #-}  -- | Maximal element of vector.-maximum :: (Ord a, Arity (S n)) => Fun (S n) a a+maximum :: (Ord a, Arity (S n)) => ContVec (S n) a -> a maximum = foldl1 max {-# INLINE maximum #-}  -- | Conjunction of elements of a vector.-and :: Arity n => Fun n Bool Bool+and :: Arity n => ContVec n Bool -> Bool and = foldr (&&) True {-# INLINE and #-}  -- | Disjunction of all elements of a vector.-or :: Arity n => Fun n Bool Bool+or :: Arity n => ContVec n Bool -> Bool or = foldr (||) False {-# INLINE or #-}  -- | Determines whether all elements of vector satisfy predicate.-all :: Arity n => (a -> Bool) -> Fun n a Bool+all :: Arity n => (a -> Bool) -> ContVec n a -> Bool all f = foldr (\x b -> f x && b) True {-# INLINE all #-}  -- | Determines whether any of element of vector satisfy predicate.-any :: Arity n => (a -> Bool) -> Fun n a Bool+any :: Arity n => (a -> Bool) -> ContVec n a -> Bool any f = foldr (\x b -> f x && b) True {-# INLINE any #-}  +                                            ---------------------------------------------------------------- -- Deforestation ----------------------------------------------------------------@@ -652,7 +939,7 @@  {-# RULES "cvec/vector" forall v.-  cvec (vector v) = changeMonad runID v+  cvec (vector v) = v   #-}   @@ -665,13 +952,21 @@ instance RealFloat a => Vector Complex a where   construct = Fun (:+)   inspect (x :+ y) (Fun f) = f x y+  {-# INLINE construct #-}+  {-# INLINE inspect #-}   type instance Dim ((,) a) = N2 +-- | Note this instance (and other instances for tuples) is+--   essentially monomorphic in element type. Vector type /v/ of 2+--   element tuple @(Int,Int)@ is @(,) Int@ so it will only work+--   with elements of type @Int@. instance (b~a) => Vector ((,) b) a where   construct = Fun (,)   inspect (a,b) (Fun f) = f a b+  {-# INLINE construct #-}+  {-# INLINE inspect #-}   type instance Dim ((,,) a b) = N3@@ -679,6 +974,8 @@ instance (b~a, c~a) => Vector ((,,) b c) a where   construct = Fun (,,)   inspect (a,b,c) (Fun f) = f a b c+  {-# INLINE construct #-}+  {-# INLINE inspect #-}   type instance Dim ((,,,) a b c) = N4@@ -686,6 +983,8 @@ instance (b~a, c~a, d~a) => Vector ((,,,) b c d) a where   construct = Fun (,,,)   inspect (a,b,c,d) (Fun f) = f a b c d+  {-# INLINE construct #-}+  {-# INLINE inspect #-}   type instance Dim ((,,,,) a b c d) = N5@@ -693,6 +992,8 @@ instance (b~a, c~a, d~a, e~a) => Vector ((,,,,) b c d e) a where   construct = Fun (,,,,)   inspect (a,b,c,d,e) (Fun f) = f a b c d e+  {-# INLINE construct #-}+  {-# INLINE inspect #-}   type instance Dim ((,,,,,) a b c d e) = N6@@ -700,6 +1001,8 @@ instance (b~a, c~a, d~a, e~a, f~a) => Vector ((,,,,,) b c d e f) a where   construct = Fun (,,,,,)   inspect (a,b,c,d,e,f) (Fun fun) = fun a b c d e f+  {-# INLINE construct #-}+  {-# INLINE inspect #-}   type instance Dim ((,,,,,,) a b c d e f) = S N6@@ -707,3 +1010,5 @@ instance (b~a, c~a, d~a, e~a, f~a, g~a) => Vector ((,,,,,,) b c d e f g) a where   construct = Fun (,,,,,,)   inspect (a,b,c,d,e,f,g) (Fun fun) = fun a b c d e f g+  {-# INLINE construct #-}+  {-# INLINE inspect #-}

@@ -0,0 +1,86 @@+{-# LANGUAGE TypeFamilies #-}+-- |+-- More generic version of function from "Data.Vector.Fixed"+-- module. They do not require that all vector have same type, only+-- same length. All such functions have suffix /G/.+module Data.Vector.Fixed.Generic (+    -- * Mapping+    mapG+  , imapG+  , mapMG+  , imapMG+    -- * Zips+  , zipWithG+  , izipWithG+  , zipWithMG+  , izipWithMG+  ) where++import Control.Monad (liftM)+import           Data.Vector.Fixed.Cont (Vector,Dim)+import qualified Data.Vector.Fixed.Cont as C++++-- | Map over vector+mapG :: (Vector v a, Vector w b, Dim v ~ Dim w)+     => (a -> b) -> v a -> w b+{-# INLINE mapG #-}+mapG f = C.vector+       . C.map f+       . C.cvec++-- | Apply function to every element of the vector and its index.+imapG :: (Vector v a, Vector w b, Dim v ~ Dim w)+      => (Int -> a -> b) -> v a -> w b+{-# INLINE imapG #-}+imapG f = C.vector+        . C.imap f+        . C.cvec++-- | Monadic map over vector.+mapMG :: (Vector v a, Vector w b, Dim w ~ Dim v, Monad m)+      => (a -> m b) -> v a -> m (w b)+{-# INLINE mapMG #-}+mapMG f = liftM C.vector+       . C.mapM f+       . C.cvec++-- | Monadic map over vector.+imapMG :: (Vector v a, Vector w b, Dim w ~ Dim v, Monad m)+       => (Int -> a -> m b) -> v a -> m (w b)+{-# INLINE imapMG #-}+imapMG f = liftM C.vector+         . C.imapM f+         . C.cvec+++-- | Zip two vector together using function.+zipWithG :: (Vector v a, Vector w b, Vector u c, Dim v ~ Dim u, Dim v ~ Dim w)+         => (a -> b -> c) -> v a -> w b -> u c+{-# INLINE zipWithG #-}+zipWithG f v u = C.vector+               $ C.zipWith f (C.cvec v) (C.cvec u)++-- | Zip two vector together using monadic function.+zipWithMG :: (Vector v a, Vector w b, Vector u c, Dim v ~ Dim u, Dim v ~ Dim w, Monad m)+          => (a -> b -> m c) -> v a -> w b -> m (u c)+{-# INLINE zipWithMG #-}+zipWithMG f v u = liftM C.vector+                $ C.zipWithM f (C.cvec v) (C.cvec u)++-- | Zip two vector together using function which takes element index+--   as well.+izipWithG :: (Vector v a, Vector w b, Vector u c, Dim v ~ Dim u, Dim v ~ Dim w)+          => (Int -> a -> b -> c) -> v a -> w b -> u c+{-# INLINE izipWithG #-}+izipWithG f v u = C.vector+                $ C.izipWith f (C.cvec v) (C.cvec u)++-- | Zip two vector together using monadic function which takes element+--   index as well..+izipWithMG :: (Vector v a, Vector w b, Vector u c, Dim v ~ Dim u, Dim v ~ Dim w, Monad m)+           => (Int -> a -> b -> m c) -> v a -> w b -> m (u c)+{-# INLINE izipWithMG #-}+izipWithMG f v u = liftM C.vector+                 $ C.izipWithM f (C.cvec v) (C.cvec u)

@@ -1,93 +1,95 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE Rank2Types            #-}-{-# LANGUAGE FlexibleContexts      #-} -- | -- Implementation of fixed-vectors module Data.Vector.Fixed.Internal where  import Control.Applicative (Applicative)+import Control.Monad       (liftM)+import Data.Monoid         (Monoid(..)) import qualified Data.Foldable    as T import qualified Data.Traversable as T -import Data.Vector.Fixed.Internal.Arity-import Data.Vector.Fixed.Cont     (Vector(..),Dim)++import Data.Vector.Fixed.Cont     (Vector(..),Dim,S,Z,Arity,vector) import qualified Data.Vector.Fixed.Cont as C+import           Data.Vector.Fixed.Cont   (ContVec,Index) import qualified Prelude as P import Prelude hiding ( replicate,map,zipWith,maximum,minimum,and,or,all,any-                      , foldl,foldr,foldl1,length,sum+                      , foldl,foldr,foldl1,length,sum,reverse                       , head,tail,mapM,mapM_,sequence,sequence_                       )  - ------------------------------------------------------------------- Generic functions+-- Constructors ---------------------------------------------------------------- --- TODO: does not fuse!---- | Generic function for construction of arbitrary vectors. It---   represents partially constructed vector where /n/ is number of---   uninitialized elements, /v/ is type of vector and /a/ element type.------   Uninitialized vector could be obtained from 'con' and vector---   elements could be added from left to right using '|>' operator.---   Finally it could be converted to vector using 'vec' function.------   Construction of complex number which could be seen as 2-element vector:+-- | Variadic vector constructor. Resulting vector should be converted+--   from 'ContVec' using 'vector' function.  For example: -----   >>> import Data.Complex---   >>> vec $ con |> 1 |> 3 :: Complex Double---   1.0 :+ 3.0-newtype New n v a = New (Fn n a (v a))+-- >>> vector $ mkN 'a' 'b' 'c' :: (Char,Char,Char)+-- ('a','b','c')+mkN :: Make (S Z) a r => a -> r+mkN = unGo $ make id+{-# INLINE mkN #-} --- | 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+-- | Type class for variadic vector constructors.+class Make n a r where+  make :: (ContVec Z a -> ContVec n a) -> r --- | Apply another element to vector-(|>) :: New (S n) v a -> a -> New n v a-{-# INLINE  (|>) #-}-New f |> a = New (f a)-infixl 1 |>+instance (a'~a, Make (S n) a r) => Make n a' (a -> r) where+  make f a = make (C.cons a . f)+  {-# INLINE make #-} -f2n :: Fun n a (v a) -> New n v a-{-# INLINE f2n #-}-f2n (Fun f) = New f+instance Arity n =>  Make n a (ContVec n a) where+  make f = C.reverse $ f C.empty+  {-# INLINE make #-} +newtype Go r = Go { unGo :: r } +instance Make Z a r => Make Z a (Go r) where+  make f = Go $ make f+  {-# INLINE make #-} -----------------------------------------------------------------+-- | Cons value to continuation based vector.+(<|) :: a -> ContVec n a -> ContVec (S n) a+(<|) = C.cons+{-# INLINE (<|) #-} +infixr 1 <|+++ mk1 :: (Vector v a, Dim v ~ C.N1) => a -> v a-mk1 a1 = C.vector $ C.mk1 a1+mk1 a1 = vector $ C.mk1 a1 {-# INLINE mk1 #-}  mk2 :: (Vector v a, Dim v ~ C.N2) => a -> a -> v a-mk2 a1 a2 = C.vector $ C.mk2 a1 a2+mk2 a1 a2 = vector $ C.mk2 a1 a2 {-# INLINE mk2 #-}  mk3 :: (Vector v a, Dim v ~ C.N3) => a -> a -> a -> v a-mk3 a1 a2 a3 = C.vector $ C.mk3 a1 a2 a3+mk3 a1 a2 a3 = vector $ C.mk3 a1 a2 a3 {-# INLINE mk3 #-}  mk4 :: (Vector v a, Dim v ~ C.N4) => a -> a -> a -> a -> v a-mk4 a1 a2 a3 a4 = C.vector $ C.mk4 a1 a2 a3 a4+mk4 a1 a2 a3 a4 = vector $ C.mk4 a1 a2 a3 a4 {-# INLINE mk4 #-}  mk5 :: (Vector v a, Dim v ~ C.N5) => a -> a -> a -> a -> a -> v a-mk5 a1 a2 a3 a4 a5 = C.vector $ C.mk5 a1 a2 a3 a4 a5+mk5 a1 a2 a3 a4 a5 = vector $ C.mk5 a1 a2 a3 a4 a5 {-# INLINE mk5 #-}    ----------------------------------------------------------------+-- Generic functions+----------------------------------------------------------------  -- | Replicate value /n/ times. --@@ -100,13 +102,13 @@ --   >>> replicate 2 :: (Double,Double,Double) --   (2.0,2.0,2.0) -----   >>> import Data.Vector.Fixed.Boxed (Vec)---   >>> replicate "foo" :: Vec N5 String---   fromList ["foo","foo","foo","foo","foo"]+--   >>> import Data.Vector.Fixed.Boxed (Vec4)+--   >>> replicate "foo" :: Vec4 String+--   fromList ["foo","foo","foo","foo"] replicate :: Vector v a => a -> v a {-# INLINE replicate #-} replicate-  = C.vector . C.replicate+  = vector . C.replicate   -- | Execute monadic action for every element of vector.@@ -123,7 +125,7 @@ replicateM :: (Vector v a, Monad m) => m a -> m (v a) {-# INLINE replicateM #-} replicateM-  = C.vectorM . C.replicateM+  = liftM vector . C.replicateM   -- | Unit vector along Nth axis. If index is larger than vector@@ -140,13 +142,13 @@ --   fromList [0,0,0] basis :: (Vector v a, Num a) => Int -> v a {-# INLINE basis #-}-basis = C.vector . C.basis+basis = vector . C.basis   -- | Unfold vector. unfoldr :: (Vector v a) => (b -> (a,b)) -> b -> v a {-# INLINE unfoldr #-}-unfoldr f = C.vector . C.unfoldr f+unfoldr f = vector . C.unfoldr f   -- | Generate vector from function which maps element's index to its@@ -154,19 +156,19 @@ -- --   Examples: -----   >>> import Data.Vector.Fixed.Unboxed (Vec)---   >>> generate (^2) :: Vec N4 Int+--   >>> import Data.Vector.Fixed.Unboxed (Vec4)+--   >>> generate (^2) :: Vec4 Int --   fromList [0,1,4,9] generate :: (Vector v a) => (Int -> a) -> v a {-# INLINE generate #-}-generate = C.vector . C.generate+generate = vector . C.generate   -- | Generate vector from monadic function which maps element's index --   to its value. generateM :: (Monad m, Vector v a) => (Int -> m a) -> m (v a) {-# INLINE generateM #-}-generateM = C.vectorM . C.generateM+generateM = liftM vector . C.generateM   @@ -182,7 +184,7 @@ --   1 head :: (Vector v a, Dim v ~ S n) => v a -> a {-# INLINE head #-}-head = C.runContVec C.head . C.cvec+head = C.head . C.cvec   -- | Tail of vector.@@ -195,14 +197,25 @@ tail :: (Vector v a, Vector w a, Dim v ~ S (Dim w))      => v a -> w a {-# INLINE tail #-}-tail = C.vector . C.tail . C.cvec+tail = vector . C.tail . C.cvec  -- | Cons element to the vector cons :: (Vector v a, Vector w a, S (Dim v) ~ Dim w)      => a -> v a -> w a {-# INLINE cons #-}-cons a = C.vector . C.cons a . C.cvec+cons a = vector . C.cons a . C.cvec +-- | Append element to the vector+snoc :: (Vector v a, Vector w a, S (Dim v) ~ Dim w)+     => a -> v a -> w a+{-# INLINE snoc #-}+snoc a = vector . C.snoc a . C.cvec++-- | Reverse order of elements in the vector+reverse :: Vector v a => v a -> v a+reverse = vector . C.reverse . C.cvec+{-# INLINE reverse #-}+ -- | Retrieve vector's element at index. Generic implementation is --   /O(n)/ but more efficient one is used when possible. (!) :: (Vector v a) => v a -> Int -> a@@ -211,56 +224,85 @@  -- Used in rewriting of index function. runIndex :: Arity n => Int -> C.ContVec n r -> r-runIndex n = C.runContVec (C.index n)+runIndex = C.index {-# INLINE[0] runIndex #-} +-- | Get element from vector at statically known index+index :: (Vector v a, C.Index k (Dim v)) => v a -> k -> a+{-# INLINE index #-}+index v k = C.runContVec (C.getF k)+          $ C.cvec v  ++-- | Twan van Laarhoven's lens for element of vector+element :: (Vector v a, Functor f) => Int -> (a -> f a) -> (v a -> f (v a))+{-# INLINE element #-}+element i f v = vector `fmap` C.element i f (C.cvec v)++-- | Twan van Laarhoven's lens for element of vector with statically+--   known index.+elementTy :: (Vector v a, Index k (Dim v), Functor f)+          => k -> (a -> f a) -> (v a -> f (v a))+{-# INLINE elementTy #-}+elementTy k f v = vector `fmap` C.elementTy k f (C.cvec v)+++ -- | Left fold over vector foldl :: Vector v a => (b -> a -> b) -> b -> v a -> b {-# INLINE foldl #-}-foldl f x = C.runContVec (C.foldl f x)+foldl f x = C.foldl f x           . C.cvec  -- | Right fold over vector foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b {-# INLINE foldr #-}-foldr f x = C.runContVec (C.foldr f x)+foldr f x = C.foldr f x           . C.cvec   -- | Left fold over vector foldl1 :: (Vector v a, Dim v ~ S n) => (a -> a -> a) -> v a -> a {-# INLINE foldl1 #-}-foldl1 f = C.runContVec (C.foldl1 f)+foldl1 f = C.foldl1 f          . C.cvec +-- | Combine the elements of a structure using a monoid. Similar to+--   'T.fold'+fold :: (Vector v m, Monoid m) => v m -> m+{-# INLINE fold #-}+fold = T.fold+     . C.cvec++-- | Map each element of the structure to a monoid,+--   and combine the results. Similar to 'T.foldMap'+foldMap :: (Vector v a, Monoid m) => (a -> m) -> v a -> m+{-# INLINE foldMap #-}+foldMap f = T.foldMap f+          . C.cvec+ -- | Left fold over vector ifoldr :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b {-# INLINE ifoldr #-}-ifoldr f x = C.runContVec (C.ifoldr f x)+ifoldr f x = C.ifoldr f x            . C.cvec  -- | Left fold over vector. Function is applied to each element and --   its index. ifoldl :: Vector v a => (b -> Int -> a -> b) -> b -> v a -> b {-# INLINE ifoldl #-}-ifoldl f z = C.runContVec (C.ifoldl f z)+ifoldl f z = C.ifoldl f z            . C.cvec  -- | 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+foldM f x = C.foldM f x . C.cvec  -- | Left monadic fold over vector. Function is applied to each element and --   its index. ifoldM :: (Vector v a, Monad m) => (b -> Int -> a -> m b) -> b -> v a -> m b {-# INLINE ifoldM #-}-ifoldM f x v = ifoldl go (return x) v-  where-    go m i a = do { b <- m; f b i a }+ifoldM f x = C.ifoldM f x . C.cvec   @@ -268,7 +310,7 @@  -- | Sum all elements in the vector. sum :: (Vector v a, Num a) => v a -> a-sum = C.runContVec C.sum . C.cvec+sum = C.sum . C.cvec {-# INLINE sum #-}  -- | Maximal element of vector.@@ -280,7 +322,7 @@ --   >>> maximum x --   3 maximum :: (Vector v a, Dim v ~ S n, Ord a) => v a -> a-maximum = C.runContVec C.maximum . C.cvec+maximum = C.maximum . C.cvec {-# INLINE maximum #-}  -- | Minimal element of vector.@@ -292,27 +334,27 @@ --   >>> minimum x --   1 minimum :: (Vector v a, Dim v ~ S n, Ord a) => v a -> a-minimum = C.runContVec C.minimum . C.cvec+minimum = C.minimum . C.cvec {-# INLINE minimum #-}  -- | Conjunction of all elements of a vector. and :: (Vector v Bool) => v Bool -> Bool-and = C.runContVec C.and . C.cvec+and = C.and . C.cvec {-# INLINE and #-}  -- | Disjunction of all elements of a vector. or :: (Vector v Bool) => v Bool -> Bool-or = C.runContVec C.or . C.cvec+or = C.or . C.cvec {-# INLINE or #-}  -- | Determines whether all elements of vector satisfy predicate. all :: (Vector v a) => (a -> Bool) -> v a -> Bool-all f = C.runContVec (C.all f) . C.cvec+all f = (C.all f) . C.cvec {-# INLINE all #-}  -- | Determines whether any of element of vector satisfy predicate. any :: (Vector v a) => (a -> Bool) -> v a -> Bool-any f = C.runContVec (C.any f) . C.cvec+any f = (C.any f) . C.cvec {-# INLINE any #-}  @@ -331,16 +373,24 @@ --   False eq :: (Vector v a, Eq a) => v a -> v a -> Bool {-# INLINE eq #-}-eq v w = C.runContVec C.and+eq v w = C.and        $ C.zipWith (==) (C.cvec v) (C.cvec w)  +-- | Lexicographic ordering of two vectors.+ord :: (Vector v a, Ord a) => v a -> v a -> Ordering+{-# INLINE ord #-}+ord v w = C.foldl mappend mempty+        $ C.zipWith compare (C.cvec v) (C.cvec w)+++ ----------------------------------------------------------------  -- | Map over vector map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b {-# INLINE map #-}-map f = C.vector+map f = vector       . C.map f       . C.cvec @@ -358,7 +408,7 @@ -- | 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 = C.vectorM+mapM f = liftM vector        . C.mapM f        . C.cvec @@ -372,15 +422,15 @@ imap :: (Vector v a, Vector v b) =>     (Int -> a -> b) -> v a -> v b {-# INLINE imap #-}-imap f = C.vector+imap f = vector        . C.imap f        . C.cvec  -- | Apply monadic function to every element of the vector and its index.-imapM :: (Vector v a, Vector v b, Monad m) =>-    (Int -> a -> m b) -> v a -> m (v b)+imapM :: (Vector v a, Vector v b, Monad m)+      => (Int -> a -> m b) -> v a -> m (v b) {-# INLINE imapM #-}-imapM f = C.vectorM+imapM f = liftM vector         . C.imapM f         . C.cvec @@ -395,14 +445,16 @@ sequenceA :: (Vector v a, Vector v (f a), Applicative f)           => v (f a) -> f (v a) {-# INLINE sequenceA #-}-sequenceA = fmap fromList . T.sequenceA . toList+sequenceA = fmap vector . T.sequenceA . C.cvec  -- | Analog of 'T.traverse' from 'T.Traversable'. traverse :: (Vector v a, Vector v b, Applicative f)           => (a -> f b) -> v a -> f (v b) {-# INLINE traverse #-}-traverse f = fmap fromList . T.traverse f . toList+traverse f = fmap vector . T.traverse f . C.cvec ++ ----------------------------------------------------------------  -- | Zip two vector together using function.@@ -423,14 +475,14 @@ 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 = C.vector+zipWith f v u = vector               $ C.zipWith f (C.cvec v) (C.cvec u)  -- | Zip two vector together using monadic function. zipWithM :: (Vector v a, Vector v b, Vector v c, Monad m)          => (a -> b -> m c) -> v a -> v b -> m (v c) {-# INLINE zipWithM #-}-zipWithM f v u = C.vectorM+zipWithM f v u = liftM vector                $ C.zipWithM f (C.cvec v) (C.cvec u)  -- | Zip two vector together using function which takes element index@@ -438,7 +490,7 @@ 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 = C.vector+izipWith f v u = vector                $ C.izipWith f (C.cvec v) (C.cvec u)  -- | Zip two vector together using monadic function which takes element@@ -446,7 +498,7 @@ izipWithM :: (Vector v a, Vector v b, Vector v c, Monad m)           => (Int -> a -> b -> m c) -> v a -> v b -> m (v c) {-# INLINE izipWithM #-}-izipWithM f v u = C.vectorM+izipWithM f v u = liftM vector                 $ C.izipWithM f (C.cvec v) (C.cvec u)  @@ -455,29 +507,30 @@ -- | Convert between different vector types convert :: (Vector v a, Vector w a, Dim v ~ Dim w) => v a -> w a {-# INLINE convert #-}-convert = C.vector . C.cvec+convert = vector . C.cvec  -- | Convert vector to the list toList :: (Vector v a) => v a -> [a] toList = foldr (:) []+{-# INLINE toList #-}  -- | Create vector form list. Will throw error if list is shorter than --   resulting vector. fromList :: (Vector v a) => [a] -> v a {-# INLINE fromList #-}-fromList = C.vector . C.fromList+fromList = vector . C.fromList  -- | Create vector form list. Will throw error if list has different --   length from resulting vector. fromList' :: (Vector v a) => [a] -> v a {-# INLINE fromList' #-}-fromList' = C.vector . C.fromList'+fromList' = vector . C.fromList'  -- | Create vector form list. Will return @Nothing@ if list has different --   length from resulting vector. fromListM :: (Vector v a) => [a] -> Maybe (v a) {-# INLINE fromListM #-}-fromListM = C.vectorM . C.fromListM+fromListM = liftM vector . C.fromListM  -- | Create vector from 'Foldable' data type. Will return @Nothing@ if --   data type different number of elements that resulting vector.

@@ -1,167 +0,0 @@-{-# LANGUAGE EmptyDataDecls        #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE Rank2Types            #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE DeriveDataTypeable    #-}--- |--- Type class for working with N-ary functions-module Data.Vector.Fixed.Internal.Arity (-    -- * Type-level naturals-    Z-  , S-    -- ** Synonyms for small numerals-  , N1-  , N2-  , N3-  , N4-  , N5-  , N6-    -- * N-ary functions-  , Fn-  , Fun(..)-  , Arity(..)-  , apply-  , applyM-  ) where--import Control.Applicative (Applicative(..))-import Data.Typeable       (Typeable)----------------------------------------------------------------------- Naturals--------------------------------------------------------------------- | Type level zero-data Z   deriving Typeable--- | Successor of n-data S n deriving Typeable--type N1 = S Z-type N2 = S N1-type N3 = S N2-type N4 = S N3-type N5 = S N4-type N6 = S N5----------------------------------------------------------------------- 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 { unFun :: 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 #-}--instance Arity n => Applicative (Fun n a) where-  pure (x :: x) = Fun $ accum (\(T_pure r) (_::a) -> T_pure r)-                              (\(T_pure r)        -> r)-                              (T_pure x :: T_pure x n)-  (Fun f0 :: Fun n a (p -> q)) <*> (Fun g0 :: Fun n a p)-    = Fun $ accum (\(T_ap f g) a -> T_ap (f a) (g a))-                  (\(T_ap f g)   -> f g)-                  (T_ap f0 g0 :: T_ap a (p -> q) p n)-  {-# INLINE pure  #-}-  {-# INLINE (<*>) #-}--newtype T_fmap a b   n = T_fmap (Fn n a b)-data    T_pure a     n = T_pure a-data    T_ap   a b c n = T_ap (Fn n a b) (Fn n a c)----------------------------------------------------------------------- Generic operations of N-ary functions--------------------------------------------------------------------- | 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.-  applyFun :: (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, t Z)--  -- | Monadic apply-  applyFunM :: Monad m-            => (forall k. t (S k) -> m (a, t k)) -- ^ Get value to apply to function-            -> t n                               -- ^ Initial value-            -> Fn n a (m b)                      -- ^ N-ary function-            -> m (b, t Z)-  -- | Arity of function.-  arity :: n -> Int---- | Apply all parameters to the function.-apply :: Arity n-      => (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-{-# INLINE apply #-}-apply step z f = fst $ applyFun step z f---- | Apply all parameters to the function.-applyM :: (Arity n, Monad m)-       => (forall k. t (S k) -> m (a, t k)) -- ^ Get value to apply to function-       -> t n                               -- ^ Initial value-       -> Fn n a (m b)                      -- ^ N-ary function-       -> m b-{-# INLINE applyM #-}-applyM step z f = do-  (r,_) <- applyFunM step z f-  return r--instance Arity Z where-  accum     _ g t = g t-  accumM    _ g t = g =<< t-  applyFun  _ t h = (h,t)-  applyFunM _ t h = do r <- h-                       return (r,t)-  arity  _ = 0-  {-# INLINE accum     #-}-  {-# INLINE accumM    #-}-  {-# INLINE applyFun  #-}-  {-# INLINE applyFunM #-}-  {-# 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-  applyFun  f t h = case f t of (a,u) -> applyFun f u (h a)-  applyFunM f t h = do (a,u) <- f t-                       applyFunM f u (h a)-  arity _ = 1 + arity (undefined :: n)-  {-# INLINE accum     #-}-  {-# INLINE accumM    #-}-  {-# INLINE applyFun  #-}-  {-# INLINE applyFunM #-}-  {-# INLINE arity     #-}

@@ -1,27 +0,0 @@--- |--- Strict identity monad-module Data.Vector.Fixed.Internal.Id (-    Id(..)-  ) where--import Control.Applicative (Applicative(..))----- | Strict identity monad-newtype Id a = Id { runID :: a }--instance Functor Id where-  fmap f (Id a) = Id (f a)-  {-# INLINE fmap #-}--instance Applicative Id where-  pure          = Id-  Id f <*> Id a = Id (f a)-  {-# INLINE pure  #-}-  {-# INLINE (<*>) #-}--instance Monad Id where-  return     = Id-  Id a >>= f = f a-  {-# INLINE return #-}-  {-# INLINE (>>=)  #-}

@@ -53,6 +53,7 @@     -- ** Transformations   , head   , tail+  , reverse   , (!)     -- ** Comparison   , eq@@ -69,6 +70,8 @@   , foldl1   , ifoldl   , ifoldr+  , fold+  , foldMap   , foldM   , ifoldM     -- ** Special folds@@ -91,10 +94,11 @@   ) where  import Control.Monad (liftM)-import Data.Vector.Fixed.Internal.Arity+import Data.Monoid   (Monoid) import qualified Data.Vector.Fixed as F+import Data.Vector.Fixed.Cont (S,Z,Arity,Fun(..)) import Prelude hiding ( replicate,map,zipWith,maximum,minimum,and,or,all,any-                      , foldl,foldr,foldl1,length,sum+                      , foldl,foldr,foldl1,length,sum,reverse                       , head,tail,mapM,mapM_,sequence,sequence_                       ) @@ -209,6 +213,9 @@ {-# INLINE tail #-} tail v = getMono $ F.tail $ Mono v +reverse :: (VectorMono v) => v -> v+reverse = getMono . F.reverse . Mono+{-# INLINE reverse #-}  (!) :: (VectorMono v, VectorElm v ~ a) => v -> Int -> a {-# INLINE (!) #-}@@ -240,7 +247,14 @@ {-# INLINE ifoldl #-} ifoldl f z = F.ifoldl f z . Mono --- | Monadic fold over vector.+fold :: (VectorMono v, Monoid (VectorElm v)) => v -> VectorElm v+fold = F.fold . Mono+{-# INLINE fold #-}++foldMap :: (VectorMono v, Monoid m) => (VectorElm v -> m) -> v -> m+foldMap f = F.foldMap f . Mono+{-# INLINE foldMap #-}+ foldM :: (VectorMono v, VectorElm v ~ a, Monad m)       => (b -> a -> m b) -> b -> v -> m b {-# INLINE foldM #-}

@@ -4,12 +4,14 @@ {-# 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.+-- Type classes for vectors which are implemented on top of the arrays+-- and support in-place mutation. API is similar to one used in the+-- @vector@ package. module Data.Vector.Fixed.Mutable (     -- * Mutable vectors-    Mutable+    Arity+  , arity+  , Mutable   , DimM   , MVector(..)   , lengthM@@ -29,8 +31,7 @@  import Control.Monad.ST import Control.Monad.Primitive-import Data.Vector.Fixed.Internal.Arity-import Data.Vector.Fixed.Cont (Dim)+import Data.Vector.Fixed.Cont (Dim,Arity,Fun(..),S,arity,apply,accum) import Prelude hiding (read)  @@ -38,13 +39,13 @@ -- Type classes ---------------------------------------------------------------- --- | Mutable counterpart of fixed-length vector+-- | Mutable counterpart of fixed-length vector. type family Mutable (v :: * -> *) :: * -> * -> * --- | Dimension for mutable vector+-- | Dimension for mutable vector. type family DimM (v :: * -> * -> *) :: * --- | Type class for mutable vectors+-- | 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@@ -68,11 +69,11 @@   unsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m ()  --- | Length of mutable vector+-- | Length of mutable vector. Function doesn't evaluate its argument. lengthM :: forall v s a. (Arity (DimM v)) => v s a -> Int lengthM _ = arity (undefined :: DimM v) --- | Clone vector+-- | Create copy of vector. clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a) {-# INLINE clone #-} clone v = do@@ -103,10 +104,10 @@   -- | 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+  -- | Get element at specified index without bounds check.   unsafeIndex :: v a -> Int -> a --- | Length of immutable vector+-- | Length of immutable vector. Function doesn't evaluate its argument. lengthI :: IVector v a => v a -> Int lengthI = lengthM . cast   where@@ -135,7 +136,7 @@ -- Vector API ---------------------------------------------------------------- --- | Generic inspect+-- | Generic inspect implementation for array-based vectors. 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)@@ -146,7 +147,7 @@ newtype T_idx n = T_idx Int  --- | Generic construct+-- | Generic construct implementation for array-based vectors. constructVec :: forall v a. (Arity (Dim v), IVector v a) => Fun (Dim v) a (v a) {-# INLINE constructVec #-} constructVec = Fun $

@@ -26,8 +26,7 @@ import Data.Primitive import Prelude hiding (length,replicate,zipWith,map,foldl) -import Data.Vector.Fixed-import Data.Vector.Fixed.Internal.Arity+import Data.Vector.Fixed hiding (index) import Data.Vector.Fixed.Mutable  @@ -103,3 +102,7 @@ instance (Arity n, Prim a, Eq a) => Eq (Vec n a) where   (==) = eq   {-# INLINE (==) #-}+instance (Arity n, Prim a, Ord a) => Ord (Vec n a) where+  compare = ord+  {-# INLINE compare #-}+

@@ -32,8 +32,7 @@  import Prelude hiding (length,replicate,zipWith,map,foldl) -import Data.Vector.Fixed-import Data.Vector.Fixed.Internal.Arity+import Data.Vector.Fixed hiding (index) import Data.Vector.Fixed.Mutable  @@ -149,6 +148,9 @@ instance (Arity n, Storable a, Eq a) => Eq (Vec n a) where   (==) = eq   {-# INLINE (==) #-}+instance (Arity n, Storable a, Ord a) => Ord (Vec n a) where+  compare = ord+  {-# INLINE compare #-}   

@@ -29,7 +29,7 @@ import Data.Word (Word,Word8,Word16,Word32,Word64) import Prelude hiding (length,replicate,zipWith,map,foldl) -import Data.Vector.Fixed (Dim,Arity,Vector(..),VectorN,S,Z,toList,eq)+import Data.Vector.Fixed (Dim,Vector(..),VectorN,S,Z,toList,eq,ord) import Data.Vector.Fixed.Mutable import qualified Data.Vector.Fixed.Primitive as P @@ -78,6 +78,10 @@ instance (Unbox n a, Eq a) => Eq (Vec n a) where   (==) = eq   {-# INLINE (==) #-}+instance (Unbox n a, Ord a) => Ord (Vec n a) where+  compare = ord+  {-# INLINE compare #-}+   ----------------------------------------------------------------

@@ -1,5 +1,5 @@ Name:           fixed-vector-Version:        0.4.4.0+Version:        0.5.0.0 Synopsis:       Generic vectors with statically known size. Description:   Generic library for vectors with statically known@@ -19,65 +19,82 @@   .   Library is structured as follows:   .-  [@Data.Vector.Fixed@]-  Generic API. It's suitable for both ADT-based vector like @Complex@+  [Data.Vector.Fixed]+  Generic API. It's suitable for both ADT-based vector like Complex   and array-based ones.   .-  [@Data.Vector.Fixed.Cont@]+  [Data.Vector.Fixed.Cont]   Continuation based vectors. Internally all functions use them.   .-  [@Data.Vector.Fixed.Mutable@]+  [Data.Vector.Fixed.Mutable]   Type classes for array-based implementation and API for working with   mutable state.   .-  [@Data.Vector.Fixed.Unboxed@]+  [Data.Vector.Fixed.Unboxed]   Unboxed vectors.   .-  [@Data.Vector.Fixed.Boxed@]+  [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.Storable]+  Unboxed vectors of Storable  types.   .-  [@Data.Vector.Fixed.Primitive@]+  [Data.Vector.Fixed.Primitive]   Unboxed vectors based on pritimive package.   .-  [@Data.Vector.Fixed.Monomorphic@]+  [Data.Vector.Fixed.Monomorphic]   Wrappers for monomorphic vectors   .+  Changes in 0.5.0.0+  .+  * ContVec now behaves like normal vector. Arity type class is+    reworked. Id is removed.+  .+  * Construction of vector reworked.+  .+  * reverse, snoc, consV, fold and foldMap are added.+  .+  * Type changing maps and zips are added.+  .+  * Vector indexing with type level numbers is added.+  .+  * Twan van Laarhoven's lens added. (element and elementTy)+  .+  * Ord instances added to vector data types defined in the library.+  .   Changes in 0.4.4.0   .   * Functor and Applicative instances are added to Id.   .   Changes in 0.4.3.0   .-  * Typeable instance for @S@ and @Z@ added.+  * Typeable instance for S and Z added.   .   Changes in 0.4.2.0   .-  * 1-tuple @Only@ added.+  * 1-tuple Only added.   .-  * @fromList'@ and @fromListM@ added.+  * fromList' and fromListM added.   .-  * @apply@ functions from @Arity@ type class generalized.+  * apply functions from Arity type class generalized.   .   Changes in 0.4.1.0   .-  * @cons@ function added.+  * cons function added.   .-  * Getter to @Fun@ data type added.+  * Getter to Fun data type added.   .   Changes in 0.4.0.0   .   * Wrapper for monomorphics vectors is added.   .-  * @VecList@ is reimplemented as GADT and constructors are exported.+  * VecList is reimplemented as GADT and constructors are exported.   .   * Constructor of ContVecT is exported   .-  * Empty @ContVecT@ is implemented as @empty@.+  * Empty ContVecT is implemented as empty.   .-  * @Typeable@, @Foldable@ and @Traversable@ instances are added where+  * Typeable, Foldable and Traversable instances are added where     appropriate   .   Changes in 0.3.0.0@@ -86,11 +103,11 @@   .   Changes in 0.3.0.0   .-  * @Vector@ type class definition is moved to the @D.V.F.Cont@ module.+  * Vector type class definition is moved to the D.V.F.Cont module.   .   * Indexing function restored.   .-  * @unfoldr@ added.+  * unfoldr added.   .   Changes in 0.2.0.0   .@@ -98,22 +115,22 @@   .   * Right fold added.   .-  * @tailWith@, @convertContinuation@, and @!@ from-    @Data.Vector.Fixed@ removed.+  * tailWith, convertContinuation, and ! from+    Data.Vector.Fixed removed.   .-  * @Vector@ instance for tuples added.+  * Vector instance for tuples added.   .   Changes in 0.1.2   .-  * @imap@, @imapM@, @ifoldl@, @ifoldM@, @zipWithM@, @izipWithM@+  * imap, imapM, ifoldl, ifoldM, zipWithM, izipWithM     functions are added.   .-  * @VectorN@ type class added.+  * VectorN type class added.   .   Changes in 0.1.1   .-  * @foldM@ and @tailWith@ added. Type synonyms for numbers up to 6 are-    added. @Fun@ is reexported from @Data.Vector.Fixed@.+  * foldM and tailWith added. Type synonyms for numbers up to 6 are+    added. Fun is reexported from Data.Vector.Fixed.   Cabal-Version:  >= 1.8@@ -139,10 +156,9 @@     primitive   Exposed-modules:     -- API-    Data.Vector.Fixed.Internal.Arity-    Data.Vector.Fixed.Internal.Id     Data.Vector.Fixed.Cont     Data.Vector.Fixed+    Data.Vector.Fixed.Generic     Data.Vector.Fixed.Monomorphic     -- Arrays     Data.Vector.Fixed.Mutable