fixed-vector 0.5.1.2 → 0.6.0.0
raw patch · 8 files changed
+223/−29 lines, 8 filesdep ~base
Dependency ranges changed: base
Files
- ChangeLog +9/−0
- Data/Vector/Fixed.hs +30/−0
- Data/Vector/Fixed/Boxed.hs +27/−3
- Data/Vector/Fixed/Cont.hs +67/−15
- Data/Vector/Fixed/Primitive.hs +25/−3
- Data/Vector/Fixed/Storable.hs +39/−3
- Data/Vector/Fixed/Unboxed.hs +25/−4
- fixed-vector.cabal +1/−1
ChangeLog view
@@ -1,3 +1,12 @@+Changes in 0.6.0.0++ * Data instance for all array-based vectors added.++ * Storable instance added for `Storable.Vec'.++ * Monoid instances added for all vectors.++ Changes in 0.5.1.0 * Zero-element vector `Empty' is added.
Data/Vector/Fixed.hs view
@@ -11,6 +11,27 @@ -- For encoding of vector size library uses Peano naturals defined in -- the library. At come point in the future it would make sense to -- switch to new GHC type level numerals.+--+-- [@Common pitfalls@]+--+-- Library provide instances for tuples. But there's a catch. Tuples+-- are monomorphic in element type. Let consider 2-tuple @(Int,Int)@.+-- Vector type @v@ is @(,) Int@ and only allowed element type is+-- @Int@. Because of that we cannot change element type and following+-- code will fail:+--+-- > >>> map (== 1) ((1,2) :: (Int,Int))+-- >+-- > <interactive>:3:1:+-- > Couldn't match type `Int' with `Bool'+-- > In the expression: F.map (== 1) ((1, 2) :: (Int, Int))+-- > In an equation for `it': it = map (== 1) ((1, 2) :: (Int, Int))+--+-- To make it work we need to change vector type as well. Functions+-- from module "Data.Vector.Fixed.Generic" provide this functionality.+--+-- > >>> map (== 1) ((1,2) :: (Int,Int)) :: (Bool,Bool)+-- > (True,False) module Data.Vector.Fixed ( -- * Vector type class -- ** Vector size@@ -125,6 +146,7 @@ import Control.Applicative (Applicative(..),(<$>)) import Data.Data (Typeable,Data)+import Data.Monoid (Monoid(..)) import qualified Data.Foldable as F import qualified Data.Traversable as T @@ -252,6 +274,11 @@ instance Arity n => T.Traversable (VecList n) where sequenceA = sequenceA traverse = traverse+instance (Arity n, Monoid a) => Monoid (VecList n a) where+ mempty = replicate mempty+ mappend = zipWith mappend+ {-# INLINE mempty #-}+ {-# INLINE mappend #-} -- | Single-element tuple.@@ -265,6 +292,9 @@ instance T.Traversable Only where sequenceA (Only f) = Only <$> f traverse f (Only a) = Only <$> f a+instance Monoid a => Monoid (Only a) where+ mempty = Only mempty+ Only a `mappend` Only b = Only $ mappend a b type instance Dim Only = S Z
Data/Vector/Fixed/Boxed.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -18,13 +19,15 @@ import Control.Applicative (Applicative(..)) import Data.Primitive.Array-import Data.Typeable (Typeable)+import Data.Monoid (Monoid(..))+import Data.Data import qualified Data.Foldable as F import qualified Data.Traversable as T import Prelude hiding (length,replicate,zipWith,map,foldl,foldr) import Data.Vector.Fixed hiding (index) import Data.Vector.Fixed.Mutable+import qualified Data.Vector.Fixed.Cont as C @@ -34,19 +37,35 @@ -- | Vector with fixed length which can hold any value. newtype Vec n a = Vec (Array a)- deriving (Typeable) -- | Mutable unboxed vector with fixed length newtype MVec n s a = MVec (MutableArray s a)- deriving (Typeable) +deriving instance Typeable2 Vec+deriving instance Typeable3 MVec+ type Vec2 = Vec (S (S Z)) type Vec3 = Vec (S (S (S Z))) type Vec4 = Vec (S (S (S (S Z)))) type Vec5 = Vec (S (S (S (S (S Z))))) +instance (Typeable n, Arity n, Data a) => Data (Vec n a) where+ gfoldl = C.gfoldl+ gunfold = C.gunfold+ toConstr _ = con_Vec+ dataTypeOf _ = ty_Vec ++ty_Vec :: DataType+ty_Vec = mkDataType "Data.Vector.Fixed.Boxed.Vec" [con_Vec]++con_Vec :: Constr+con_Vec = mkConstr ty_Vec "Vec" [] Prefix++++ ---------------------------------------------------------------- -- Instances ----------------------------------------------------------------@@ -102,6 +121,11 @@ compare = ord {-# INLINE compare #-} +instance (Arity n, Monoid a) => Monoid (Vec n a) where+ mempty = replicate mempty+ mappend = zipWith mappend+ {-# INLINE mempty #-}+ {-# INLINE mappend #-} instance Arity n => Functor (Vec n) where {-# INLINE fmap #-}
Data/Vector/Fixed/Cont.hs view
@@ -104,11 +104,14 @@ , or , all , any+ -- ** Data.Data.Data+ , gfoldl+ , gunfold ) where import Control.Applicative (Applicative(..),(<$>)) import Data.Complex (Complex(..))-import Data.Typeable (Typeable(..))+import Data.Data (Typeable(..),Data) import qualified Data.Foldable as F import qualified Data.Traversable as F @@ -117,6 +120,7 @@ , head,tail,mapM,mapM_,sequence,sequence_ ) + ---------------------------------------------------------------- -- Naturals ----------------------------------------------------------------@@ -214,7 +218,12 @@ -- | Reverse order of parameters. reverseF :: Fun n a b -> Fun n a b+ -- | Worker function for 'gunfold'+ gunfoldF :: (Arity n, Data a)+ => (forall b x. Data b => c (b -> x) -> c x)+ -> T_gunfold c r a n -> c r +newtype T_gunfold c r a n = T_gunfold (c (Fn n a r)) -- | Apply all parameters to the function.@@ -240,30 +249,40 @@ applyFun _ t h = (h,t) applyFunM _ t = return (empty, t) arity _ = 0- reverseF = id {-# INLINE accum #-} {-# INLINE applyFun #-} {-# INLINE applyFunM #-} {-# INLINE arity #-}- {-# INLINE reverseF #-}-+ reverseF = id+ gunfoldF _ (T_gunfold c) = c+ {-# INLINE reverseF #-}+ {-# INLINE gunfoldF #-} instance Arity n => Arity (S n) where accum f g t = \a -> accum f g (f t a) applyFun f t h = case f t of (a,u) -> applyFun f u (h a)- applyFunM f t = do (a,t') <- f t- (ContVec cont, tZ) <- applyFunM f t'- return (ContVec $ \g -> cont (apFun g a) , tZ)+ applyFunM f t = do (a,t') <- f t+ (vec,tZ) <- applyFunM f t'+ return (cons a vec , tZ) arity _ = 1 + arity (undefined :: n)- reverseF f = Fun $ \a -> unFun (reverseF $ fmap ($ a) $ hideLast f) {-# INLINE accum #-} {-# INLINE applyFun #-} {-# INLINE applyFunM #-} {-# INLINE arity #-}- {-# INLINE reverseF #-}+ reverseF f = Fun $ \a -> unFun (reverseF $ fmap ($ a) $ hideLast f)+ gunfoldF f c = gunfoldF f (apGunfold f c)+ {-# INLINE reverseF #-}+ {-# INLINE gunfoldF #-} +apGunfold :: Data a+ => (forall b x. Data b => c (b -> x) -> c x)+ -> T_gunfold c r a (S n)+ -> T_gunfold c r a n+apGunfold f (T_gunfold c) = T_gunfold $ f c+{-# INLINE apGunfold #-} + ---------------------------------------------------------------- -- Combinators ----------------------------------------------------------------@@ -290,7 +309,7 @@ hideLast (Fun f0) = Fun $ accum (\(T_fun f) a -> T_fun (f a)) (\(T_fun f) -> f) (T_fun f0 :: T_fun a b n)- + newtype T_fun a b n = T_fun (Fn (S n) a b) @@ -589,7 +608,7 @@ {-# INLINE imapM #-} imapM f v = inspect v- $ imapMF f construct + $ imapMF f construct -- | Apply monadic action to each element of vector and ignore result. mapM_ :: (Arity n, Monad m) => (a -> m b) -> ContVec n a -> m ()@@ -615,7 +634,7 @@ (T_mapM 0 (return funB) :: T_mapM b m r n) data T_mapM a m r n = T_mapM Int (m (Fn n a r))- + imapF :: forall n a b r. Arity n => (Int -> a -> b) -> Fun n b r -> Fun n a r {-# INLINE imapF #-}@@ -796,7 +815,7 @@ -- fini :: T_lens f a r Z -> f r fini (T_lens (Left _)) = error "Data.Vector.Fixed.lensF: Index out of range"- fini (T_lens (Right r)) = r + fini (T_lens (Right r)) = r -- start :: T_lens f a r n start = T_lens $ Left (n,fun0)@@ -909,8 +928,41 @@ any f = foldr (\x b -> f x && b) True {-# INLINE any #-} +-- | Generic 'Data.Data.gfoldl' which could work with any vector.+gfoldl :: forall c v a. (Vector v a, Data a)+ => (forall x y. Data x => c (x -> y) -> x -> c y)+ -> (forall x . x -> c x)+ -> v a -> c (v a)+gfoldl f inj v+ = inspect v+ $ gfoldlF f (inj $ unFun (construct :: Fun (Dim v) a (v a))) - +-- | Generic 'Data.Data.gunfoldl' which could work with any+-- vector. Since vector can only have one constructor argument for+-- constructor is ignored.+gunfold :: forall con c v a. (Vector v a, Data a)+ => (forall b r. Data b => c (b -> r) -> c r)+ -> (forall r. r -> c r)+ -> con -> c (v a)+gunfold f inj _+ = gunfoldF f gun+ where+ con = construct :: Fun (Dim v) a (v a)+ gun = T_gunfold (inj $ unFun con) :: T_gunfold c (v a) a (Dim v)+++gfoldlF :: forall c r a n. (Arity n, Data a)+ => (forall x y. Data x => c (x -> y) -> x -> c y)+ -> c (Fn n a r) -> Fun n a (c r)+gfoldlF f c0 = Fun $ accum+ (\(T_gfoldl c) x -> T_gfoldl (f c x))+ (\(T_gfoldl c) -> c)+ (T_gfoldl c0 :: T_gfoldl c r a n)++newtype T_gfoldl c r a n = T_gfoldl (c (Fn n a r))+++ ---------------------------------------------------------------- -- Deforestation ----------------------------------------------------------------@@ -942,7 +994,7 @@ cvec (vector v) = v #-} - + ---------------------------------------------------------------- -- Instances ----------------------------------------------------------------
Data/Vector/Fixed/Primitive.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -21,13 +22,15 @@ ) where import Control.Monad-import Data.Typeable (Typeable)+import Data.Data+import Data.Monoid (Monoid(..)) import Data.Primitive.ByteArray import Data.Primitive import Prelude hiding (length,replicate,zipWith,map,foldl) import Data.Vector.Fixed hiding (index) import Data.Vector.Fixed.Mutable+import qualified Data.Vector.Fixed.Cont as C @@ -37,12 +40,13 @@ -- | Unboxed vector with fixed length newtype Vec n a = Vec ByteArray- deriving (Typeable) -- | Mutable unboxed vector with fixed length newtype MVec n s a = MVec (MutableByteArray s)- deriving (Typeable) +deriving instance Typeable2 Vec+deriving instance Typeable3 MVec+ type Vec2 = Vec (S (S Z)) type Vec3 = Vec (S (S (S Z))) type Vec4 = Vec (S (S (S (S Z))))@@ -105,4 +109,22 @@ instance (Arity n, Prim a, Ord a) => Ord (Vec n a) where compare = ord {-# INLINE compare #-}++instance (Arity n, Prim a, Monoid a) => Monoid (Vec n a) where+ mempty = replicate mempty+ mappend = zipWith mappend+ {-# INLINE mempty #-}+ {-# INLINE mappend #-}++instance (Typeable n, Arity n, Prim a, Data a) => Data (Vec n a) where+ gfoldl = C.gfoldl+ gunfold = C.gunfold+ toConstr _ = con_Vec+ dataTypeOf _ = ty_Vec++ty_Vec :: DataType+ty_Vec = mkDataType "Data.Vector.Fixed.Primitive.Vec" [con_Vec]++con_Vec :: Constr+con_Vec = mkConstr ty_Vec "Vec" [] Prefix
Data/Vector/Fixed/Storable.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -23,7 +24,9 @@ ) where import Control.Monad.Primitive-import Data.Typeable (Typeable)+import Data.Monoid (Monoid(..))+import Data.Data+import Foreign.Ptr (castPtr) import Foreign.Storable import Foreign.ForeignPtr import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray )@@ -34,6 +37,7 @@ import Data.Vector.Fixed hiding (index) import Data.Vector.Fixed.Mutable+import qualified Data.Vector.Fixed.Cont as C @@ -43,12 +47,13 @@ -- | Storable-based vector with fixed length newtype Vec n a = Vec (ForeignPtr a)- deriving (Typeable) -- | Storable-based mutable vector with fixed length newtype MVec n s a = MVec (ForeignPtr a)- deriving (Typeable) +deriving instance Typeable2 Vec+deriving instance Typeable3 MVec+ type Vec2 = Vec (S (S Z)) type Vec3 = Vec (S (S (S Z))) type Vec4 = Vec (S (S (S (S Z))))@@ -151,6 +156,37 @@ instance (Arity n, Storable a, Ord a) => Ord (Vec n a) where compare = ord {-# INLINE compare #-}++instance (Arity n, Storable a, Monoid a) => Monoid (Vec n a) where+ mempty = replicate mempty+ mappend = zipWith mappend+ {-# INLINE mempty #-}+ {-# INLINE mappend #-}++instance (Arity n, Storable a) => Storable (Vec n a) where+ sizeOf _ = arity (undefined :: n) * sizeOf (undefined :: a)+ alignment _ = alignment (undefined :: a)+ peek ptr = do+ arr@(MVec fp) <- new+ withForeignPtr fp $ \p ->+ moveArray p (castPtr ptr) (arity (undefined :: n))+ unsafeFreeze arr+ poke ptr (Vec fp)+ = withForeignPtr fp $ \p ->+ moveArray (castPtr ptr) p (arity (undefined :: n))++instance (Typeable n, Arity n, Storable a, Data a) => Data (Vec n a) where+ gfoldl = C.gfoldl+ gunfold = C.gunfold+ toConstr _ = con_Vec+ dataTypeOf _ = ty_Vec++ty_Vec :: DataType+ty_Vec = mkDataType "Data.Vector.Fixed.Primitive.Vec" [con_Vec]++con_Vec :: Constr+con_Vec = mkConstr ty_Vec "Vec" [] Prefix+
Data/Vector/Fixed/Unboxed.hs view
@@ -24,16 +24,19 @@ import Control.Monad import Data.Complex-import Data.Typeable (Typeable2,Typeable3)-import Data.Int ( Int8, Int16, Int32, Int64 )-import Data.Word (Word,Word8,Word16,Word32,Word64)+import Data.Monoid (Monoid(..))+import Data.Data+import Data.Int (Int8, Int16, Int32, Int64 )+import Data.Word (Word,Word8,Word16,Word32,Word64) import Prelude hiding (length,replicate,zipWith,map,foldl) -import Data.Vector.Fixed (Dim,Vector(..),VectorN,S,Z,toList,eq,ord)+import Data.Vector.Fixed (Dim,Vector(..),VectorN,S,Z,toList,eq,ord,replicate,zipWith) import Data.Vector.Fixed.Mutable+import qualified Data.Vector.Fixed.Cont as C import qualified Data.Vector.Fixed.Primitive as P + ---------------------------------------------------------------- -- Data type ----------------------------------------------------------------@@ -81,6 +84,24 @@ instance (Unbox n a, Ord a) => Ord (Vec n a) where compare = ord {-# INLINE compare #-}++instance (Unbox n a, Monoid a) => Monoid (Vec n a) where+ mempty = replicate mempty+ mappend = zipWith mappend+ {-# INLINE mempty #-}+ {-# INLINE mappend #-}++instance (Typeable n, Unbox n a, Data a) => Data (Vec n a) where+ gfoldl = C.gfoldl+ gunfold = C.gunfold+ toConstr _ = con_Vec+ dataTypeOf _ = ty_Vec++ty_Vec :: DataType+ty_Vec = mkDataType "Data.Vector.Fixed.Unboxed.Vec" [con_Vec]++con_Vec :: Constr+con_Vec = mkConstr ty_Vec "Vec" [] Prefix
fixed-vector.cabal view
@@ -1,5 +1,5 @@ Name: fixed-vector-Version: 0.5.1.2+Version: 0.6.0.0 Synopsis: Generic vectors with statically known size. Description: Generic library for vectors with statically known