packages feed

fixed-vector 0.1.2.1 → 0.2.0.0

raw patch · 8 files changed

+773/−414 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Data.Vector.Fixed: (!) :: Vector v a => v a -> Int -> a
- Data.Vector.Fixed: VecList :: [a] -> VecList n a
- Data.Vector.Fixed: convertContinuation :: Arity n => (forall v. (Dim v ~ n, Vector v a) => v a -> r) -> Fun n a r
- Data.Vector.Fixed: instance Arity n => Vector (VecList n) a
- Data.Vector.Fixed: instance Arity n => VectorN VecList n a
- Data.Vector.Fixed: instance Eq a => Eq (VecList n a)
- Data.Vector.Fixed: instance Monad Id
- Data.Vector.Fixed: instance Show a => Show (VecList n a)
- Data.Vector.Fixed: newtype VecList n a
- Data.Vector.Fixed: tailWith :: (Arity n, Vector v a, Dim v ~ S n) => (forall w. (Vector w a, Dim w ~ n) => w a -> r) -> v a -> r
- Data.Vector.Fixed.Internal: Cont :: (forall r. Fun n a r -> r) -> Cont n a
- Data.Vector.Fixed.Internal: create :: (Arity (Dim v), Vector v a) => Cont (Dim v) a -> v a
- Data.Vector.Fixed.Internal: inspectV :: (Arity (Dim v), Vector v a) => v a -> Fun (Dim v) a b -> b
- Data.Vector.Fixed.Internal: newtype Cont n a
+ Data.Vector.Fixed: all :: Vector v a => (a -> Bool) -> v a -> Bool
+ Data.Vector.Fixed: and :: Vector v Bool => v Bool -> Bool
+ Data.Vector.Fixed: any :: Vector v a => (a -> Bool) -> v a -> Bool
+ Data.Vector.Fixed: data VecList n a
+ Data.Vector.Fixed: foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b
+ Data.Vector.Fixed: ifoldr :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b
+ Data.Vector.Fixed: mk1 :: (Vector v a, Dim v ~ N1) => a -> v a
+ Data.Vector.Fixed: mk2 :: (Vector v a, Dim v ~ N2) => a -> a -> v a
+ Data.Vector.Fixed: mk3 :: (Vector v a, Dim v ~ N3) => a -> a -> a -> v a
+ Data.Vector.Fixed: mk4 :: (Vector v a, Dim v ~ N4) => a -> a -> a -> a -> v a
+ Data.Vector.Fixed: mk5 :: (Vector v a, Dim v ~ N5) => a -> a -> a -> a -> a -> v a
+ Data.Vector.Fixed: or :: Vector v Bool => v Bool -> Bool
+ Data.Vector.Fixed.Boxed: instance (Arity n, Eq a) => Eq (Vec n a)
+ Data.Vector.Fixed.Cont: all :: Arity n => (a -> Bool) -> Fun n a Bool
+ Data.Vector.Fixed.Cont: and :: Arity n => Fun n Bool Bool
+ Data.Vector.Fixed.Cont: any :: Arity n => (a -> Bool) -> Fun n a Bool
+ Data.Vector.Fixed.Cont: basis :: (Num a, Arity n) => Int -> ContVecT m n a
+ Data.Vector.Fixed.Cont: cons :: a -> ContVecT m n a -> ContVecT m (S n) a
+ Data.Vector.Fixed.Cont: cvec :: (Vector v a, Dim v ~ n, Monad m) => v a -> ContVecT m n a
+ Data.Vector.Fixed.Cont: data ContVecT m n a
+ Data.Vector.Fixed.Cont: data VecList n a
+ Data.Vector.Fixed.Cont: foldM :: (Arity n, Monad m) => (b -> a -> m b) -> b -> Fun n a (m b)
+ Data.Vector.Fixed.Cont: foldl :: Arity n => (b -> a -> b) -> b -> Fun n a b
+ Data.Vector.Fixed.Cont: foldl1 :: Arity (S n) => (a -> a -> a) -> Fun (S n) a a
+ Data.Vector.Fixed.Cont: foldr :: Arity n => (a -> b -> b) -> b -> Fun n a b
+ Data.Vector.Fixed.Cont: fromList :: Arity n => [a] -> ContVecT m n a
+ Data.Vector.Fixed.Cont: generate :: Arity n => (Int -> a) -> ContVecT m n a
+ Data.Vector.Fixed.Cont: generateM :: (Monad m, Arity n) => (Int -> m a) -> ContVecT m n a
+ Data.Vector.Fixed.Cont: head :: Arity (S n) => Fun (S n) a a
+ Data.Vector.Fixed.Cont: ifoldM :: (Arity n, Monad m) => (b -> Int -> a -> m b) -> b -> Fun n a (m b)
+ Data.Vector.Fixed.Cont: ifoldl :: Arity n => (b -> Int -> a -> b) -> b -> Fun n a b
+ Data.Vector.Fixed.Cont: ifoldr :: Arity n => (Int -> a -> b -> b) -> b -> Fun n a b
+ Data.Vector.Fixed.Cont: imap :: Arity n => (Int -> a -> b) -> ContVecT m n a -> ContVecT m n b
+ Data.Vector.Fixed.Cont: imapM :: (Arity n, Monad m) => (Int -> a -> m b) -> ContVecT m n a -> ContVecT m n b
+ Data.Vector.Fixed.Cont: instance Arity n => Applicative (ContVecT m n)
+ Data.Vector.Fixed.Cont: instance Arity n => Functor (ContVecT m n)
+ Data.Vector.Fixed.Cont: instance Arity n => Vector (VecList n) a
+ Data.Vector.Fixed.Cont: instance Arity n => VectorN VecList n a
+ Data.Vector.Fixed.Cont: instance Eq a => Eq (VecList n a)
+ Data.Vector.Fixed.Cont: instance Show a => Show (VecList n a)
+ Data.Vector.Fixed.Cont: izipWith :: Arity n => (Int -> a -> b -> c) -> ContVecT m n a -> ContVecT m n b -> ContVecT m n c
+ Data.Vector.Fixed.Cont: izipWithM :: (Arity n, Monad m) => (Int -> a -> b -> m c) -> ContVecT m n a -> ContVecT m n b -> ContVecT m n c
+ Data.Vector.Fixed.Cont: map :: Arity n => (a -> b) -> ContVecT m n a -> ContVecT m n b
+ Data.Vector.Fixed.Cont: mapM :: (Arity n, Monad m) => (a -> m b) -> ContVecT m n a -> ContVecT m n b
+ Data.Vector.Fixed.Cont: maximum :: (Ord a, Arity (S n)) => Fun (S n) a a
+ Data.Vector.Fixed.Cont: minimum :: (Ord a, Arity (S n)) => Fun (S n) a a
+ Data.Vector.Fixed.Cont: mk1 :: a -> ContVecT m N1 a
+ Data.Vector.Fixed.Cont: mk2 :: a -> a -> ContVecT m N2 a
+ Data.Vector.Fixed.Cont: mk3 :: a -> a -> a -> ContVecT m N3 a
+ Data.Vector.Fixed.Cont: mk4 :: a -> a -> a -> a -> ContVecT m N4 a
+ Data.Vector.Fixed.Cont: mk5 :: a -> a -> a -> a -> a -> ContVecT m N5 a
+ Data.Vector.Fixed.Cont: or :: Arity n => Fun n Bool Bool
+ Data.Vector.Fixed.Cont: replicate :: Arity n => a -> ContVecT m n a
+ Data.Vector.Fixed.Cont: replicateM :: (Arity n, Monad m) => m a -> ContVecT m n a
+ Data.Vector.Fixed.Cont: runContVec :: Arity n => Fun n a r -> ContVec n a -> r
+ Data.Vector.Fixed.Cont: runContVecM :: Arity n => Fun n a (m r) -> ContVecT m n a -> m r
+ Data.Vector.Fixed.Cont: runContVecT :: (Monad m, Arity n) => Fun n a r -> ContVecT m n a -> m r
+ Data.Vector.Fixed.Cont: sum :: (Num a, Arity n) => Fun n a a
+ Data.Vector.Fixed.Cont: tail :: ContVecT m (S n) a -> ContVecT m n a
+ Data.Vector.Fixed.Cont: type ContVec = ContVecT Id
+ Data.Vector.Fixed.Cont: type N1 = S Z
+ Data.Vector.Fixed.Cont: type N2 = S N1
+ Data.Vector.Fixed.Cont: type N3 = S N2
+ Data.Vector.Fixed.Cont: type N4 = S N3
+ Data.Vector.Fixed.Cont: type N5 = S N4
+ Data.Vector.Fixed.Cont: type N6 = S N5
+ Data.Vector.Fixed.Cont: vector :: (Vector v a, Dim v ~ n) => ContVec n a -> v a
+ Data.Vector.Fixed.Cont: vectorM :: (Vector v a, Dim v ~ n, Monad m) => ContVecT m n a -> m (v a)
+ Data.Vector.Fixed.Cont: zipWith :: Arity n => (a -> b -> c) -> ContVecT m n a -> ContVecT m n b -> ContVecT m n c
+ Data.Vector.Fixed.Cont: zipWithM :: (Arity n, Monad m) => (a -> b -> m c) -> ContVecT m n a -> ContVecT m n b -> ContVecT m n c
+ Data.Vector.Fixed.Internal: Id :: a -> Id a
+ Data.Vector.Fixed.Internal: instance (b ~ a, c ~ a) => Vector ((,,) b c) a
+ Data.Vector.Fixed.Internal: instance (b ~ a, c ~ a, d ~ a) => Vector ((,,,) b c d) a
+ Data.Vector.Fixed.Internal: instance (b ~ a, c ~ a, d ~ a, e ~ a) => Vector ((,,,,) b c d e) a
+ Data.Vector.Fixed.Internal: instance Monad Id
+ Data.Vector.Fixed.Internal: instance b ~ a => Vector ((,) b) a
+ Data.Vector.Fixed.Internal: newtype Id a
+ Data.Vector.Fixed.Internal: runID :: Id a -> a
+ Data.Vector.Fixed.Internal: type N1 = S Z
+ Data.Vector.Fixed.Internal: type N2 = S N1
+ Data.Vector.Fixed.Internal: type N3 = S N2
+ Data.Vector.Fixed.Internal: type N4 = S N3
+ Data.Vector.Fixed.Internal: type N5 = S N4
+ Data.Vector.Fixed.Internal: type N6 = S N5
+ Data.Vector.Fixed.Primitive: instance (Arity n, Prim a, Eq a) => Eq (Vec n a)
+ Data.Vector.Fixed.Storable: instance (Arity n, Storable a, Eq a) => Eq (Vec n a)
+ Data.Vector.Fixed.Unboxed: instance (Unbox n a, Eq a) => Eq (Vec n a)
- Data.Vector.Fixed.Internal: applyM :: (Arity n, Monad m) => (forall k. t (S k) -> m (a, t k)) -> t n -> Fn n a b -> m b
+ Data.Vector.Fixed.Internal: applyM :: (Arity n, Monad m) => (forall k. t (S k) -> m (a, t k)) -> t n -> Fn n a (m b) -> m b

