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 +170/−354
- Data/Vector/Fixed/Boxed.hs +5/−0
- Data/Vector/Fixed/Cont.hs +510/−0
- Data/Vector/Fixed/Internal.hs +49/−55
- Data/Vector/Fixed/Primitive.hs +4/−0
- Data/Vector/Fixed/Storable.hs +4/−0
- Data/Vector/Fixed/Unboxed.hs +3/−0
- fixed-vector.cabal +28/−5
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,