Files

Data/Vector/Fixed.hs view
@@ -18,39 +18,44 @@   , Z   , S     -- ** Synonyms for small numerals-  , N1-  , N2-  , N3-  , N4-  , N5-  , N6+  , C.N1+  , C.N2+  , C.N3+  , C.N4+  , C.N5+  , C.N6     -- ** Type class   , Vector(..)   , VectorN   , Arity   , Fun(..)   , length-  , convertContinuation-    -- * Generic functions-    -- ** Literal vectors+    -- * Constructors+    -- ** Small dimensions+    -- $smallDim+  , mk1+  , mk2+  , mk3+  , mk4+  , mk5+    -- ** Generic constructor   , New   , vec   , con   , (|>)-    -- ** Construction+    -- ** Functions   , replicate   , replicateM   , basis   , generate   , generateM-    -- ** Element access+    -- * Modifying vectors+    -- ** Transformations   , head   , tail-  , tailWith-  , (!)     -- ** Comparison   , eq-    -- ** Map+    -- ** Maps   , map   , mapM   , mapM_@@ -59,34 +64,42 @@   , imapM_   , sequence   , sequence_-    -- ** Folding+    -- * Folding   , foldl+  , foldr   , foldl1-  , foldM   , ifoldl+  , ifoldr+  , foldM   , ifoldM-    -- *** Special folds+    -- ** Special folds   , sum   , maximum   , minimum-    -- ** Zips+  , and+  , or+  , all+  , any+    -- * Zips   , zipWith   , zipWithM   , izipWith   , izipWithM-    -- ** Conversion+    -- * Conversion   , convert   , toList   , fromList-    -- * Special types-  , VecList(..)+    -- * Data types+  , VecList   ) where  import Data.Vector.Fixed.Internal+import Data.Vector.Fixed.Cont     (VecList)+import qualified Data.Vector.Fixed.Cont as C  import qualified Prelude as P-import Prelude hiding ( replicate,map,zipWith,maximum,minimum-                      , foldl,foldl1,length,sum+import Prelude hiding ( replicate,map,zipWith,maximum,minimum,and,or,all,any+                      , foldl,foldr,foldl1,length,sum                       , head,tail,mapM,mapM_,sequence,sequence_                       ) @@ -96,23 +109,6 @@ -- Generic functions ---------------------------------------------------------------- -type N1 = S Z-type N2 = S N1-type N3 = S N2-type N4 = S N3-type N5 = S N4-type N6 = S N5---- | Change continuation type.-convertContinuation :: forall n a r. (Arity n)-                    => (forall v. (Dim v ~ n, Vector v a) => v a -> r)-                    -> Fun n a r-{-# INLINE convertContinuation #-}-convertContinuation f = fmap f g-  where-    g = construct :: Fun n a (VecList n a)-- -- TODO: does not fuse!  -- | Generic function for construction of arbitrary vectors. It@@ -128,7 +124,6 @@ --   >>> import Data.Complex --   >>> vec $ con |> 1 |> 3 :: Complex Double --   1.0 :+ 3.0--- newtype New n v a = New (Fn n a (v a))  -- | Convert fully applied constructor to vector@@ -152,36 +147,55 @@ f2n (Fun f) = New f  + ---------------------------------------------------------------- +-- $smallDim+--+-- Constructors for vectors with small dimensions.++mk1 :: (Vector v a, Dim v ~ C.N1) => a -> v a+mk1 a1 = C.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+{-# 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+{-# 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+{-# 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+{-# INLINE mk5 #-}++++----------------------------------------------------------------+ -- | Replicate value /n/ times. -- --   Examples: -- --   >>> import Data.Vector.Fixed.Boxed (Vec2)---   >>> replicate 1 :: Vec2 Int     -- Two element vector+--   >>> replicate 1 :: Vec2 Int --   fromList [1,1] -----   >>> import Data.Vector.Fixed.Boxed (Vec3)---   >>> replicate 2 :: Vec3 Double  -- Three element vector---   fromList [2.0,2.0,2.0]+--   >>> 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"]--- 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+replicate+  = C.vector . C.replicate  -- | Execute monadic action for every element of vector. --@@ -194,21 +208,17 @@ --   Hi! --   Hi! --   fromList [(),()]--- replicateM :: (Vector v a, Monad m) => m a -> m (v a) {-# INLINE replicateM #-}-replicateM x = replicateFM x construct+replicateM+  = C.vectorM . C.replicateM -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,+-- | Unit vector along Nth axis. If index is larger than vector+--   dimensions returns zero vector. -- --   Examples: --@@ -217,56 +227,34 @@ --   fromList [1,0,0] --   >>> basis 1 :: Vec3 Int --   fromList [0,1,0]---   >>> basis 2 :: Vec3 Int---   fromList [0,0,1]---+--   >>> basis 3 :: Vec3 Int+--   fromList [0,0,0] basis :: forall v a. (Vector v a, Num a) => Int -> v a {-# INLINE basis #-}-basis n = create $ Cont-        $ basisF n+basis = C.vector . C.basis -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 from function which maps element's index to its value.+-- | Generate vector from function which maps element's index to its+--   value. -- --   Examples: -- --   >>> import Data.Vector.Fixed.Unboxed (Vec) --   >>> generate (^2) :: Vec N4 Int --   fromList [0,1,4,9]--- 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+generate = C.vector . C.generate --- | Monadic generation+-- | Generate vector from monadic function which maps element's index+--   to its value. generateM :: forall m v a. (Monad m, Vector v a) => (Int -> m a) -> m (v a) {-# INLINE generateM #-}-generateM f = generateFM f construct+generateM = C.vectorM . C.generateM -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   ----------------------------------------------------------------@@ -276,21 +264,12 @@ --   Examples: -- --   >>> import Data.Vector.Fixed.Boxed (Vec3)---   >>> let x = vec $ con |> 1 |> 2 |> 3 :: Vec3 Int+--   >>> let x = mk3 1 2 3 :: Vec3 Int --   >>> head x --   1--- 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))+head = C.runContVec C.head . C.cvec   ----------------------------------------------------------------@@ -299,128 +278,57 @@ -- --   Examples: -----   >>> import Data.Vector.Fixed.Boxed (Vec2, Vec3)---   >>> let x = vec $ con |> 1 |> 2 |> 3 :: Vec3 Int---   >>> tail x :: Vec2 Int---   fromList [2,3]---+--   >>> import Data.Complex+--   >>> tail (1,2,3) :: Complex Double+--   2.0 :+ 3.0 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+tail = C.vector . C.tail . C.cvec -tailF :: Arity n => Fun n a b -> Fun (S n) a b-{-# INLINE tailF #-}-tailF (Fun f) = Fun (\_ -> f) --- | Continuation variant of tail. It should be used when tail of---   vector is immediately deconstructed with polymorphic---   function. For example @'sum' . 'tail'@ will fail with unhelpful---   error message because return value of @tail@ is polymorphic. But---   @'tailWith' 'sum'@ works just fine.------   Examples:------   >>> import Data.Vector.Fixed.Boxed (Vec3)---   >>> let x = vec $ con |> 1 |> 2 |> 3 :: Vec3 Int---   >>> tailWith sum x---   5----tailWith :: (Arity n, Vector v a, Dim v ~ S n)-         => (forall w. (Vector w a, Dim w ~ n) => w a -> r) -- ^ Continuation-         -> v a                                             -- ^ Vector-         -> r-{-# INLINE tailWith #-}-tailWith f v = inspectV v-             $ tailF-             $ convertContinuation 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+foldl f x = C.runContVec (C.foldl f x)+          . C.cvec -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+foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b+{-# INLINE foldr #-}+foldr f x = C.runContVec (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 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))+foldl1 f = C.runContVec (C.foldl1 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)+           . 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 v = inspectV v-             $ ifoldlF f z+ifoldl f z = C.runContVec (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+ -- | 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@@ -429,51 +337,60 @@   where     go m i a = do { b <- m; f b i a } -data T_ifoldl b n = T_ifoldl {-# UNPACK #-} !Int b -ifoldlF :: forall n a b. Arity n => (b -> Int -> a -> b) -> b -> Fun n a b-{-# INLINE ifoldlF #-}-ifoldlF 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) -- ---------------------------------------------------------------- --- | Sum all elements in the vector+-- | Sum all elements in the vector. sum :: (Vector v a, Num a) => v a -> a+sum = C.runContVec C.sum . C.cvec {-# INLINE sum #-}-sum = foldl (+) 0 --- | Maximum element of vector+-- | Maximal element of vector. -- --   Examples: -- --   >>> import Data.Vector.Fixed.Boxed (Vec3)---   >>> let x = vec $ con |> 1 |> 2 |> 3 :: Vec3 Int+--   >>> let x = mk3 1 2 3 :: Vec3 Int --   >>> maximum x --   3--- maximum :: (Vector v a, Dim v ~ S n, Ord a) => v a -> a+maximum = C.runContVec C.maximum . C.cvec {-# INLINE maximum #-}-maximum = foldl1 max --- | Minimum element of vector+-- | Minimal element of vector. -- --   Examples: -- --   >>> import Data.Vector.Fixed.Boxed (Vec3)---   >>> let x = vec $ con |> 1 |> 2 |> 3 :: Vec3 Int+--   >>> let x = mk3 1 2 3 :: Vec3 Int --   >>> minimum x --   1--- minimum :: (Vector v a, Dim v ~ S n, Ord a) => v a -> a+minimum = C.runContVec C.minimum . C.cvec {-# INLINE minimum #-}-minimum = foldl1 min +-- | Conjunction of all elements of a vector.+and :: (Vector v Bool) => v Bool -> Bool+and = C.runContVec 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+{-# 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+{-# 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+{-# INLINE any #-}++ ----------------------------------------------------------------  -- | Test two vectors for equality.@@ -487,24 +404,20 @@ --   True --   >>> v0 `eq` v1 --   False--- eq :: (Vector v a, Eq a) => v a -> v a -> Bool {-# INLINE eq #-}-eq v w = inspectV w-       $ inspectV v-       $ fmap (fmap runID)-       $ izipWithFM (\_ a b -> return (a == b))-       $ foldlF (&&) True+eq v w = C.runContVec (C.foldl (&&) True)+       $ C.zipWith (==) (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 v = create $ Cont-        $ inspectV v-        . fmap runID-        . mapFM (return . f)+map f = C.vector+      . C.map f+      . C.cvec  -- | Evaluate every action in the vector from left to right. sequence :: (Vector v a, Vector v (m a), Monad m) => v (m a) -> m (v a)@@ -520,9 +433,9 @@ -- | 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+mapM f = C.vectorM+       . C.mapM f+       . C.cvec  -- | Apply monadic action to each element of vector and ignore result. mapM_ :: (Vector v a, Monad m) => (a -> m b) -> v a -> m ()@@ -530,31 +443,21 @@ mapM_ f = foldl (\m a -> m >> f a >> return ()) (return ())  -newtype T_map b c n = T_map (Fn n b c)--mapFM :: forall m n a b c. (Arity n, Monad m) => (a -> m b) -> Fun n b c -> Fun n a (m c)-{-# INLINE mapFM #-}-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))-- -- | Apply function to every element of the vector and its index. imap :: (Vector v a, Vector v b) =>     (Int -> a -> b) -> v a -> v b {-# INLINE imap #-}-imap f v = create $ Cont-         $ inspectV v-         . fmap runID-         . imapFM (\i a -> return $ f i a)+imap f = C.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) {-# INLINE imapM #-}-imapM f v = inspectV v-          $ imapFM f-          $ construct+imapM f = C.vectorM+        . C.imapM f+        . C.cvec  -- | Apply monadic function to every element of the vector and its --   index and discard result.@@ -563,19 +466,6 @@ imapM_ f = ifoldl (\m i a -> m >> f i a >> return ()) (return ())  -data T_imap b c n = T_imap {-# UNPACK #-} !Int (Fn n b c)--imapFM :: forall m n a b c. (Arity n, Monad m)-       => (Int -> a -> m b) -> Fun n b c -> Fun n a (m c)-{-# INLINE imapFM #-}-imapFM f (Fun h) = Fun $-  accumM (\(T_imap i g) a -> do b <- f i a-                                return (T_imap (i + 1) (g b)))-         (\(T_imap _ g) -> return g)-         (return $ T_imap 0 h :: m (T_imap b c n))--- ----------------------------------------------------------------  -- | Zip two vector together using function.@@ -593,61 +483,34 @@ --   fromList [1,0,1] --   >>> vplus b1 b2 --   fromList [0,1,1]--- 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-              . (fmap (fmap runID))-              . izipWithFM (\_ a b -> return (f a b))+zipWith f v u = C.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 = inspectV u-               $ inspectV v-               $ izipWithFM (const f)-               $ construct+zipWithM f v u = C.vectorM+               $ C.zipWithM f (C.cvec v) (C.cvec u)  -- | Zip two vector together using function which takes element index --   as well. 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-               . fmap (fmap runID)-               . izipWithFM (\i a b -> return $ f i a b)+izipWith 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.. 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 = inspectV u-                $ inspectV v-                $ izipWithFM f-                $ construct--data T_izip a c r n = T_izip Int (VecList n a) (Fn n c r)---- FIXME: explain function-izipWithFM :: forall m n a b c d. (Arity n, Monad m)-           => (Int -> a -> b -> m c) -> Fun n c d -> Fun n a (Fun n b (m d))-{-# INLINE izipWithFM #-}-izipWithFM f (Fun g0) =-  fmap (\v -> Fun $ accumM-              (\(T_izip i (VecList (a:as)) g) b -> do x <- f i a b-                                                      return $ T_izip (i+1) (VecList as) (g x)-              )-              (\(T_izip _ _ x) -> return x)-              (return $ T_izip 0 v g0 :: m (T_izip a c d n))-       ) construct-+izipWithM f v u = C.vectorM+                $ C.izipWithM f (C.cvec v) (C.cvec u)   ----------------------------------------------------------------@@ -655,61 +518,14 @@ -- | 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 = C.vector . C.cvec  -- | Convert vector to the list toList :: (Vector v a) => v a -> [a]-toList v-  = case inspectV v construct of VecList xs -> xs+toList = foldr (:) [] --- | Create vector form list. List must have same length as the---   vector.-fromList :: forall v a. (Vector v a) => [a] -> v a+-- | Create vector form list. Will throw error if list is shorter than+--   resulting vector.+fromList :: (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   #-}-instance Arity n => VectorN VecList n a----- String identity monad-newtype Id a = Id { runID :: a }--instance Monad Id where-  return     = Id-  Id a >>= f = f a-  {-# INLINE return #-}-  {-# INLINE (>>=)  #-}+fromList = C.vector . C.fromList
Data/Vector/Fixed/Boxed.hs view
@@ -84,5 +84,10 @@   {-# INLINE inspect   #-} instance (Arity n) => VectorN Vec n a +instance (Arity n, Eq a) => Eq (Vec n a) where+  (==) = eq+  {-# INLINE (==) #-}++ uninitialised :: a uninitialised = error "Data.Vector.Fixed.Boxed: uninitialised element"
+ Data/Vector/Fixed/Cont.hs view
@@ -0,0 +1,510 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE Rank2Types            #-}+-- |+-- Continuations-based API+module Data.Vector.Fixed.Cont (+    -- * Vector as continuation+    ContVecT+  , ContVec+    -- ** Synonyms for small numerals+  , N1+  , N2+  , N3+  , N4+  , N5+  , N6+    -- * Construction of ContVec+  , cvec+  , fromList+  , replicate+  , replicateM+  , generate+  , generateM+  , basis+    -- ** Constructors+  , mk1+  , mk2+  , mk3+  , mk4+  , mk5+    -- * Transformations+  , map+  , imap+  , mapM+  , imapM+  , tail+  , cons+    -- ** Zips+  , zipWith+  , izipWith+  , zipWithM+  , izipWithM+    -- * Running ContVec+    -- $running+  , runContVecT+  , runContVecM+  , runContVec+    -- ** Getters+  , head+    -- ** Vector construction+  , vector+  , vectorM+    -- ** Folds+  , foldl+  , foldl1+  , foldr+  , ifoldl+  , ifoldr+  , foldM+  , ifoldM+    -- *** Special folds+  , sum+  , minimum+  , maximum+  , and+  , or+  , all+  , any+    -- * Data types+  , VecList+  ) where++import Control.Applicative+import Data.Vector.Fixed.Internal+import Prelude hiding ( replicate,map,zipWith,maximum,minimum,and,or,any,all+                      , foldl,foldr,foldl1,length,sum+                      , head,tail,mapM,mapM_,sequence,sequence_+                      )++----------------------------------------------------------------+-- 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 as continuation without monadic context.+type ContVec = ContVecT Id++instance (Arity n) => Functor (ContVecT m n) where+  fmap = map+  {-# INLINE fmap #-}++instance (Arity n) => Applicative (ContVecT m n) where+  pure  = replicate+  (<*>) = zipWith ($)+  {-# INLINE pure  #-}+  {-# INLINE (<*>) #-}++++----------------------------------------------------------------+-- 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)+{-# INLINE[1] cvec #-}++-- | 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+{-# INLINE fromList #-}+fromList xs = ContVecT $ \(Fun fun) ->+  apply step+        (T_flist xs :: T_flist a n)+        fun+  where+    step (T_flist []    ) = error "Data.Vector.Fixed.Cont.fromList: too few elements"+    step (T_flist (a:as)) = (a, T_flist as)++data T_flist a n = T_flist [a]+++-- | Execute monadic action for every element of vector. Synonym for 'pure'.+replicate :: forall m n a. (Arity n)+          => a -> ContVecT m n a+{-# INLINE replicate #-}+replicate a = ContVecT $ \(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+{-# INLINE replicateM #-}+replicateM act = ContVecT $ \(Fun fun) ->+  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+{-# INLINE generate #-}+generate f = ContVecT $ \(Fun fun) ->+  apply (\(T_generate n) -> (f n, T_generate (n + 1)))+        (T_generate 0 :: T_generate n)+         fun++-- | 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+{-# INLINE generateM #-}+generateM f = ContVecT $ \(Fun fun) ->+  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++-- | Unit vector along Nth axis.+basis :: forall m n a. (Num a, Arity n) => Int -> ContVecT m n a+{-# INLINE basis #-}+basis n0 = ContVecT $ \(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++newtype T_basis n = T_basis Int+++mk1 :: a -> ContVecT m N1 a+mk1 a1 = ContVecT $ \(Fun f) -> f a1+{-# INLINE mk1 #-}++mk2 :: a -> a -> ContVecT m N2 a+mk2 a1 a2 = ContVecT $ \(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+{-# INLINE mk3 #-}++mk4 :: a -> a -> a -> a -> ContVecT m N4 a+mk4 a1 a2 a3 a4 = ContVecT $ \(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+{-# INLINE mk5 #-}+++----------------------------------------------------------------+-- Transforming vectors+----------------------------------------------------------------++-- | Map over vector. Synonym for 'fmap'+map :: (Arity n) => (a -> b) -> ContVecT m n a -> ContVecT m 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+{-# INLINE imap #-}+imap f (ContVecT contA) = ContVecT $+  contA . imapF f++-- | Monadic map over vector.+mapM :: (Arity n, Monad m) => (a -> m b) -> ContVecT m n a -> ContVecT m 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+{-# INLINE imapM #-}+imapM f (ContVecT contA) = ContVecT $+  contA . imapFM f+++imapF :: forall n a b r. Arity n+      => (Int -> a -> b) -> Fun n b r -> Fun n a r+{-# INLINE imapF #-}+imapF f (Fun funB) = Fun $+  accum (\(T_map i g) b -> T_map (i+1) (g (f i b)))+        (\(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)+++-- | /O(1)/ Tail of vector.+tail :: ContVecT m (S n) a+     -> ContVecT m n a+tail (ContVecT cont) = ContVecT $ \(Fun f) -> cont (Fun $ \_ -> 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+{-# INLINE cons #-}++-- | Zip two vector together using function.+zipWith :: (Arity n) => (a -> b -> c)+        -> ContVecT m n a -> ContVecT m n b -> ContVecT m 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+{-# INLINE izipWith #-}+izipWith f (ContVecT contA) (ContVecT contB) = ContVecT $ \funC ->+  contA $ fmap contB $ 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+{-# INLINE zipWithM #-}+zipWithM = izipWithM . const++-- | 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+{-# INLINE izipWithM #-}+izipWithM f (ContVecT contA) (ContVecT contB) = ContVecT $ \funC ->+  contA $ fmap contB $ izipWithFM f funC++++-- FIXME: explain function+izipWithF :: forall n a b c r. (Arity n)+          => (Int -> a -> b -> c) -> Fun n c r -> Fun n a (Fun n b r)+{-# INLINE izipWithF #-}+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 r n))+       ) construct++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 (VecList (a:as)) g) b -> do x <- f i a b+                                                      return $ T_izip (i+1) (VecList as) (g x)+              )+              (\(T_izip _ _ x) -> x)+              (return $ T_izip 0 v g0 :: m (T_izip a c (m r) n))+       ) construct++data T_izip a c r n = T_izip Int (VecList n a) (Fn n c r)++++----------------------------------------------------------------+-- 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.+runContVec :: Arity n+           => Fun n a r+           -> ContVec n a+           -> r+runContVec f (ContVecT c) = runID $ c (fmap return f)+{-# INLINE runContVec #-}++-- | Convert continuation to the vector.+vector :: (Vector v a, Dim v ~ n) => ContVec n a -> v a+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 #-}++{-# RULES "cvec/vector"+   forall x. cvec (vector x) = x+  #-}+++-- | Finalizer function for getting head of the vector.+head :: forall n a. Arity (S n) => Fun (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))++data T_head a n = T_head (Maybe a)+++-- | Left fold over continuation vector.+foldl :: forall n a b. Arity n+      => (b -> a -> b) -> b -> Fun 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+{-# 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)++-- | 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)+{-# 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)+{-# 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:+--+-- > 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.++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+{-# 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))++-- | Right fold over continuation vector+foldr :: forall n a b. Arity n+      => (a -> b -> b) -> b -> Fun 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+{-# 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)+++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 = foldl (+) 0+{-# INLINE sum #-}++-- | Minimal element of vector.+minimum :: (Ord a, Arity (S n)) => Fun (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 = foldl1 max+{-# INLINE maximum #-}++-- | Conjunction of elements of a vector.+and :: Arity n => Fun n Bool Bool+and = foldr (&&) True+{-# INLINE and #-}++-- | Disjunction of all elements of a vector.+or :: Arity n => Fun 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 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 f = foldr (\x b -> f x && b) True+{-# INLINE any #-}+++----------------------------------------------------------------+-- VecList+----------------------------------------------------------------++-- | 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   #-}+instance Arity n => VectorN VecList n a
Data/Vector/Fixed/Internal.hs view
@@ -16,6 +16,13 @@     -- * Type-level naturals     Z   , S+    -- ** Synonyms for small numerals+  , N1+  , N2+  , N3+  , N4+  , N5+  , N6     -- * N-ary functions   , Fn   , Fun(..)@@ -25,11 +32,7 @@   , Vector(..)   , VectorN   , length-    -- * Deforestation-    -- $deforestation-  , Cont(..)-  , create-  , inspectV+  , Id(..)   ) where  import Data.Complex@@ -45,6 +48,12 @@ -- | Successor of n data S n +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@@ -94,7 +103,7 @@   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+         -> Fn n a (m b)                      -- ^ N-ary function          -> m b   -- | Arity of function.   arity :: n -> Int@@ -103,7 +112,7 @@   accum  _ g t = g t   accumM _ g t = g =<< t   apply  _ _ h = h-  applyM _ _ h = return h+  applyM _ _ h = h   arity  _ = 0   {-# INLINE accum  #-}   {-# INLINE accumM #-}@@ -154,66 +163,51 @@ length _ = arity (undefined :: Dim v)  +-- | Strict identity monad+newtype Id a = Id { runID :: a } +instance Monad Id where+  return     = Id+  Id a >>= f = f a+  {-# INLINE return #-}+  {-# INLINE (>>=)  #-}+++ ------------------------------------------------------------------- Fusion+-- Instances ---------------------------------------------------------------- --- $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.+type instance Dim Complex = N2 +instance RealFloat a => Vector Complex a where+  construct = Fun (:+)+  inspect (x :+ y) (Fun f) = f x y --- | 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+type instance Dim ((,) a) = N2 --- | 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+instance (b~a) => Vector ((,) b) a where+  construct = Fun (,)+  inspect (a,b) (Fun f) = f a b -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-  #-}+type instance Dim ((,,) a b) = N3 +instance (b~a, c~a) => Vector ((,,) b c) a where+  construct = Fun (,,)+  inspect (a,b,c) (Fun f) = f a b c  -------------------------------------------------------------------- Instances-----------------------------------------------------------------+type instance Dim ((,,,) a b c) = N4 -type instance Dim Complex = S (S Z)+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 -instance RealFloat a => Vector Complex a where-  construct = Fun (:+)-  inspect (x :+ y) (Fun f) = f x y++type instance Dim ((,,,,) a b c d) = N5++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
Data/Vector/Fixed/Primitive.hs view
@@ -87,3 +87,7 @@   {-# INLINE construct #-}   {-# INLINE inspect   #-} instance (Arity n, Prim a) => VectorN Vec n a++instance (Arity n, Prim a, Eq a) => Eq (Vec n a) where+  (==) = eq+  {-# INLINE (==) #-}
Data/Vector/Fixed/Storable.hs view
@@ -134,6 +134,10 @@   {-# INLINE inspect   #-} instance (Arity n, Storable a) => VectorN Vec n a +instance (Arity n, Storable a, Eq a) => Eq (Vec n a) where+  (==) = eq+  {-# INLINE (==) #-}+   ----------------------------------------------------------------
Data/Vector/Fixed/Unboxed.hs view
@@ -61,6 +61,9 @@   {-# INLINE inspect   #-} instance (Unbox n a) => VectorN Vec n a +instance (Unbox n a, Eq a) => Eq (Vec n a) where+  (==) = eq+  {-# INLINE (==) #-}   ----------------------------------------------------------------
fixed-vector.cabal view
@@ -1,5 +1,5 @@ Name:           fixed-vector-Version:        0.1.2.1+Version:        0.2.0.0 Synopsis:       Generic vectors with fixed length Description:   Generic vectors with fixed length. Package is structured as follows:@@ -8,6 +8,9 @@   Generic API. It's suitable for both ADT-based vector like @Complex@   and array-based ones.   .+  [@Data.Vector.Fixed.Cont@]+  Continuation based vectors.+  .   [@Data.Vector.Fixed.Mutable@]   Type classes for array-based implementation.   .@@ -23,11 +26,30 @@   [@Data.Vector.Fixed.Primitive@]   Unboxed vectors based on pritimive package.   .+  Changes in 0.2.0.0+  .+  * Continuation-based vector added.+  .+  * Right fold added.+  .+  * @tailWith@, @convertContinuation@, and @!@ from+    @Data.Vector.Fixed@ removed.+  .+  * @Vector@ instance for tuples added.+  .+  Changes in 0.1.2+  .+  * @imap@, @imapM@, @ifoldl@, @ifoldM@, @zipWithM@, @izipWithM@+    functions are 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@. + Cabal-Version:  >= 1.8 License:        BSD3 License-File:   LICENSE@@ -53,17 +75,18 @@     -- API     Data.Vector.Fixed     Data.Vector.Fixed.Internal-    -- Arrays+    Data.Vector.Fixed.Cont     Data.Vector.Fixed.Mutable+    -- Arrays     Data.Vector.Fixed.Boxed     Data.Vector.Fixed.Primitive     Data.Vector.Fixed.Unboxed     Data.Vector.Fixed.Storable  Test-Suite doctests-  Type: exitcode-stdio-1.0-  Hs-Source-Dirs: test-  Main-Is: Doctests.hs+  Type:           exitcode-stdio-1.0+  Hs-source-dirs: test+  Main-is:        Doctests.hs   Build-Depends:     base >=3 && <5,     primitive,