fixed-vector 0.9.0.0 → 1.0.0.0

raw patch · 11 files changed

+679/−1063 lines, 11 filesdep ~basedep ~primitivePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, primitive

API changes (from Hackage documentation)

Files

• ChangeLog.md +22/−0
• Data/Vector/Fixed.hs +49/−79
• Data/Vector/Fixed/Boxed.hs +24/−22
• Data/Vector/Fixed/Cont.hs +277/−360
• Data/Vector/Fixed/Internal.hs +105/−107
• Data/Vector/Fixed/Monomorphic.hs +0/−379
• Data/Vector/Fixed/Mutable.hs +24/−28
• Data/Vector/Fixed/Primitive.hs +16/−14
• Data/Vector/Fixed/Storable.hs +23/−27
• Data/Vector/Fixed/Unboxed.hs +130/−29
• fixed-vector.cabal +9/−18

@@ -1,3 +1,25 @@+Changes in 1.0.0.0++  * Vector length now expressed as GHC's type level literals. Underlying+    implementation still uses Peano numbers to perform induction. This doesn't+    change user facing API much. Notably `FlexibleInstances` and+    `GADTs`/`TypeFamiles` are now required to write `Arity` constraint.++  * `Monad` constraint is relaxed to `Applicative` where applicable. Duplicate+    functions are removed (`sequence` & `sequenceA` → `sequence`, etc)++  * Module `Data.Vector.Fixed.Monomorphic` is dropped.++  * Construction of N-ary vectors reworked. `Make` type class is gone.++  * Boxed arrays now use SmallArrays internally.++  * `overlaps` is removed from API for mutable vectors.++  * `Data.Vector.Fixed.defaultRnf` is added.++  * `Data.Vector.Fixed.Mutable.lengthI` is dropped.+ Changes in 0.9.0.0    * Simplification of `Arity` type class. This change shouldn't affect client

@@ -1,10 +1,15 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE TypeFamilies      #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE PolyKinds             #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-} -- | -- Generic API for vectors with fixed length. --@@ -36,15 +41,6 @@     -- * Vector type class     -- ** Vector size     Dim-  , Z-  , S-    -- ** Synonyms for small numerals-  , N1-  , N2-  , N3-  , N4-  , N5-  , N6     -- ** Type class   , Vector(..)   , VectorN@@ -61,14 +57,12 @@   , mk3   , mk4   , mk5-    -- ** Consing+  , mkN+    -- ** Continuation-based vectors   , ContVec   , empty   , vector-  , (<|)-    -- ** Variadic function-  , Make-  , mkN+  , C.cvec     -- ** Functions   , replicate   , replicateM@@ -85,7 +79,7 @@   , concat   , reverse     -- ** Indexing & lenses-  , C.Index+  -- , C.Index   , (!)   , index   , set@@ -109,8 +103,6 @@   , traverse   , distribute   , collect-  , distributeM-  , collectM     -- * Folding   , foldl   , foldr@@ -145,6 +137,8 @@   , defaultSizeOf   , defaultPeek   , defaultPoke+    -- * NFData+  , defaultRnf     -- * Conversion   , convert   , toList@@ -154,6 +148,7 @@   , fromFoldable     -- * Data types   , VecList(..)+  , VecPeano(..)   , Only(..)   , Empty(..)     -- ** Tuple synonyms@@ -171,14 +166,14 @@ import qualified Data.Traversable as T import Foreign.Storable (Storable(..)) import Foreign.Ptr      (castPtr)+import GHC.TypeLits -import Data.Vector.Fixed.Cont     (Vector(..),VectorN,Dim,length,ContVec,vector,-                                   empty,S,Z,Arity,Fun(..),accum,apply,-                                   N1,N2,N3,N4,N5,N6,vector)+import Data.Vector.Fixed.Cont     (Vector(..),VectorN,Dim,length,ContVec,PeanoNum(..),+                                   vector,empty,Arity,Fun(..),accum,apply,vector) import qualified Data.Vector.Fixed.Cont as C import Data.Vector.Fixed.Internal -import Prelude (Show(..),Eq(..),Ord(..),Functor(..),id,(.),($),seq,undefined)+import Prelude (Show(..),Eq(..),Ord(..),Functor(..),id,(.),($),undefined) -- Needed for doctest import Prelude (Char) @@ -192,6 +187,9 @@ -- >>> mk3 'a' 'b' 'c' :: (Char,Char,Char) -- ('a','b','c') --+-- Alternatively one could use 'mkN'. See its documentation for+-- examples+-- -- Another option is to create tuple and 'convert' it to desired -- vector type. For example: --@@ -204,21 +202,8 @@ -- > function :: Vec N3 Double -> ... -- > function (convert -> (x,y,z)) = ... ----- Third way is to use variadic function 'mkN'. It works similarly to--- 'Text.Printf.printf' except it produces result of type 'ContVec'--- which should be converted to vector of desired type by 'vector':------ >>> vector $ mkN 'a' 'b' 'c' :: (Char,Char,Char)--- ('a','b','c')------ Probably most generic way is to cons values to the @ContVec@ and--- convert it vector of desired type using 'vector':------ >>> vector $ 'a' <| 'b' <| 'c' <| empty :: (Char,Char,Char)--- ('a','b','c')  - -- $smallDim -- -- Constructors for vectors with small dimensions.@@ -231,60 +216,39 @@   ------------------------------------------------------------------------------------ We are trying to be clever with indexing here. It's not possible to--- write generic indexing function. For example it's necessary O(n)--- for VecList. It's however possible to write O(1) indexing for some--- vectors and we trying to use such functions where possible.------ We try to use presumable more efficient basicIndex------  1. It should not interfere with deforestation. So we should---     rewrite only when deforestation rule already fired.---     (starting from phase 1).------  2. Creation of vector is costlier than generic indexing so we should---     apply rule only when vector is created anyway------ In order to avoid firing this rule on implementation of (!) it has--- been necessary to move definition of all functions to internal module.--{-# RULES-"fixed-vector:index/basicIndex"[1] forall vv i.-  runIndex i (C.cvec vv) = C.basicIndex vv i- #-}-+-- | Type-based vector with statically known length parametrized by+--   GHC's type naturals+newtype VecList (n :: Nat) a = VecList (VecPeano (C.Peano n) a) --- | Vector based on the lists. Not very useful by itself but is---   necessary for implementation.-data VecList n a where-  Nil  :: VecList Z a-  Cons :: a -> VecList n a -> VecList (S n) a+-- | Standard GADT-based vector with statically known length+--   parametrized by Peano numbers.+data VecPeano (n :: PeanoNum) a where+  Nil  :: VecPeano 'Z a+  Cons :: a -> VecPeano n a -> VecPeano ('S n) a   deriving (Typeable)  instance (Arity n, NFData a) => NFData (VecList n a) where-  rnf = foldl (\r a -> r `seq` rnf a) ()+  rnf = defaultRnf   {-# INLINE rnf #-} --- Vector instance type instance Dim (VecList n) = n  instance Arity n => Vector (VecList n) a where-  construct = accum+  construct = fmap VecList $ accum     (\(T_List f) a -> T_List (f . Cons a))     (\(T_List f)   -> f Nil)-    (T_List id :: T_List a n n)-  inspect v = inspect $ apply step (Flip v)+    (T_List id :: T_List a (C.Peano n) (C.Peano n))+  inspect (VecList v)+    = inspect (apply step (Flip v) :: C.ContVec n a)     where-      step :: Flip VecList a (S k)  -> (a, Flip VecList a k)+      step :: Flip VecPeano a ('S k)  -> (a, Flip VecPeano a k)       step (Flip (Cons a xs)) = (a, Flip xs)   {-# INLINE construct #-}   {-# INLINE inspect   #-} instance Arity n => VectorN VecList n a  newtype Flip f a n = Flip (f n a)--newtype T_List a n k = T_List (VecList k a -> VecList n a)+newtype T_List a n k = T_List (VecPeano k a -> VecPeano n a)   -- Standard instances@@ -340,7 +304,7 @@ instance NFData a => NFData (Only a) where   rnf (Only a) = rnf a -type instance Dim Only = S Z+type instance Dim Only = 1  instance Vector Only a where   construct = Fun Only@@ -360,7 +324,13 @@   -- | Empty tuple.-data Empty a = Empty deriving (Typeable, Data)+data Empty a = Empty+  deriving (Show,Eq,Ord)+-- GHC7.10 wants standalone deriving for some reason:+-- >    No instance for (Typeable a)+-- >      arising from the 'deriving' clause of a data type declaration+deriving instance Typeable a => Typeable (Empty a)+deriving instance Data     a => Data     (Empty a)  instance Functor Empty where   fmap _ Empty = Empty@@ -373,7 +343,7 @@ instance NFData (Empty a) where   rnf Empty = () -type instance Dim Empty = Z+type instance Dim Empty = 0  instance Vector Empty a where   construct = Fun Empty

@@ -1,9 +1,12 @@-{-# LANGUAGE StandaloneDeriving    #-}-{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-} -- | -- Vector which could hold any value. module Data.Vector.Fixed.Boxed (@@ -20,14 +23,15 @@  import Control.Applicative  (Applicative(..)) import Control.DeepSeq      (NFData(..))-import Data.Primitive.Array+import Data.Primitive.SmallArray import Data.Monoid          (Monoid(..)) import Data.Data import qualified Data.Foldable    as F import qualified Data.Traversable as T import Foreign.Storable (Storable(..))-import Prelude (Show(..),Eq(..),Ord(..),Functor(..),Monad(..))-import Prelude ((++),($),($!),undefined,error,seq)+import GHC.TypeLits+import Prelude ( Show(..),Eq(..),Ord(..),Functor(..),Monad(..)+               , (++),($),($!),error,seq)  import Data.Vector.Fixed hiding (index) import Data.Vector.Fixed.Mutable@@ -40,19 +44,19 @@ ----------------------------------------------------------------  -- | Vector with fixed length which can hold any value.-newtype Vec n a = Vec (Array a)+newtype Vec (n :: Nat) a = Vec (SmallArray a)  -- | Mutable unboxed vector with fixed length-newtype MVec n s a = MVec (MutableArray s a)+newtype MVec (n :: Nat) s a = MVec (SmallMutableArray s a)  deriving instance Typeable Vec deriving instance Typeable MVec -type Vec1 = Vec (S Z)-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)))))+type Vec1 = Vec 1+type Vec2 = Vec 2+type Vec3 = Vec 3+type Vec4 = Vec 4+type Vec5 = Vec 5   instance (Typeable n, Arity n, Data a) => Data (Vec n a) where@@ -94,25 +98,23 @@ type instance Mutable (Vec n) = MVec n  instance (Arity n) => MVector (MVec n) a where-  overlaps (MVec v) (MVec u) = sameMutableArray v u-  {-# INLINE overlaps    #-}   new = do-    v <- newArray (arity (undefined :: n)) uninitialised+    v <- newSmallArray (arity (Proxy :: Proxy n)) uninitialised     return $ MVec v   {-# INLINE new         #-}   copy = move   {-# INLINE copy        #-}-  move (MVec dst) (MVec src) = copyMutableArray dst 0 src 0 (arity (undefined :: n))+  move (MVec dst) (MVec src) = copySmallMutableArray dst 0 src 0 (arity (Proxy :: Proxy n))   {-# INLINE move        #-}-  unsafeRead  (MVec v) i   = readArray  v i+  unsafeRead  (MVec v) i   = readSmallArray  v i   {-# INLINE unsafeRead  #-}-  unsafeWrite (MVec v) i x = writeArray v i x+  unsafeWrite (MVec v) i x = writeSmallArray v i x   {-# INLINE unsafeWrite #-}  instance (Arity n) => IVector (Vec n) a where-  unsafeFreeze (MVec v)   = do { a <- unsafeFreezeArray v; return $! Vec  a }-  unsafeThaw   (Vec  v)   = do { a <- unsafeThawArray   v; return $! MVec a }-  unsafeIndex  (Vec  v) i = indexArray v i+  unsafeFreeze (MVec v)   = do { a <- unsafeFreezeSmallArray v; return $! Vec  a }+  unsafeThaw   (Vec  v)   = do { a <- unsafeThawSmallArray   v; return $! MVec a }+  unsafeIndex  (Vec  v) i = indexSmallArray v i   {-# INLINE unsafeFreeze #-}   {-# INLINE unsafeThaw   #-}   {-# INLINE unsafeIndex  #-}

@@ -1,40 +1,33 @@-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE EmptyDataDecls        #-}+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DataKinds             #-} {-# LANGUAGE DeriveDataTypeable    #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE EmptyDataDecls        #-} {-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds             #-} {-# LANGUAGE Rank2Types            #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE DataKinds, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-} -- | -- API for Church-encoded vectors. Implementation of function from -- "Data.Vector.Fixed" module uses these function internally in order -- to provide shortcut fusion. module Data.Vector.Fixed.Cont (     -- * Type-level numbers-    S-  , Z+    PeanoNum(..)+  , Peano   , Add-    -- ** Isomorphism between Peano number and Nats-    -- $natiso-  , NatIso-  , ToPeano-  , ToNat-    -- ** Synonyms for small numerals-  , N1-  , N2-  , N3-  , N4-  , N5-  , N6     -- * N-ary functions   , Fn   , Fun(..)-  , Arity(..)+  , Arity+  , ArityPeano(..)+  , arity   , apply   , applyM     -- ** Combinators@@ -51,9 +44,12 @@   , Vector(..)   , VectorN   , length-  , Index(..)     -- * Vector as continuation   , ContVec(..)+  , CVecPeano(..)+  , consPeano+  , toContVec+  , runContVec     -- * Construction of ContVec   , cvec   , fromList@@ -90,8 +86,6 @@   , sequence_   , distribute   , collect-  , distributeM-  , collectM   , tail   , reverse     -- ** Zips@@ -103,13 +97,10 @@   , zipWithM_   , izipWithM   , izipWithM_-    -- * Running ContVec-  , runContVec     -- ** Getters   , head   , index   , element-  , elementTy     -- ** Vector construction   , vector     -- ** Folds@@ -134,15 +125,16 @@   , gunfold   ) where -import Control.Applicative (Applicative(..),(<$>),(<|>))-import Control.Monad       (liftM)+import Control.Applicative   ((<|>)) import Data.Coerce-import Data.Complex        (Complex(..))-import Data.Data           (Typeable,Data)-import Data.Typeable       (Proxy(..))-import GHC.TypeLits+import Data.Complex          (Complex(..))+import Data.Data             (Data)+import Data.Functor.Identity (Identity(..))+import Data.Typeable         (Proxy(..)) import qualified Data.Foldable    as F import qualified Data.Traversable as F+import Unsafe.Coerce       (unsafeCoerce)+import GHC.TypeLits  import Prelude hiding ( replicate,map,zipWith,zipWith3,maximum,minimum,and,or,any,all                       , foldl,foldr,foldl1,length,sum,reverse,scanl,scanl1@@ -154,76 +146,46 @@ -- Naturals ---------------------------------------------------------------- --- | Type level zero-data Z   deriving Typeable--- | Successor of n-data S n deriving Typeable---- | Type family for sum of unary natural numbers.-type family Add n m :: *--type instance Add  Z    n = n-type instance Add (S n) k = S (Add n k)--type N1 = S Z-type N2 = S N1-type N3 = S N2-type N4 = S N3-type N5 = S N4-type N6 = S N5----- $natiso------ It's only become possible to define isomorphism between Peano--- number and built-in @Nat@ number in GHC 7.8. It's however--- impossible to define their properties inductively. So Peano number--- are used everywhere.---- | Isomorphism between two representations of natural numbers-class (ToNat a ~ b, ToPeano b ~ a) => NatIso (a :: *) (b :: Nat) where---- | Convert Peano number to Nat-type family ToNat   (a :: *  ) :: Nat where-  ToNat  Z    = 0-  ToNat (S k) = 1 + ToNat k---- | Convert Nat number to Peano represenation-type family ToPeano (b :: Nat) :: * where-  ToPeano 0 = Z-  ToPeano n = S (ToPeano (n - 1))+-- | Peano numbers. Since type level naturals don't support induction+--   we have to convert type nats to Peano representation first and+--   work with it,+data PeanoNum = Z+              | S PeanoNum -instance NatIso  Z 0 where-instance ( NatIso k (n - 1)-         , ToPeano (n - 1) ~ k-         , ToPeano  n    ~ S k-         , n ~ (1 + (n - 1))    -- n is positive-         ) => NatIso (S k) n where+-- | Convert type level natural to Peano representation+type family Peano (n :: Nat) :: PeanoNum where+  Peano 0 = 'Z+  Peano n = 'S (Peano (n - 1)) +-- | Type family for sum of unary natural numbers.+type family Add (n :: PeanoNum) (m :: PeanoNum) :: PeanoNum where+  Add  'Z    n = n+  Add ('S n) k = 'S (Add n k)   ---------------------------------------------------------------- -- N-ary functions ---------------------------------------------------------------- --- | Type family for n-ary functions.-type family   Fn n a b-type instance Fn Z     a b = b-type instance Fn (S n) a b = a -> Fn n a b+-- | Type family for n-ary functions. @n@ is number of parameters of+--   type @a@ and @b@ is result type.+type family Fn (n :: PeanoNum) (a :: *) (b :: *) where+  Fn 'Z     a b = b+  Fn ('S n) a b = a -> Fn n a b  -- | Newtype wrapper which is used to make 'Fn' injective. It's also a --   reader monad. newtype Fun n a b = Fun { unFun :: Fn n a b }  -instance Arity n => Functor (Fun n a) where+instance ArityPeano n => Functor (Fun n a) where   fmap f fun      = accum (\(T_Flip g) a -> T_Flip (curryFirst g a))              (\(T_Flip x)   -> f (unFun x))              (T_Flip fun)   {-# INLINE fmap #-} -instance Arity n => Applicative (Fun n a) where+instance ArityPeano n => Applicative (Fun n a) where   pure x = accum (\Proxy _ -> Proxy)                  (\Proxy   -> x)                   Proxy@@ -234,14 +196,13 @@   {-# INLINE pure  #-}   {-# INLINE (<*>) #-} -instance Arity n => Monad (Fun n a) where+instance ArityPeano n => Monad (Fun n a) where   return  = pure   f >>= g = shuffleFun g <*> f   {-# INLINE return #-}   {-# INLINE (>>=)  #-} --data    T_ap   a b c n = T_ap (Fn n a b) (Fn n a c)+data T_ap a b c n = T_ap (Fn n a b) (Fn n a c)   @@ -249,114 +210,111 @@ -- Generic operations of N-ary functions ---------------------------------------------------------------- +-- | Type class for type level number for which we can defined+--   operations over N-ary functions.+type Arity n = ( ArityPeano (Peano n)+               , KnownNat n+               , Peano (n+1) ~ 'S (Peano n)+               )+ -- | Type class for handling /n/-ary functions.-class Arity n where+class ArityPeano n where   -- | Left fold over /n/ elements exposed as n-ary function. These   --   elements are supplied as arguments to the function.-  accum :: (forall k. t (S k) -> a -> t k) -- ^ Fold function-        -> (t Z -> b)                      -- ^ Extract result of fold-        -> t n                             -- ^ Initial value-        -> Fun n a b                       -- ^ Reduction function+  accum :: (forall k. t ('S k) -> a -> t k) -- ^ Fold function+        -> (t 'Z -> b)                      -- ^ Extract result of fold+        -> t n                              -- ^ Initial value+        -> Fun n a b                        -- ^ Reduction function    -- | Apply all parameters to the function.-  applyFun :: (forall k. t (S k) -> (a, t k)) -- ^ Get value to apply to function-           -> t n                             -- ^ Initial value-           -> Fn n a b                        -- ^ N-ary function-           -> (b, t Z)+  applyFun :: (forall k. t ('S k) -> (a, t k))+              -- ^ Get value to apply to function+           -> t n+              -- ^ Initial value+           -> (CVecPeano n a, t 'Z)    -- | Apply all parameters to the function using monadic   --   actions. Note that for identity monad it's same as   --   applyFun. Ignoring newtypes:   ---  -- > forall b. Fn n a b -> b  ~ ContVecn n a-  applyFunM :: Monad m-              => (forall k. t (S k) -> m (a, t k)) -- ^ Get value to apply to function-              -> t n                               -- ^ Initial value-              -> m (ContVec n a, t Z)-  -- | Arity of function.-  arity :: n -> Int-+  -- > forall b. Fn n a b -> b  ~ ContVec n a+  applyFunM :: Applicative f+            => (forall k. t ('S k) -> (f a, t k)) -- ^ Get value to apply to function+            -> t n                                -- ^ Initial value+            -> (f (CVecPeano n a), t 'Z) -  -- | Reverse order of parameters.+  -- | Reverse order of parameters. It's implemented directly in type+  --   class since expressing it in terms of @accum@ will require+  --   putting ArityPeano constraint on step funcion   reverseF :: Fun n a b -> Fun n a b-  -- | Uncurry /n/ first parameters of n-ary function-  uncurryMany :: Fun (Add n k) a b -> Fun n a (Fun k a b)-  +   -- | Worker function for 'gunfold'   gunfoldF :: (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. apply :: Arity n-      => (forall k. t (S k) -> (a, t k)) -- ^ Get value to apply to function-      -> t n                             -- ^ Initial value-      -> ContVec n a                     -- ^ N-ary function+      => (forall k. t ('S k) -> (a, t k)) -- ^ Get value to apply to function+      -> t (Peano n)                      -- ^ Initial value+      -> ContVec n a                      -- ^ N-ary function {-# INLINE apply #-}-apply step z = ContVec $ \(Fun f) -> fst $ applyFun step z f+apply step z = toContVec $ fst (applyFun step z) --- | Apply all parameters to the function using monadic actions.-applyM :: (Monad m, Arity n)-       => (forall k. t (S k) -> m (a, t k)) -- ^ Get value to apply to function-       -> t n                               -- ^ Initial value-       -> m (ContVec n a)+-- | Apply all parameters to the function using applicative actions.+applyM :: (Applicative f, Arity n)+       => (forall k. t ('S k) -> (f a, t k)) -- ^ Get value to apply to function+       -> t (Peano n)                        -- ^ Initial value+       -> f (ContVec n a) {-# INLINE applyM #-}-applyM f t = do (v,_) <- applyFunM f t-                return v+applyM f t = fmap toContVec $ fst $ applyFunM f t -instance Arity Z where+-- | Arity of function.+arity :: KnownNat n => proxy n -> Int+{-# INLINE arity #-}+arity = fromIntegral . natVal++instance ArityPeano 'Z where   accum     _ g t = Fun $ g t-  applyFun  _ t h = (h,t)-  applyFunM _ t   = return (empty, t)-  arity  _ = 0+  applyFun  _ t   = (CVecPeano unFun, t)+  applyFunM _ t   = (pure (CVecPeano unFun), t)   {-# INLINE accum     #-}   {-# INLINE applyFun  #-}   {-# INLINE applyFunM #-}-  {-# INLINE arity     #-}   reverseF = id   gunfoldF _ (T_gunfold c) = c-  uncurryMany = coerce   {-# INLINE reverseF    #-}   {-# INLINE gunfoldF    #-}-  {-# INLINE uncurryMany #-} -instance Arity n => Arity (S n) where+instance ArityPeano n => ArityPeano ('S n) where   accum     f g t = Fun $ \a -> unFun $ 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-                       (vec,tZ) <- applyFunM f t'-                       return (cons a vec , tZ)-  arity    _ = 1 + arity (undefined :: n)+  applyFun  f t   = let (a,t') = f t+                        (v,tZ) = applyFun f t'+                    in  (consPeano a v, tZ)+  applyFunM f t   = let (a,t')   = f t+                        (vec,t0) = applyFunM f t'+                    in  (consPeano <$> a <*> vec, t0)   {-# INLINE accum     #-}   {-# INLINE applyFun  #-}   {-# INLINE applyFunM #-}-  {-# INLINE arity     #-}   reverseF f   = Fun $ \a -> unFun (reverseF $ apLast f a)   gunfoldF f c = gunfoldF f (apGunfold f c)-  -  uncurryMany :: forall k a b. Fun (Add (S n) k) a b -> Fun (S n) a (Fun k a b)-  uncurryMany f-    = coerce-     (fmap uncurryMany (curryFirst f) :: a -> Fun n a (Fun k a b))   {-# INLINE reverseF    #-}   {-# INLINE gunfoldF    #-}-  {-# INLINE uncurryMany #-}  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 ('S n)           -> T_gunfold c r a n apGunfold f (T_gunfold c) = T_gunfold $ f c {-# INLINE apGunfold #-}  -newtype T_Flip    a b n = T_Flip (Fun n a b)-newtype T_Counter n     = T_Counter Int+newtype T_Flip a b n = T_Flip (Fun n a b)   @@ -365,55 +323,52 @@ ----------------------------------------------------------------  -- | Prepend ignored parameter to function-constFun :: Fun n a b -> Fun (S n) a b+constFun :: Fun n a b -> Fun ('S n) a b constFun (Fun f) = Fun $ \_ -> f {-# INLINE constFun #-}  -- | Curry first parameter of n-ary function-curryFirst :: Fun (S n) a b -> a -> Fun n a b+curryFirst :: Fun ('S n) a b -> a -> Fun n a b curryFirst = coerce {-# INLINE curryFirst #-}  -- | Uncurry first parameter of n-ary function-uncurryFirst :: (a -> Fun n a b) -> Fun (S n) a b+uncurryFirst :: (a -> Fun n a b) -> Fun ('S n) a b uncurryFirst = coerce {-# INLINE uncurryFirst #-}  -- | Curry last parameter of n-ary function-curryLast :: Arity n => Fun (S n) a b -> Fun n a (a -> b)+curryLast :: ArityPeano n => Fun ('S n) a b -> Fun n a (a -> b) {-# INLINE curryLast #-}-curryLast (Fun f0) = accum (\(T_fun f) a -> T_fun (f a))-                           (\(T_fun f)   -> f)-                           (T_fun f0)+-- NOTE: This function is essentially rearrangement of newtypes. Since+--       Fn is closed type family it couldn't be extended and it's+--       quite straightforward to show that both types have same+--       representation. Unfortunately GHC cannot infer it so we have+--       to unsafe-coerce it.+curryLast = unsafeCoerce -newtype T_fun a b n = T_fun (Fn (S n) a b)  -- | Curry /n/ first parameters of n-ary function-curryMany :: forall n k a b. Arity n+curryMany :: forall n k a b. ArityPeano n           => Fun (Add n k) a b -> Fun n a (Fun k a b) {-# INLINE curryMany #-}-curryMany (Fun f0) = accum-  (\(T_curry f) a -> T_curry (f a))-  (\(T_curry f) -> Fun f)-  ( T_curry f0 :: T_curry a b k n)--newtype T_curry a b k n = T_curry (Fn (Add n k) a b)-+-- NOTE: It's same as curryLast+curryMany = unsafeCoerce   -- | Apply last parameter to function. Unlike 'apFun' we need to --   traverse all parameters but last hence 'Arity' constraint.-apLast :: Arity n => Fun (S n) a b -> a -> Fun n a b+apLast :: ArityPeano n => Fun ('S n) a b -> a -> Fun n a b apLast f x = fmap ($ x) $ curryLast f {-# INLINE apLast #-}  -- | Recursive step for the function-withFun :: (Fun n a b -> Fun n a b) -> Fun (S n) a b -> Fun (S n) a b+withFun :: (Fun n a b -> Fun n a b) -> Fun ('S n) a b -> Fun ('S n) a b withFun f fun = Fun $ \a -> unFun $ f $ curryFirst fun a {-# INLINE withFun #-}  -- | Move function parameter to the result of N-ary function.-shuffleFun :: Arity n+shuffleFun :: ArityPeano n            => (b -> Fun n a r) -> Fun n a (b -> r) {-# INLINE shuffleFun #-} shuffleFun f0@@ -430,18 +385,27 @@ ----------------------------------------------------------------  -- | Size of vector expressed as type-level natural.-type family Dim (v :: * -> *)+type family Dim (v :: * -> *) :: Nat  -- | Type class for vectors with fixed length. Instance should provide--- two functions: one to create vector and another for vector--- deconstruction. They must obey following law:+--   two functions: one to create vector and another for vector+--   deconstruction. They must obey following law: ----- > inspect v construct = v+--   > inspect v construct = v+--+--   For example instance for 2D vectors could be written as:+--+--   > data V2 a = V2 a a+--   >+--   > type instance V2 = 2+--   > instance Vector V2 a where+--   >   construct                = Fun V2+--   >   inspect (V2 a b) (Fun f) = f a b class Arity (Dim v) => Vector v a where   -- | N-ary function for creation of vectors.-  construct :: Fun (Dim v) a (v a)+  construct :: Fun (Peano (Dim v)) a (v a)   -- | Deconstruction of vector.-  inspect   :: v a -> Fun (Dim v) a b -> b+  inspect   :: v a -> Fun (Peano (Dim v)) a b -> b   -- | Optional more efficient implementation of indexing. Shouldn't   --   be used directly, use 'Data.Vector.Fixed.!' instead.   basicIndex :: v a -> Int -> a@@ -456,34 +420,9 @@ class (Vector (v n) a, Dim (v n) ~ n) => VectorN v n a  -- | Length of vector. Function doesn't evaluate its argument.-length :: forall v a. Arity (Dim v) => v a -> Int+length :: forall v a. KnownNat (Dim v) => v a -> Int {-# INLINE length #-}-length _ = arity (undefined :: Dim v)---- | Type class for indexing of vector when index value is known at---   compile time.-class Index k n where-  getF  :: k -> Fun n a a-  putF  :: k -> a -> Fun n a r -> Fun n a r-  lensF :: Functor f => k -> (a -> f a) -> Fun n a r -> Fun n a (f r)--instance Arity n => Index Z (S n) where-  getF  _       = Fun $ \(a :: a) -> unFun (pure a :: Fun n a a)-  putF  _ a (Fun f) = Fun $ \_ -> f a-  lensF _ f fun = Fun $ \(a :: a) -> unFun $-    (\g -> g <$> f a) <$> shuffleFun (curryFirst fun)-  {-# INLINE getF  #-}-  {-# INLINE putF  #-}-  {-# INLINE lensF #-}--instance Index k n => Index (S k) (S n) where-  getF  _       = Fun $ \(_::a) -> unFun (getF  (undefined :: k) :: Fun n a a)-  putF _ a (f :: Fun (S n) a b)-    = withFun (putF (undefined :: k) a) f-  lensF _ f fun = Fun $ \a -> unFun (lensF (undefined :: k) f (curryFirst fun a))-  {-# INLINE getF  #-}-  {-# INLINE putF  #-}-  {-# INLINE lensF #-}+length _ = arity (Proxy :: Proxy (Dim v))   ----------------------------------------------------------------@@ -492,20 +431,31 @@  -- | Vector represented as continuation. Alternative wording: it's --   Church encoded N-element vector.-newtype ContVec n a = ContVec (forall r. Fun n a r -> r)+newtype ContVec n a = ContVec (forall r. Fun (Peano n) a r -> r)  type instance Dim (ContVec n) = n +-- | Same as 'ContVec' but its length is expressed as Peano number.+newtype CVecPeano n a = CVecPeano (forall r. Fun n a r -> r)++-- | Cons values to the @CVecPeano@.+consPeano :: a -> CVecPeano n a -> CVecPeano ('S n) a+consPeano a (CVecPeano cont) = CVecPeano $ \f -> cont $ curryFirst f a+{-# INLINE consPeano #-}++toContVec :: CVecPeano (Peano n) a -> ContVec n a+toContVec = coerce+ instance Arity n => Vector (ContVec n) a where   construct = accum-    (\(T_mkN f) a -> T_mkN (f . cons a))-    (\(T_mkN f)   -> f empty)+    (\(T_mkN f) a -> T_mkN (f . consPeano a))+    (\(T_mkN f)   -> toContVec $ f (CVecPeano unFun))     (T_mkN id)   inspect (ContVec c) f = c f   {-# INLINE construct #-}   {-# INLINE inspect   #-} -newtype T_mkN n_tot a n = T_mkN (ContVec n a -> ContVec n_tot a)+newtype T_mkN n_tot a n = T_mkN (CVecPeano n a -> CVecPeano n_tot a)  instance Arity n => VectorN ContVec n a @@ -528,7 +478,7 @@   sequenceA v = inspect v $ sequenceAF construct   {-# INLINE sequenceA #-} -sequenceAF :: forall f n a b. (Applicative f, Arity n)+sequenceAF :: forall f n a b. (Applicative f, ArityPeano n)      => Fun n a b -> Fun n (f a) (f b) {-# INLINE sequenceAF #-} sequenceAF (Fun f0)@@ -550,7 +500,7 @@ {-# INLINE[0] cvec #-}  -- | Create empty vector.-empty :: ContVec Z a+empty :: ContVec 0 a {-# INLINE empty #-} empty = ContVec (\(Fun r) -> r) @@ -560,37 +510,33 @@ fromList :: Arity n => [a] -> ContVec n a {-# INLINE fromList #-} fromList xs =-  apply step (T_flist xs)+  apply step (Const xs)   where-    step (T_flist []    ) = error "Data.Vector.Fixed.Cont.fromList: too few elements"-    step (T_flist (a:as)) = (a, T_flist as)+    step (Const []    ) = error "Data.Vector.Fixed.Cont.fromList: too few elements"+    step (Const (a:as)) = (a, Const as)  -- | Same as 'fromList' bu throws error is list doesn't have same --   length as vector. fromList' :: forall n a. Arity n => [a] -> ContVec n a {-# INLINE fromList' #-}-fromList' xs = ContVec $ \(Fun fun) ->-  let (r,rest) = applyFun step (T_flist xs :: T_flist a n) fun-      step (T_flist []    ) = error "Data.Vector.Fixed.Cont.fromList': too few elements"-      step (T_flist (a:as)) = (a, T_flist as)-  in case rest of-       T_flist [] -> r-       _          -> error "Data.Vector.Fixed.Cont.fromList': too many elements"+fromList' xs =+  let step (Const []    ) = error "Data.Vector.Fixed.Cont.fromList': too few elements"+      step (Const (a:as)) = (a, Const as)+  in case applyFun step (Const xs :: Const [a] (Peano n)) of+    (v,Const []) -> toContVec v+    _            -> error "Data.Vector.Fixed.Cont.fromList': too many elements" + -- | Convert list to continuation-based vector. Will fail with --   'Nothing' if list doesn't have right length. fromListM :: forall n a. Arity n => [a] -> Maybe (ContVec n a) {-# INLINE fromListM #-}-fromListM xs = do-  (v,rest) <- applyFunM step (T_flist xs :: T_flist a n)-  case rest of-    T_flist [] -> return v-    _          -> Nothing+fromListM xs = case applyFunM step (Const xs :: Const [a] (Peano n)) of+  (Just v, Const []) -> Just (toContVec v)+  _                  -> Nothing   where-    step (T_flist []    ) = Nothing-    step (T_flist (a:as)) = return (a, T_flist as)--newtype T_flist a n = T_flist [a]+    step (Const []    ) = (Nothing, Const [])+    step (Const (a:as)) = (Just a , Const as)   -- | Convert vector to the list@@ -605,64 +551,59 @@ replicate a = apply (\Proxy -> (a, Proxy)) Proxy  -- | Execute monadic action for every element of vector.-replicateM :: (Arity n, Monad m) => m a -> m (ContVec n a)+replicateM :: (Arity n, Applicative f) => f a -> f (ContVec n a) {-# INLINE replicateM #-} replicateM act-  = applyM (\Proxy -> do { a <- act; return (a, Proxy)}) Proxy+  = applyM (\Proxy -> (act, Proxy)) Proxy   -- | Generate vector from function which maps element's index to its value. generate :: (Arity n) => (Int -> a) -> ContVec n a {-# INLINE generate #-} generate f =-  apply (\(T_Counter n) -> (f n, T_Counter (n + 1)))-        (T_Counter 0)+  apply (\(Const n) -> (f n, Const (n + 1))) (Const 0)  -- | Generate vector from monadic function which maps element's index --   to its value.-generateM :: (Monad m, Arity n) => (Int -> m a) -> m (ContVec n a)+generateM :: (Applicative f, Arity n) => (Int -> f a) -> f (ContVec n a) {-# INLINE generateM #-} generateM f =-  applyM (\(T_Counter n) -> do { a <- f n; return (a, T_Counter (n + 1)) } )-         (T_Counter 0)+  applyM (\(Const n) -> (f n, Const (n + 1))) (Const 0)   -- | Unfold vector. unfoldr :: Arity n => (b -> (a,b)) -> b -> ContVec n a {-# INLINE unfoldr #-} unfoldr f b0 =-  apply (\(T_unfoldr b) -> let (a,b') = f b in (a, T_unfoldr b'))-        (T_unfoldr b0)--newtype T_unfoldr b n = T_unfoldr b-+  apply (\(Const b) -> let (a,b') = f b in (a, Const b'))+        (Const b0)  -- | Unit vector along Nth axis. basis :: (Num a, Arity n) => Int -> ContVec n a {-# INLINE basis #-} basis n0 =-  apply (\(T_Counter n) -> (if n == 0 then 1 else 0, T_Counter (n - 1)))-        (T_Counter n0)+  apply (\(Const n) -> (if n == 0 then 1 else 0, Const (n - 1)))+        (Const n0)   -mk1 :: a -> ContVec N1 a+mk1 :: a -> ContVec 1 a mk1 a1 = ContVec $ \(Fun f) -> f a1 {-# INLINE mk1 #-} -mk2 :: a -> a -> ContVec N2 a+mk2 :: a -> a -> ContVec 2 a mk2 a1 a2 = ContVec $ \(Fun f) -> f a1 a2 {-# INLINE mk2 #-} -mk3 :: a -> a -> a -> ContVec N3 a+mk3 :: a -> a -> a -> ContVec 3 a mk3 a1 a2 a3 = ContVec $ \(Fun f) -> f a1 a2 a3 {-# INLINE mk3 #-} -mk4 :: a -> a -> a -> a -> ContVec N4 a+mk4 :: a -> a -> a -> a -> ContVec 4 a mk4 a1 a2 a3 a4 = ContVec $ \(Fun f) -> f a1 a2 a3 a4 {-# INLINE mk4 #-} -mk5 :: a -> a -> a -> a -> a -> ContVec N5 a+mk5 :: a -> a -> a -> a -> a -> ContVec 5 a mk5 a1 a2 a3 a4 a5 = ContVec $ \(Fun f) -> f a1 a2 a3 a4 a5 {-# INLINE mk5 #-} @@ -683,44 +624,42 @@ imap f (ContVec contA) = ContVec $   contA . imapF f --- | Monadic map over vector.-mapM :: (Arity n, Monad m) => (a -> m b) -> ContVec n a -> m (ContVec n b)+-- | Effectful map over vector.+mapM :: (Arity n, Applicative f) => (a -> f b) -> ContVec n a -> f (ContVec n b) {-# INLINE mapM #-} mapM = imapM . const  -- | Apply monadic function to every element of the vector and its index.-imapM :: (Arity n, Monad m) => (Int -> a -> m b) -> ContVec n a -> m (ContVec n b)+imapM :: (Arity n, Applicative f)+      => (Int -> a -> f b) -> ContVec n a -> f (ContVec n b) {-# INLINE imapM #-} imapM f v   = inspect v   $ imapMF f construct  -- | Apply monadic action to each element of vector and ignore result.-mapM_ :: (Arity n, Monad m) => (a -> m b) -> ContVec n a -> m ()+mapM_ :: (Arity n, Applicative f) => (a -> f b) -> ContVec n a -> f () {-# INLINE mapM_ #-}-mapM_ f = foldl (\m a -> m >> f a >> return ()) (return ())+mapM_ f = foldl (\m a -> m *> f a *> pure ()) (pure ())  -- | Apply monadic action to each element of vector and its index and --   ignore result.-imapM_ :: (Arity n, Monad m) => (Int -> a -> m b) -> ContVec n a -> m ()+imapM_ :: (Arity n, Applicative f) => (Int -> a -> f b) -> ContVec n a -> f () {-# INLINE imapM_ #-}-imapM_ f = ifoldl (\m i a -> m >> f i a >> return ()) (return ())+imapM_ f = ifoldl (\m i a -> m *> f i a *> pure ()) (pure ())  -imapMF :: (Arity n, Monad m)-       => (Int -> a -> m b) -> Fun n b r -> Fun n a (m r)+imapMF :: (ArityPeano n, Applicative f)+       => (Int -> a -> f b) -> Fun n b r -> Fun n a (f r) {-# INLINE imapMF #-} imapMF f (Fun funB) =-  accum (\(T_mapM i m) a -> T_mapM (i+1) $ do b   <- f i a-                                              fun <- m-                                              return $ fun b-                           )+  accum (\(T_mapM i m) a -> T_mapM (i+1) $ ($) <$> m <*> f i a)         (\(T_mapM _ m) -> m)-        (T_mapM 0 (return funB))+        (T_mapM 0 (pure funB))  data T_mapM a m r n = T_mapM Int (m (Fn n a r)) -imapF :: Arity n+imapF :: ArityPeano n       => (Int -> a -> b) -> Fun n b r -> Fun n a r {-# INLINE imapF #-} imapF f (Fun funB) =@@ -731,7 +670,7 @@ data T_map a r n = T_map Int (Fn n a r)  -- | Left scan over vector-scanl :: (Arity n) => (b -> a -> b) -> b -> ContVec n a -> ContVec (S n) b+scanl :: (Arity n) => (b -> a -> b) -> b -> ContVec n a -> ContVec (n+1) b {-# INLINE scanl #-} scanl f b0 (ContVec cont) = ContVec $   cont . scanlF f b0@@ -742,19 +681,19 @@ scanl1 f (ContVec cont) = ContVec $   cont . scanl1F f -scanlF :: forall n a b r. (Arity n) => (b -> a -> b) -> b -> Fun (S n) b r -> Fun n a r+scanlF :: forall n a b r. (ArityPeano n) => (b -> a -> b) -> b -> Fun ('S n) b r -> Fun n a r scanlF f b0 (Fun fun0)   = accum step fini start   where-    step  :: forall k. T_scanl r b (S k) -> a -> T_scanl r b k+    step  :: forall k. T_scanl r b ('S k) -> a -> T_scanl r b k     step (T_scanl b fn) a = let b' = f b a in T_scanl b' (fn b')     fini (T_scanl _ r) = r     start = T_scanl b0 (fun0 b0)  :: T_scanl r b n -scanl1F :: forall n a r. (Arity n) => (a -> a -> a) -> Fun n a r -> Fun n a r+scanl1F :: forall n a r. (ArityPeano n) => (a -> a -> a) -> Fun n a r -> Fun n a r scanl1F f (Fun fun0) = accum step fini start   where-    step  :: forall k. T_scanl1 r a (S k) -> a -> T_scanl1 r a k+    step  :: forall k. T_scanl1 r a ('S k) -> a -> T_scanl1 r a k     step (T_scanl1 Nothing  fn) a = T_scanl1 (Just a) (fn a)     step (T_scanl1 (Just x) fn) a = let a' = f x a in T_scanl1 (Just a') (fn a')     fini (T_scanl1 _ r) = r@@ -765,12 +704,12 @@   -- | Evaluate every action in the vector from left to right.-sequence :: (Arity n, Monad m) => ContVec n (m a) -> m (ContVec n a)+sequence :: (Arity n, Applicative f) => ContVec n (f a) -> f (ContVec n a) sequence = mapM id {-# INLINE sequence #-}  -- | Evaluate every action in the vector from left to right and ignore result.-sequence_ :: (Arity n, Monad m) => ContVec n (m a) -> m ()+sequence_ :: (Arity n, Applicative f) => ContVec n (f a) -> f () sequence_ = mapM_ id {-# INLINE sequence_ #-} @@ -782,55 +721,43 @@   where     -- It's not possible to use ContVec as accumulator type since `head'     -- require Arity constraint on `k'. So we use plain lists-    step (T_distribute f) = ( fmap (\(x:_) -> x) f-                            , T_distribute $ fmap (\(_:x) -> x) f)-    start = T_distribute (fmap toList f0)+    step (Const f) = ( fmap (\(x:_) -> x) f+                     , Const $ fmap (\(_:x) -> x) f)+    start = Const (fmap toList f0)  collect :: (Functor f, Arity n) => (a -> ContVec n b) -> f a -> ContVec n (f b) collect f = distribute . fmap f {-# INLINE collect #-} --- | The dual of sequence-distributeM :: (Monad m, Arity n) => m (ContVec n a) -> ContVec n (m a)-{-# INLINE distributeM #-}-distributeM f0-  = apply step start-  where-    step (T_distribute f) = ( liftM (\(x:_) -> x) f-                            , T_distribute $ liftM (\(_:x) -> x) f)-    start = T_distribute (liftM toList f0)--collectM :: (Monad m, Arity n) => (a -> ContVec n b) -> m a -> ContVec n (m b)-collectM f = distributeM . liftM f-{-# INLINE collectM #-}--newtype T_distribute a f n = T_distribute (f [a])-- -- | /O(1)/ Tail of vector.-tail :: ContVec (S n) a -> ContVec n a+tail :: {-FIXME-} Arity n => ContVec (n+1) a -> ContVec n a tail (ContVec cont) = ContVec $ \f -> cont $ constFun f {-# INLINE tail #-}  -- | /O(1)/ Prepend element to vector-cons :: a -> ContVec n a -> ContVec (S n) a+cons :: {-FIXME-} Arity n => a -> ContVec n a -> ContVec (n+1) a cons a (ContVec cont) = ContVec $ \f -> cont $ curryFirst f a {-# INLINE cons #-}  -- | Prepend single element vector to another vector.-consV :: ContVec (S Z) a -> ContVec n a -> ContVec (S n) a+consV :: {-FIXME-} Arity n => ContVec 1 a -> ContVec n a -> ContVec (n+1) a {-# INLINE consV #-} consV (ContVec cont1) (ContVec cont)   = ContVec $ \f -> cont $ curryFirst f $ cont1 $ Fun id  -- | /O(1)/ Append element to vector-snoc :: Arity n => a -> ContVec n a -> ContVec (S n) a+snoc :: Arity n => a -> ContVec n a -> ContVec (n+1) a snoc a (ContVec cont) = ContVec $ \f -> cont $ apLast f a {-# INLINE snoc #-}  -- | Concatenate vector-concat :: (Arity n, Arity k, Arity (Add n k))-       => ContVec n a -> ContVec k a -> ContVec (Add n k) a+concat :: ( Arity n+          , Arity k+          , Arity (n + k)+          -- Tautology+          , Peano (n + k) ~ Add (Peano n) (Peano k)+          )+       => ContVec n a -> ContVec k a -> ContVec (n + k) a {-# INLINE concat #-} concat v u = inspect u            $ inspect v@@ -870,29 +797,29 @@ izipWith3 f v1 v2 v3 = izipWith (\i a (b, c) -> f i a b c) v1 (zipWith (,) v2 v3)  -- | Zip two vector together using monadic function.-zipWithM :: (Arity n, Monad m) => (a -> b -> m c)-         -> ContVec n a -> ContVec n b -> m (ContVec n c)+zipWithM :: (Arity n, Applicative f) => (a -> b -> f c)+         -> ContVec n a -> ContVec n b -> f (ContVec n c) {-# INLINE zipWithM #-} zipWithM f v w = sequence $ zipWith f v w -zipWithM_ :: (Arity n, Monad m)-          => (a -> b -> m c) -> ContVec n a -> ContVec n b -> m ()+zipWithM_ :: (Arity n, Applicative f)+          => (a -> b -> f c) -> ContVec n a -> ContVec n b -> f () {-# INLINE zipWithM_ #-} zipWithM_ f xs ys = sequence_ (zipWith f xs ys)  -- | Zip two vector together using monadic function which takes element --   index as well..-izipWithM :: (Arity n, Monad m) => (Int -> a -> b -> m c)-          -> ContVec n a -> ContVec n b -> m (ContVec n c)+izipWithM :: (Arity n, Applicative f) => (Int -> a -> b -> f c)+          -> ContVec n a -> ContVec n b -> f (ContVec n c) {-# INLINE izipWithM #-} izipWithM f v w = sequence $ izipWith f v w -izipWithM_ :: (Arity n, Monad m)-           => (Int -> a -> b -> m c) -> ContVec n a -> ContVec n b -> m ()+izipWithM_ :: (Arity n, Applicative f)+           => (Int -> a -> b -> f c) -> ContVec n a -> ContVec n b -> f () {-# INLINE izipWithM_ #-} izipWithM_ f xs ys = sequence_ (izipWith f xs ys) -izipWithF :: (Arity n)+izipWithF :: (ArityPeano n)           => (Int -> a -> b -> c) -> Fun n c r -> Fun n a (Fun n b r) {-# INLINE izipWithF #-} izipWithF f (Fun g0) =@@ -903,14 +830,12 @@        ) makeList  -makeList :: Arity n => Fun n a [a]+makeList :: ArityPeano n => Fun n a [a] {-# INLINE makeList #-} makeList = accum-    (\(T_mkList xs) x -> T_mkList (xs . (x:)))-    (\(T_mkList xs) -> xs [])-    (T_mkList id)--newtype T_mkList a n = T_mkList ([a] -> [a])+    (\(Const xs) x -> Const (xs . (x:)))+    (\(Const xs) -> xs [])+    (Const id)  data T_izip a c r n = T_izip Int [a] (Fn n c r) @@ -922,7 +847,7 @@  -- | Run continuation vector. It's same as 'inspect' but with --   arguments flipped.-runContVec :: Fun n a r+runContVec :: Fun (Peano n) a r            -> ContVec n a            -> r runContVec f (ContVec c) = c f@@ -934,18 +859,13 @@ {-# INLINE[1] vector #-}  -- | Finalizer function for getting head of the vector.-head :: Arity (S n) => ContVec (S n) a -> a--- NOTE: we need constraint `Arity (S n)' instead of `Arity n' because---       `Vector v' entails `Arity (Dim v)' and GHC cannot figure out---       that `Arity (S n)' ⇒ `Arity n'+head :: (Arity n, 1<=n) => ContVec n a -> a {-# INLINE head #-} head   = runContVec-  $ accum (\(T_head m) a -> T_head $ case m of { Nothing -> Just a; x -> x })-          (\(T_head (Just x)) -> x)-          (T_head Nothing)--data T_head a n = T_head (Maybe a)+  $ accum (\(Const m) a -> Const $ case m of { Nothing -> Just a; x -> x })+          (\(Const (Just x)) -> x)+          (Const Nothing)   -- | /O(n)/ Get value at specified index.@@ -954,18 +874,16 @@ index n   | n < 0     = error "Data.Vector.Fixed.Cont.index: index out of range"   | otherwise = runContVec $ accum-     (\(T_Index x) a -> T_Index $ case x of-                          Left  0 -> Right a-                          Left  i -> Left (i - 1)-                          r       -> r+     (\(Const x) a -> Const $ case x of+                        Left  0 -> Right a+                        Left  i -> Left (i - 1)+                        r       -> r      )-     (\(T_Index x) -> case x of-                        Left  _ -> error "Data.Vector.Fixed.index: index out of range"-                        Right a -> a+     (\(Const x) -> case x of+                      Left  _ -> error "Data.Vector.Fixed.index: index out of range"+                      Right a -> a      )-     (T_Index (Left n))--newtype T_Index a n = T_Index (Either Int a)+     (Const (Left n))   -- | Twan van Laarhoven lens for continuation based vector@@ -975,27 +893,18 @@ element i f v = inspect v               $ elementF i f construct --- | Twan van Laarhoven's lens for element of vector with statically---   known index.-elementTy :: (Arity n, Index k n, Functor f)-          => k -> (a -> f a) -> ContVec n a -> f (ContVec n a)-{-# INLINE elementTy #-}-elementTy k f v = inspect v-                $ lensF k f construct-- -- | Helper for implementation of Twan van Laarhoven lens.-elementF :: forall a n f r. (Arity n, Functor f)+elementF :: forall a n f r. (ArityPeano n, Functor f)          => Int -> (a -> f a) -> Fun n a r -> Fun n a (f r) {-# INLINE elementF #-} elementF n f (Fun fun0) = accum step fini start   where-    step :: forall k. T_lens f a r (S k) -> a -> T_lens f a r k+    step :: forall k. T_lens f a r ('S k) -> a -> T_lens f a r k     step (T_lens (Left (0,fun))) a = T_lens $ Right $ fmap fun $ f a     step (T_lens (Left (i,fun))) a = T_lens $ Left (i-1, fun a)     step (T_lens (Right fun))    a = T_lens $ Right $ fmap ($ a) fun     ---    fini :: T_lens f a r Z -> f r+    fini :: T_lens 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     --@@ -1045,15 +954,13 @@ -- `Arity (S n)`.  Latter imply former but GHC cannot infer it.  -- | Left fold.-foldl1 :: (Arity (S n)) => (a -> a -> a) -> ContVec (S n) a -> a+foldl1 :: (Arity n, 1 <= n) => (a -> a -> a) -> ContVec n a -> a {-# INLINE foldl1 #-} foldl1 f   = runContVec-  $ accum (\(T_foldl1 r       ) a -> T_foldl1 $ Just $ maybe a (flip f a) r)-          (\(T_foldl1 (Just x))   -> x)-          (T_foldl1 Nothing)--newtype T_foldl1 a n = T_foldl1 (Maybe a)+  $ accum (\(Const r       ) a -> Const $ Just $ maybe a (flip f a) r)+          (\(Const (Just x))   -> x)+          (Const Nothing)  -- | Right fold over continuation vector foldr :: Arity n => (a -> b -> b) -> b -> ContVec n a -> b@@ -1077,12 +984,12 @@ {-# INLINE sum #-}  -- | Minimal element of vector.-minimum :: (Ord a, Arity (S n)) => ContVec (S n) a -> a+minimum :: (Ord a, Arity n, 1<=n) => ContVec n a -> a minimum = foldl1 min {-# INLINE minimum #-}  -- | Maximal element of vector.-maximum :: (Ord a, Arity (S n)) => ContVec (S n) a -> a+maximum :: (Ord a, Arity n, 1<=n) => ContVec n a -> a maximum = foldl1 max {-# INLINE maximum #-} @@ -1120,7 +1027,7 @@        -> v a -> c (v a) gfoldl f inj v   = inspect v-  $ gfoldlF f (inj $ unFun (construct :: Fun (Dim v) a (v a)))+  $ gfoldlF f (inj $ unFun (construct :: Fun (Peano (Dim v)) a (v a)))  -- | Generic 'Data.Data.gunfoldl' which could work with any --   vector. Since vector can only have one constructor argument for@@ -1132,13 +1039,13 @@ 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)+    con = construct                   :: Fun (Peano (Dim v)) a (v a)+    gun = T_gunfold (inj $ unFun con) :: T_gunfold c (v a) a (Peano (Dim v))  -gfoldlF :: (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 :: (ArityPeano 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 = accum   (\(T_gfoldl c) x -> T_gfoldl (f c x))   (\(T_gfoldl c)   -> c)@@ -1147,6 +1054,8 @@ newtype T_gfoldl c r a n = T_gfoldl (c (Fn n a r))  +-- Const in GHC7.10 is not polykinded+newtype Const a n = Const a  ---------------------------------------------------------------- -- Deforestation@@ -1184,17 +1093,26 @@ -- Instances ---------------------------------------------------------------- -type instance Dim Complex = N2+type instance Dim Complex = 2 -instance RealFloat a => Vector Complex a where+instance Vector Complex a where   construct = Fun (:+)   inspect (x :+ y) (Fun f) = f x y   {-# INLINE construct #-}   {-# INLINE inspect #-}  -type instance Dim ((,) a) = N2+type instance Dim Identity = 1 +instance Vector Identity a where+  construct = Fun Identity+  inspect (Identity x) (Fun f) = f x+  {-# INLINE construct #-}+  {-# INLINE inspect #-}+++type instance Dim ((,) a) = 2+ -- | Note this instance (and other instances for tuples) is --   essentially monomorphic in element type. Vector type /v/ of 2 --   element tuple @(Int,Int)@ is @(,) Int@ so it will only work@@ -1206,7 +1124,7 @@   {-# INLINE inspect #-}  -type instance Dim ((,,) a b) = N3+type instance Dim ((,,) a b) = 3  instance (b~a, c~a) => Vector ((,,) b c) a where   construct = Fun (,,)@@ -1215,7 +1133,7 @@   {-# INLINE inspect #-}  -type instance Dim ((,,,) a b c) = N4+type instance Dim ((,,,) a b c) = 4  instance (b~a, c~a, d~a) => Vector ((,,,) b c d) a where   construct = Fun (,,,)@@ -1224,7 +1142,7 @@   {-# INLINE inspect #-}  -type instance Dim ((,,,,) a b c d) = N5+type instance Dim ((,,,,) a b c d) = 5  instance (b~a, c~a, d~a, e~a) => Vector ((,,,,) b c d e) a where   construct = Fun (,,,,)@@ -1233,7 +1151,7 @@   {-# INLINE inspect #-}  -type instance Dim ((,,,,,) a b c d e) = N6+type instance Dim ((,,,,,) a b c d e) = 6  instance (b~a, c~a, d~a, e~a, f~a) => Vector ((,,,,,) b c d e f) a where   construct = Fun (,,,,,)@@ -1242,7 +1160,7 @@   {-# INLINE inspect #-}  -type instance Dim ((,,,,,,) a b c d e f) = S N6+type instance Dim ((,,,,,,) a b c d e f) = 7  instance (b~a, c~a, d~a, e~a, f~a, g~a) => Vector ((,,,,,,) b c d e f g) a where   construct = Fun (,,,,,,)@@ -1250,9 +1168,8 @@   {-# INLINE construct #-}   {-# INLINE inspect #-} -type instance Dim Proxy = Z+type instance Dim Proxy = 0  instance Vector Proxy a where   construct = Fun Proxy   inspect _ = unFun-

@@ -1,6 +1,8 @@+{-# LANGUAGE DataKinds             #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds             #-} {-# LANGUAGE Rank2Types            #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeFamilies          #-}@@ -9,17 +11,18 @@ -- Implementation of fixed-vectors module Data.Vector.Fixed.Internal where -import Control.Applicative (Applicative)-import Control.Monad       (liftM)-import Data.Monoid         (Monoid(..))+import Control.DeepSeq       (NFData(..))+import Data.Typeable         (Proxy(..))+import Data.Functor.Identity (Identity(..)) import qualified Data.Foldable    as T import qualified Data.Traversable as T import Foreign.Storable (Storable(..)) import Foreign.Ptr      (Ptr,castPtr)+import GHC.TypeLits -import Data.Vector.Fixed.Cont     (Vector(..),Dim,S,Z,Arity,vector,Add)+import           Data.Vector.Fixed.Cont     (Vector(..),Dim,Arity,vector,Add) import qualified Data.Vector.Fixed.Cont as C-import           Data.Vector.Fixed.Cont   (ContVec,Index)+ import Prelude hiding ( replicate,map,zipWith,maximum,minimum,and,or,all,any                       , foldl,foldr,foldl1,length,sum,reverse,scanl,scanl1                       , head,tail,mapM,mapM_,sequence,sequence_,concat@@ -30,67 +33,42 @@ -- Constructors ---------------------------------------------------------------- --- | Variadic vector constructor. Resulting vector should be converted---   from 'ContVec' using 'vector' function.  For example:------ >>> vector $ mkN 'a' 'b' 'c' :: (Char,Char,Char)--- ('a','b','c')-mkN :: Make (S Z) a r => a -> r-mkN = unGo $ make id-{-# INLINE mkN #-}----- | Type class for variadic vector constructors.-class Make n a r where-  make :: (ContVec Z a -> ContVec n a) -> r--instance (a'~a, Make (S n) a r) => Make n a' (a -> r) where-  make f a = make (C.cons a . f)-  {-# INLINE make #-}--instance Arity n =>  Make n a (ContVec n a) where-  make f = C.reverse $ f C.empty-  {-# INLINE make #-}--newtype Go r = Go { unGo :: r }--instance Make Z a r => Make Z a (Go r) where-  make f = Go $ make f-  {-# INLINE make #-}---- | Cons value to continuation based vector.-(<|) :: a -> ContVec n a -> ContVec (S n) a-(<|) = C.cons-{-# INLINE (<|) #-}--infixr 1 <|---mk0 :: (Vector v a, Dim v ~ C.Z) => v a-mk0 = vector $ C.empty+mk0 :: (Vector v a, Dim v ~ 0) => v a+mk0 = vector C.empty {-# INLINE mk0 #-} -mk1 :: (Vector v a, Dim v ~ C.N1) => a -> v a+mk1 :: (Vector v a, Dim v ~ 1) => a -> v a mk1 a1 = vector $ C.mk1 a1 {-# INLINE mk1 #-} -mk2 :: (Vector v a, Dim v ~ C.N2) => a -> a -> v a+mk2 :: (Vector v a, Dim v ~ 2) => a -> a -> v a mk2 a1 a2 = vector $ C.mk2 a1 a2 {-# INLINE mk2 #-} -mk3 :: (Vector v a, Dim v ~ C.N3) => a -> a -> a -> v a+mk3 :: (Vector v a, Dim v ~ 3) => a -> a -> a -> v a mk3 a1 a2 a3 = vector $ C.mk3 a1 a2 a3 {-# INLINE mk3 #-} -mk4 :: (Vector v a, Dim v ~ C.N4) => a -> a -> a -> a -> v a+mk4 :: (Vector v a, Dim v ~ 4) => a -> a -> a -> a -> v a mk4 a1 a2 a3 a4 = vector $ C.mk4 a1 a2 a3 a4 {-# INLINE mk4 #-} -mk5 :: (Vector v a, Dim v ~ C.N5) => a -> a -> a -> a -> a -> v a+mk5 :: (Vector v a, Dim v ~ 5) => a -> a -> a -> a -> a -> v a mk5 a1 a2 a3 a4 a5 = vector $ C.mk5 a1 a2 a3 a4 a5 {-# INLINE mk5 #-} -+-- | N-ary constructor. Despite scary signature it's just N-ary+--   function with additional type parameter which is used to fix type+--   of vector being constructed. It could be used as:+--+--   > v = mkN (Proxy @ (Int,Int,Int)) 1 2 3+--+--   Or if type of @r@ is fixed elsewhere+--+--   > v = mkN [v] 1 2 3+mkN :: forall proxy v a. (Vector v a)+    => proxy (v a) -> C.Fn (C.Peano (Dim v)) a (v a)+mkN _ = C.unFun (construct :: C.Fun (C.Peano (Dim v)) a (v a))  ---------------------------------------------------------------- -- Generic functions@@ -127,10 +105,10 @@ --   Hi! --   Hi! --   fromList [(),()]-replicateM :: (Vector v a, Monad m) => m a -> m (v a)+replicateM :: (Vector v a, Applicative f) => f a -> f (v a) {-# INLINE replicateM #-} replicateM-  = liftM vector . C.replicateM+  = fmap vector . C.replicateM   -- | Unit vector along Nth axis. If index is larger than vector@@ -171,9 +149,9 @@  -- | Generate vector from monadic function which maps element's index --   to its value.-generateM :: (Monad m, Vector v a) => (Int -> m a) -> m (v a)+generateM :: (Applicative f, Vector v a) => (Int -> f a) -> f (v a) {-# INLINE generateM #-}-generateM = liftM vector . C.generateM+generateM = fmap vector . C.generateM   @@ -187,7 +165,7 @@ --   >>> let x = mk3 1 2 3 :: Vec3 Int --   >>> head x --   1-head :: (Vector v a, Dim v ~ S n) => v a -> a+head :: (Vector v a, 1 <= Dim v) => v a -> a {-# INLINE head #-} head = C.head . C.cvec @@ -199,24 +177,28 @@ --   >>> 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))+tail :: (Vector v a, Vector w a, Dim v ~ (Dim w + 1))      => v a -> w a {-# INLINE tail #-} tail = vector . C.tail . C.cvec  -- | Cons element to the vector-cons :: (Vector v a, Vector w a, S (Dim v) ~ Dim w)+cons :: (Vector v a, Vector w a, Dim w ~ (Dim v + 1))      => a -> v a -> w a {-# INLINE cons #-} cons a = vector . C.cons a . C.cvec  -- | Append element to the vector-snoc :: (Vector v a, Vector w a, S (Dim v) ~ Dim w)+snoc :: (Vector v a, Vector w a, Dim w ~ (Dim v + 1))      => a -> v a -> w a {-# INLINE snoc #-} snoc a = vector . C.snoc a . C.cvec -concat :: (Vector v a, Vector u a, Vector w a, (Add (Dim v) (Dim u)) ~ Dim w)+concat :: ( Vector v a, Vector u a, Vector w a+          , (Dim v + Dim u) ~ Dim w+            -- Tautology+          , C.Peano (Dim v + Dim u) ~ Add (C.Peano (Dim v)) (C.Peano (Dim u))+          )        => v a -> u a -> w a {-# INLINE concat #-} concat v u = vector $ C.concat (C.cvec v) (C.cvec u)@@ -237,17 +219,40 @@ runIndex = C.index {-# INLINE[0] runIndex #-} +-- We are trying to be clever with indexing here. It's not possible to+-- write generic indexing function. For example it's necessary O(n)+-- for VecList. It's however possible to write O(1) indexing for some+-- vectors and we trying to use such functions where possible.+--+-- We try to use presumable more efficient basicIndex+--+--  1. It should not interfere with deforestation. So we should+--     rewrite only when deforestation rule already fired.+--     (starting from phase 1).+--+--  2. Creation of vector is costlier than generic indexing so we should+--     apply rule only when vector is created anyway+--+-- In order to avoid firing this rule on implementation of (!) it has+-- been necessary to move definition of all functions to internal module.++{-# RULES+"fixed-vector:index/basicIndex"[1] forall vv i.+  runIndex i (C.cvec vv) = C.basicIndex vv i+ #-}++ -- | Get element from vector at statically known index-index :: (Vector v a, C.Index k (Dim v)) => v a -> k -> a+index :: (Vector v a, KnownNat k, k + 1 <= Dim v)+      => v a -> proxy k -> a {-# INLINE index #-}-index v k = C.runContVec (C.getF k)-          $ C.cvec v  +index v k = v ! fromIntegral (natVal k)  -- | Set n'th element in the vector-set :: (Vector v a, C.Index k (Dim v)) => k -> a -> v a -> v a+set :: (Vector v a, KnownNat k, k + 1 <= Dim v) => proxy k -> a -> v a -> v a {-# INLINE set #-}-set k a v = inspect v-          $ C.putF k a construct +set k a = runIdentity . element (fromIntegral (natVal k))+                                (const (Identity a))  -- | Twan van Laarhoven's lens for element of vector element :: (Vector v a, Functor f) => Int -> (a -> f a) -> (v a -> f (v a))@@ -256,12 +261,10 @@  -- | Twan van Laarhoven's lens for element of vector with statically --   known index.-elementTy :: (Vector v a, Index k (Dim v), Functor f)-          => k -> (a -> f a) -> (v a -> f (v a))+elementTy :: (Vector v a, KnownNat k, k + 1 <= Dim v, Functor f)+          => proxy k -> (a -> f a) -> (v a -> f (v a)) {-# INLINE elementTy #-}-elementTy k f v = vector `fmap` C.elementTy k f (C.cvec v)--+elementTy k = element (fromIntegral (natVal k))  -- | Left fold over vector foldl :: Vector v a => (b -> a -> b) -> b -> v a -> b@@ -277,7 +280,7 @@   -- | Left fold over vector-foldl1 :: (Vector v a, Dim v ~ S n) => (a -> a -> a) -> v a -> a+foldl1 :: (Vector v a, 1 <= Dim v) => (a -> a -> a) -> v a -> a {-# INLINE foldl1 #-} foldl1 f = C.foldl1 f          . C.cvec@@ -337,7 +340,7 @@ --   >>> 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 :: (Vector v a, 1 <= Dim v, Ord a) => v a -> a maximum = C.maximum . C.cvec {-# INLINE maximum #-} @@ -349,7 +352,7 @@ --   >>> 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 :: (Vector v a, 1 <= Dim v, Ord a) => v a -> a minimum = C.minimum . C.cvec {-# INLINE minimum #-} @@ -417,27 +420,28 @@       . 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)+sequence :: (Vector v a, Vector v (f a), Applicative f) => v (f a) -> f (v a) {-# INLINE sequence #-} sequence = mapM id  -- | Evaluate every action in the vector from left to right and ignore result-sequence_ :: (Vector v (m a), Monad m) => v (m a) -> m ()+sequence_ :: (Vector v (f a), Applicative f) => v (f a) -> f () {-# INLINE sequence_ #-} sequence_ = mapM_ id  --- | Monadic map over vector.-mapM :: (Vector v a, Vector v b, Monad m) => (a -> m b) -> v a -> m (v b)+-- | Effectful map over vector.+mapM :: (Vector v a, Vector v b, Applicative f) => (a -> f b) -> v a -> f (v b) {-# INLINE mapM #-}-mapM f = liftM vector+mapM f = fmap vector        . 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 ()+mapM_ :: (Vector v a, Applicative f) => (a -> f b) -> v a -> f () {-# INLINE mapM_ #-}-mapM_ f = foldl (\m a -> m >> f a >> return ()) (return ())+mapM_ f = C.mapM_ f+        . C.cvec   -- | Apply function to every element of the vector and its index.@@ -449,21 +453,22 @@        . C.cvec  -- | Apply monadic function to every element of the vector and its index.-imapM :: (Vector v a, Vector v b, Monad m)-      => (Int -> a -> m b) -> v a -> m (v b)+imapM :: (Vector v a, Vector v b, Applicative f)+      => (Int -> a -> f b) -> v a -> f (v b) {-# INLINE imapM #-}-imapM f = liftM vector+imapM f = fmap vector         . C.imapM f         . C.cvec  -- | Apply monadic function to every element of the vector and its --   index and discard result.-imapM_ :: (Vector v a, Monad m) => (Int -> a -> m b) -> v a -> m ()+imapM_ :: (Vector v a, Applicative f) => (Int -> a -> f b) -> v a -> f () {-# INLINE imapM_ #-}-imapM_ f = ifoldl (\m i a -> m >> f i a >> return ()) (return ())+imapM_ f = C.imapM_ f+         . C.cvec  -- | Left scan over vector-scanl :: (Vector v a, Vector w b, Dim w ~ S (Dim v))+scanl :: (Vector v a, Vector w b, Dim w ~ (Dim v + 1))       => (b -> a -> b) -> b -> v a -> w b {-# INLINE scanl #-} scanl f x0 = vector . C.scanl f x0 . C.cvec@@ -496,18 +501,8 @@ {-# INLINE collect #-} collect f = vector . C.collect (C.cvec . f) -distributeM :: (Vector v a, Vector v (m a), Monad m)-           => m (v a) -> v (m a)-{-# INLINE distributeM #-}-distributeM = vector . C.distributeM . liftM C.cvec -collectM :: (Vector v a, Vector v b, Vector v (m b), Monad m)-         => (a -> v b) -> m a -> v (m b)-{-# INLINE collectM #-}-collectM f = vector . C.collectM (C.cvec . f) -- ----------------------------------------------------------------  -- | Zip two vector together using function.@@ -543,17 +538,17 @@   $ C.zipWith3 f (C.cvec v1) (C.cvec v2) (C.cvec v3)  -- | 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)+zipWithM :: (Vector v a, Vector v b, Vector v c, Applicative f)+         => (a -> b -> f c) -> v a -> v b -> f (v c) {-# INLINE zipWithM #-}-zipWithM f v u = liftM vector+zipWithM f v u = fmap vector                $ C.zipWithM f (C.cvec v) (C.cvec u)  -- | Zip two vector elementwise using monadic function and discard --   result zipWithM_-  :: (Vector v a, Vector v b, Monad m)-  => (a -> b -> m c) -> v a -> v b -> m ()+  :: (Vector v a, Vector v b, Applicative f)+  => (a -> b -> f c) -> v a -> v b -> f () {-# INLINE zipWithM_ #-} zipWithM_ f xs ys = C.zipWithM_ f (C.cvec xs) (C.cvec ys) @@ -578,17 +573,17 @@  -- | 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)+izipWithM :: (Vector v a, Vector v b, Vector v c, Applicative f)+          => (Int -> a -> b -> f c) -> v a -> v b -> f (v c) {-# INLINE izipWithM #-}-izipWithM f v u = liftM vector+izipWithM f v u = fmap vector                 $ C.izipWithM f (C.cvec v) (C.cvec u)  -- | Zip two vector elementwise using monadic function and discard --   result izipWithM_-  :: (Vector v a, Vector v b, Vector v c, Monad m, Vector v (m c))-  => (Int -> a -> b -> m c) -> v a -> v b -> m ()+  :: (Vector v a, Vector v b, Vector v c, Applicative f, Vector v (f c))+  => (Int -> a -> b -> f c) -> v a -> v b -> f () {-# INLINE izipWithM_ #-} izipWithM_ f xs ys = C.izipWithM_ f (C.cvec xs) (C.cvec ys) @@ -606,7 +601,7 @@ defaultSizeOf   :: forall a v. (Storable a, Vector v a)   => v a -> Int-defaultSizeOf _ = sizeOf (undefined :: a) * C.arity (undefined :: Dim v)+defaultSizeOf _ = sizeOf (undefined :: a) * C.arity (Proxy :: Proxy (Dim v)) {-# INLINE defaultSizeOf #-}  -- | Default implementation of 'peek' for 'Storable' type class for@@ -623,6 +618,9 @@ defaultPoke ptr   = imapM_ (pokeElemOff (castPtr ptr)) +-- | Default implementation of 'rnf' from `NFData' type class+defaultRnf :: (NFData a, Vector v a) => v a -> ()+defaultRnf = foldl (\() a -> rnf a) ()  ---------------------------------------------------------------- @@ -652,7 +650,7 @@ --   length from resulting vector. fromListM :: (Vector v a) => [a] -> Maybe (v a) {-# INLINE fromListM #-}-fromListM = liftM vector . C.fromListM+fromListM = fmap vector . C.fromListM  -- | Create vector from 'Foldable' data type. Will return @Nothing@ if --   data type different number of elements that resulting vector.

@@ -1,379 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE UndecidableInstances  #-}--- |--- Wrapper function for working with monomorphic vectors. Standard API--- require vector to be parametric in their element type making it--- impossible to work with vectors like------ > data Vec3 = Vec3 Double Double Double------ This module provides newtype wrapper which allows use of functions--- from "Data.Vector.Fixed" with such data types and function which--- works with such vectors.------ Functions have same meaning as ones from "Data.Vector.Fixed" and--- documented there.-module Data.Vector.Fixed.Monomorphic (-    -- * Vector type class-    -- ** Vector size-    DimMono-  , Z-  , S-    -- ** Synonyms for small numerals-  , F.N1-  , F.N2-  , F.N3-  , F.N4-  , F.N5-  , F.N6-    -- ** Type class-  , VectorMono(..)-  , Arity-  , Fun(..)-  , length-    -- * Constructors-    -- $construction-    -- ** Small dimensions-    -- $smallDim-  , mk1-  , mk2-  , mk3-  , mk4-  , mk5-    -- ** Functions-  , replicate-  , replicateM-  , generate-  , generateM-  , unfoldr-  , basis-    -- * Modifying vectors-    -- ** Transformations-  , head-  , tail-  , reverse-  , (!)-    -- ** Comparison-  , eq-    -- ** Maps-  , map-  , mapM-  , mapM_-  , imap-  , imapM-  , imapM_-    -- * Folding-  , foldl-  , foldr-  , foldl1-  , ifoldl-  , ifoldr-  , fold-  , foldMap-  , foldM-  , ifoldM-    -- ** Special folds-  , sum-  , maximum-  , minimum-  , and-  , or-  , all-  , any-  , find-    -- * Zips-  , zipWith-  , zipWithM-  , izipWith-  , izipWithM-    -- * Conversion-  , convert-  , toList-  , fromList-  ) where--import Control.Monad (liftM)-import Data.Monoid   (Monoid)-import qualified Data.Vector.Fixed as F-import Data.Vector.Fixed.Cont (S,Z,Arity,Fun(..))-import Prelude (Num,Eq,Ord,Functor(..),Monad(..),Int,Bool,(.),($),Maybe)----------------------------------------------------------------------- Wrappers for monomorphic vectors--------------------------------------------------------------------- | Wrapper for monomorphic vectors it provides 'Vector' instance for---   monomorphic vectors. Trick is to restrict type parameter @a@ to---   single possible value.-newtype Mono v a = Mono { getMono :: v }--type instance F.Dim (Mono v) = DimMono v--instance (VectorMono v, a ~ VectorElm v, Arity (DimMono v)) => F.Vector (Mono v) a where-  construct  = fmap Mono construct-  inspect    = inspect . getMono-  basicIndex = basicIndex . getMono-  {-# INLINE construct  #-}-  {-# INLINE inspect    #-}-  {-# INLINE basicIndex #-}----- | Dimensions of monomorphic vector.-type family DimMono v :: *---- | Counterpart of 'Vector' type class for monomorphic vectors.-class Arity (DimMono v) => VectorMono v where-  -- | Type of vector elements.-  type VectorElm v :: *-  -- | Construct vector-  construct :: Fun (DimMono v) (VectorElm v) v-  -- | Inspect vector-  inspect   :: v -> Fun (DimMono v) (VectorElm v) r -> r-  -- | Optional more efficient implementation of indexing-  basicIndex :: v -> Int -> VectorElm v-  basicIndex v i = Mono v F.! i-  {-# INLINE basicIndex #-}---- | Length of vector-length :: Arity (DimMono v) => v -> Int-length = F.length . Mono-{-# INLINE length #-}-----------------------------------------------------------------------------------------------------------------------------------------mk1 :: (VectorMono v, VectorElm v ~ a, DimMono v ~ F.N1)-    => a -> v-mk1 a1 = getMono $ F.mk1 a1-{-# INLINE mk1 #-}--mk2 :: (VectorMono v, VectorElm v ~ a, DimMono v ~ F.N2)-    => a -> a-> v-mk2 a1 a2 = getMono $ F.mk2 a1 a2-{-# INLINE mk2 #-}--mk3 :: (VectorMono v, VectorElm v ~ a, DimMono v ~ F.N3)-    => a -> a-> a -> v-mk3 a1 a2 a3 = getMono $ F.mk3 a1 a2 a3-{-# INLINE mk3 #-}--mk4 :: (VectorMono v, VectorElm v ~ a, DimMono v ~ F.N4)-    => a -> a-> a -> a -> v-mk4 a1 a2 a3 a4 = getMono $ F.mk4 a1 a2 a3 a4-{-# INLINE mk4 #-}--mk5 :: (VectorMono v, VectorElm v ~ a, DimMono v ~ F.N5)-    => a -> a-> a -> a -> a -> v-mk5 a1 a2 a3 a4 a5 = getMono $ F.mk5 a1 a2 a3 a4 a5-{-# INLINE mk5 #-}--replicate :: (VectorMono v, VectorElm v ~ a) => a -> v-{-# INLINE replicate #-}-replicate = getMono . F.replicate--replicateM :: (VectorMono v, VectorElm v ~ a, Monad m) => m a -> m v-{-# INLINE replicateM #-}-replicateM a = getMono `liftM` F.replicateM a--basis :: (VectorMono v, VectorElm v ~ a, Num a) => Int -> v-{-# INLINE basis #-}-basis = getMono . F.basis--unfoldr :: (VectorMono v, VectorElm v ~ a) => (b -> (a,b)) -> b -> v-{-# INLINE unfoldr #-}-unfoldr f = getMono . F.unfoldr f--generate :: (VectorMono v, VectorElm v ~ a) => (Int -> a) -> v-{-# INLINE generate #-}-generate = getMono . F.generate--generateM :: (Monad m, VectorMono v, VectorElm v ~ a) => (Int -> m a) -> m v-{-# INLINE generateM #-}-generateM f = getMono `liftM` F.generateM f----------------------------------------------------------------------head :: (VectorMono v, VectorElm v ~ a, DimMono v ~ S n) => v -> a-{-# INLINE head #-}-head = F.head . Mono--tail :: ( VectorMono v, VectorElm v ~ a-        , VectorMono w, VectorElm w ~ a-        , DimMono v ~ S (DimMono w))-     => v -> w-{-# INLINE tail #-}-tail v = getMono $ F.tail $ Mono v--reverse :: (VectorMono v) => v -> v-reverse = getMono . F.reverse . Mono-{-# INLINE reverse #-}--(!) :: (VectorMono v, VectorElm v ~ a) => v -> Int -> a-{-# INLINE (!) #-}-v ! n = Mono v F.! n--foldl :: (VectorMono v, VectorElm v ~ a)-      => (b -> a -> b) -> b -> v -> b-{-# INLINE foldl #-}-foldl f x = F.foldl f x . Mono--foldr :: (VectorMono v, VectorElm v ~ a)-      => (a -> b -> b) -> b -> v -> b-{-# INLINE foldr #-}-foldr f x = F.foldr f x . Mono---foldl1 :: (VectorMono v, VectorElm v ~ a, DimMono v ~ S n)-       => (a -> a -> a) -> v -> a-{-# INLINE foldl1 #-}-foldl1 f = F.foldl1 f . Mono--ifoldr :: (VectorMono v, VectorElm v ~ a)-       => (Int -> a -> b -> b) -> b -> v -> b-{-# INLINE ifoldr #-}-ifoldr f x = F.ifoldr f x . Mono--ifoldl :: (VectorMono v, VectorElm v ~ a)-       => (b -> Int -> a -> b) -> b -> v -> b-{-# INLINE ifoldl #-}-ifoldl f z = F.ifoldl f z . Mono--fold :: (VectorMono v, Monoid (VectorElm v)) => v -> VectorElm v-fold = F.fold . Mono-{-# INLINE fold #-}--foldMap :: (VectorMono v, Monoid m) => (VectorElm v -> m) -> v -> m-foldMap f = F.foldMap f . Mono-{-# INLINE foldMap #-}--foldM :: (VectorMono v, VectorElm v ~ a, Monad m)-      => (b -> a -> m b) -> b -> v -> m b-{-# INLINE foldM #-}-foldM f x = F.foldM f x . Mono--ifoldM :: (VectorMono v, VectorElm v ~ a, Monad m) => (b -> Int -> a -> m b) -> b -> v -> m b-{-# INLINE ifoldM #-}-ifoldM f x = F.ifoldM f x . Mono----------------------------------------------------------------------sum :: (VectorMono v, VectorElm v ~ a, Num a) => v -> a-sum = F.sum . Mono-{-# INLINE sum #-}--maximum :: (VectorMono v, VectorElm v ~ a, DimMono v ~ S n, Ord a) => v -> a-maximum = F.maximum . Mono-{-# INLINE maximum #-}--minimum :: (VectorMono v, VectorElm v ~ a, DimMono v ~ S n, Ord a) => v -> a-minimum = F.minimum . Mono-{-# INLINE minimum #-}--and :: (VectorMono v, VectorElm v ~ Bool) => v -> Bool-and = F.and . Mono-{-# INLINE and #-}--or :: (VectorMono v, VectorElm v ~ Bool) => v -> Bool-or = F.or . Mono-{-# INLINE or #-}--all :: (VectorMono v, VectorElm v ~ a) => (a -> Bool) -> v -> Bool-all f = F.all f . Mono-{-# INLINE all #-}--any :: (VectorMono v, VectorElm v ~ a) => (a -> Bool) -> v -> Bool-any f = F.any f . Mono-{-# INLINE any #-}--find :: (VectorMono v, VectorElm v ~ a) => (a -> Bool) -> v -> Maybe a-find f = F.find f . Mono-{-# INLINE find #-}--------------------------------------------------------------------eq :: (VectorMono v, VectorElm v ~ a, Eq a) => v -> v -> Bool-{-# INLINE eq #-}-eq v w = F.eq (Mono v) (Mono w)---------------------------------------------------------------------map :: (VectorMono v, VectorElm v ~ a) => (a -> a) -> v -> v-{-# INLINE map #-}-map f = getMono . F.map f . Mono--mapM :: (VectorMono v, VectorElm v ~ a, Monad m)-     => (a -> m a) -> v -> m v-{-# INLINE mapM #-}-mapM f v = getMono `liftM` F.mapM f (Mono v)--mapM_ :: (VectorMono v, VectorElm v ~ a, Monad m) => (a -> m b) -> v -> m ()-{-# INLINE mapM_ #-}-mapM_ f = F.mapM_ f . Mono---imap :: (VectorMono v, VectorElm v ~ a) =>-    (Int -> a -> a) -> v -> v-{-# INLINE imap #-}-imap f = getMono . F.imap f . Mono--imapM :: (VectorMono v, VectorElm v ~ a, Monad m)-      => (Int -> a -> m a) -> v -> m v-{-# INLINE imapM #-}-imapM f v = getMono `liftM` F.imapM f (Mono v)--imapM_ :: (VectorMono v, VectorElm v ~ a, Monad m) => (Int -> a -> m b) -> v -> m ()-{-# INLINE imapM_ #-}-imapM_ f = F.imapM_ f . Mono---------------------------------------------------------------------zipWith :: (VectorMono v, VectorElm v ~ a)-        => (a -> a -> a) -> v -> v -> v-{-# INLINE zipWith #-}-zipWith f v u = getMono $ F.zipWith f (Mono v) (Mono u)---zipWithM :: (VectorMono v, VectorElm v ~ a, Monad m)-         => (a -> a -> m a) -> v -> v -> m v-{-# INLINE zipWithM #-}-zipWithM f v u = getMono `liftM` F.zipWithM f (Mono v) (Mono u)--izipWith :: (VectorMono v, VectorElm v ~ a)-         => (Int -> a -> a -> a) -> v -> v -> v-{-# INLINE izipWith #-}-izipWith f v u = getMono $ F.izipWith f (Mono v) (Mono u)--izipWithM :: (VectorMono v, VectorElm v ~ a, Monad m)-          => (Int -> a -> a -> m a) -> v -> v -> m v-{-# INLINE izipWithM #-}-izipWithM f v u = getMono `liftM` F.izipWithM f (Mono v) (Mono u)----------------------------------------------------------------------convert :: (VectorMono v, VectorMono w, VectorElm v ~ VectorElm w, DimMono v ~ DimMono w)-        => v -> w-{-# INLINE convert #-}-convert = getMono . F.convert . Mono--toList :: (VectorMono v, VectorElm v ~ a) => v -> [a]-toList = foldr (:) []--fromList :: (VectorMono v, VectorElm v ~ a) => [a] -> v-{-# INLINE fromList #-}-fromList = getMono . F.fromList-

@@ -1,8 +1,10 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DataKinds             #-} {-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds             #-} {-# LANGUAGE Rank2Types            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-} -- | -- Type classes for vectors which are implemented on top of the arrays -- and support in-place mutation. API is similar to one used in the@@ -21,7 +23,6 @@     -- * Immutable vectors   , IVector(..)   , index-  , lengthI   , freeze   , thaw     -- * Vector API@@ -31,8 +32,10 @@  import Control.Monad.ST import Control.Monad.Primitive-import Data.Vector.Fixed.Cont (Dim,Arity,Fun(..),S,Vector(..),arity,apply,accum)-import Prelude hiding (read)+import Data.Typeable  (Proxy(..))+import GHC.TypeLits+import Data.Vector.Fixed.Cont (Dim,PeanoNum(..),Peano,Arity,Fun(..),Vector(..),ContVec,arity,apply,accum,length)+import Prelude hiding (read,length)   ----------------------------------------------------------------@@ -43,12 +46,10 @@ type family Mutable (v :: * -> *) :: * -> * -> *  -- | Dimension for mutable vector.-type family DimM (v :: * -> * -> *) :: *+type family DimM (v :: * -> * -> *) :: Nat  -- | Type class for mutable vectors. class (Arity (DimM v)) => MVector v a where-  -- | Checks whether vectors' buffers overlaps-  overlaps  :: v s a -> v s a -> Bool   -- | Copy vector. The two vectors may not overlap. Since vectors'   --   length is encoded in the type there is no need in runtime checks.   copy :: PrimMonad m@@ -71,7 +72,7 @@  -- | Length of mutable vector. Function doesn't evaluate its argument. lengthM :: forall v s a. (Arity (DimM v)) => v s a -> Int-lengthM _ = arity (undefined :: DimM v)+lengthM _ = arity (Proxy :: Proxy (DimM v))  -- | Create copy of vector. clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a)@@ -107,17 +108,10 @@   -- | Get element at specified index without bounds check.   unsafeIndex :: v a -> Int -> a --- | Length of immutable vector. Function doesn't evaluate its argument.-lengthI :: IVector v a => v a -> Int-lengthI = lengthM . cast-  where-    cast :: v a -> Mutable v () a-    cast _ = undefined- index :: IVector v a => v a -> Int -> a {-# INLINE index #-}-index v i | i < 0 || i >= lengthI v = error "Data.Vector.Fixed.Mutable.!: index out of bounds"-          | otherwise               = unsafeIndex v i+index v i | i < 0 || i >= length v = error "Data.Vector.Fixed.Mutable.!: index out of bounds"+          | otherwise              = unsafeIndex v i   -- | Safely convert mutable vector to immutable.@@ -137,27 +131,29 @@ ----------------------------------------------------------------  -- | Generic inspect implementation for array-based vectors.-inspectVec :: forall v a b. (Arity (Dim v), IVector v a) => v a -> Fun (Dim v) a b -> b+inspectVec :: forall v a b. (Arity (Dim v), IVector v a) => v a -> Fun (Peano (Dim v)) a b -> b {-# INLINE inspectVec #-} inspectVec v-  = inspect-  $ apply (\(T_idx i) -> (unsafeIndex v i, T_idx (i+1)))-          (T_idx 0)--newtype T_idx n = T_idx Int+  = inspect cv+  where+    cv :: ContVec (Dim v) a+    cv = apply (\(Const i) -> (unsafeIndex v i, Const (i+1)))+               (Const 0 :: Const Int (Peano (Dim v))) +-- Const in GHC7.10 is not polykinded+newtype Const a n = Const a  -- | Generic construct implementation for array-based vectors.-constructVec :: forall v a. (Arity (Dim v), IVector v a) => Fun (Dim v) a (v a)+constructVec :: forall v a. (Arity (Dim v), IVector v a) => Fun (Peano (Dim v)) a (v a) {-# INLINE constructVec #-} constructVec =   accum step         (\(T_new _ st) -> runST $ unsafeFreeze =<< st :: v a)-        (T_new 0 new :: T_new v a (Dim v))+        (T_new 0 new :: T_new v a (Peano (Dim v)))  data T_new v a n = T_new Int (forall s. ST s (Mutable v s a)) -step :: (IVector v a) => T_new v a (S n) -> a -> T_new v a n+step :: (IVector v a) => T_new v a ('S n) -> a -> T_new v a n step (T_new i st) x = T_new (i+1) $ do   mv <- st   unsafeWrite mv i x

@@ -1,9 +1,11 @@-{-# LANGUAGE StandaloneDeriving    #-}-{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TypeFamilies          #-} -- | -- Unboxed vectors with fixed length. Vectors from -- "Data.Vector.Fixed.Unboxed" provide more flexibility at no@@ -29,6 +31,7 @@ import Data.Primitive.ByteArray import Data.Primitive import qualified Foreign.Storable as Foreign (Storable(..))+import GHC.TypeLits import Prelude (Show(..),Eq(..),Ord(..),Num(..)) import Prelude ((++),($),($!),undefined,seq) @@ -44,19 +47,19 @@ ----------------------------------------------------------------  -- | Unboxed vector with fixed length-newtype Vec n a = Vec ByteArray+newtype Vec (n :: Nat) a = Vec ByteArray  -- | Mutable unboxed vector with fixed length-newtype MVec n s a = MVec (MutableByteArray s)+newtype MVec (n :: Nat) s a = MVec (MutableByteArray s)  deriving instance Typeable Vec deriving instance Typeable MVec -type Vec1 = Vec (S Z)-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)))))+type Vec1 = Vec 1+type Vec2 = Vec 2+type Vec3 = Vec 3+type Vec4 = Vec 4+type Vec5 = Vec 5   @@ -74,15 +77,14 @@ type instance Mutable (Vec n) = MVec n  instance (Arity n, Prim a) => MVector (MVec n) a where-  overlaps (MVec v) (MVec u) = sameMutableByteArray v u-  {-# INLINE overlaps    #-}   new = do-    v <- newByteArray $! arity (undefined :: n) * sizeOf (undefined :: a)+    v <- newByteArray $! arity (Proxy :: Proxy n)+                       * sizeOf (undefined :: a)     return $ MVec v   {-# INLINE new         #-}   copy                       = move   {-# INLINE copy        #-}-  move (MVec dst) (MVec src) = copyMutableByteArray dst 0 src 0 (arity (undefined :: n))+  move (MVec dst) (MVec src) = copyMutableByteArray dst 0 src 0 (arity (Proxy :: Proxy n))   {-# INLINE move        #-}   unsafeRead  (MVec v) i   = readByteArray  v i   {-# INLINE unsafeRead  #-}

@@ -1,9 +1,11 @@-{-# LANGUAGE StandaloneDeriving    #-}-{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TypeFamilies          #-} -- | -- Storable-based unboxed vectors. module Data.Vector.Fixed.Storable (@@ -31,11 +33,12 @@ import Foreign.Ptr           (castPtr) import Foreign.Storable import Foreign.ForeignPtr-import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray )+import Foreign.Marshal.Array ( copyArray, moveArray ) import GHC.ForeignPtr        ( ForeignPtr(..), mallocPlainForeignPtrBytes ) import GHC.Ptr               ( Ptr(..) )-import Prelude (Show(..),Eq(..),Ord(..),Num(..),Monad(..),IO,Int)-import Prelude ((++),(&&),(||),($),undefined,seq)+import GHC.TypeLits+import Prelude ( Show(..),Eq(..),Ord(..),Num(..),Monad(..),IO,Int+               , (++),($),undefined,seq)  import Data.Vector.Fixed hiding (index) import Data.Vector.Fixed.Mutable@@ -48,19 +51,19 @@ ----------------------------------------------------------------  -- | Storable-based vector with fixed length-newtype Vec n a = Vec (ForeignPtr a)+newtype Vec (n :: Nat) a = Vec (ForeignPtr a)  -- | Storable-based mutable vector with fixed length-newtype MVec n s a = MVec (ForeignPtr a)+newtype MVec (n :: Nat) s a = MVec (ForeignPtr a)  deriving instance Typeable Vec deriving instance Typeable MVec -type Vec1 = Vec (S Z)-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)))))+type Vec1 = Vec 1+type Vec2 = Vec 2+type Vec3 = Vec 3+type Vec4 = Vec 4+type Vec5 = Vec 5   @@ -98,29 +101,21 @@ type instance Mutable (Vec n) = MVec n  instance (Arity n, Storable a) => MVector (MVec n) a where-  overlaps (MVec fp) (MVec fq)-    = between p q (q `advancePtr` n) || between q p (p `advancePtr` n)-    where-      between x y z = x >= y && x < z-      p = getPtr fp-      q = getPtr fq-      n = arity (undefined :: n)-  {-# INLINE overlaps    #-}   new = unsafePrimToPrim $ do-    fp <- mallocVector $ arity (undefined :: n)+    fp <- mallocVector $ arity (Proxy :: Proxy n)     return $ MVec fp   {-# INLINE new         #-}   copy (MVec fp) (MVec fq)     = unsafePrimToPrim     $ withForeignPtr fp $ \p ->       withForeignPtr fq $ \q ->-      copyArray p q (arity (undefined :: n))+      copyArray p q (arity (Proxy :: Proxy n))   {-# INLINE copy        #-}   move (MVec fp) (MVec fq)     = unsafePrimToPrim     $ withForeignPtr fp $ \p ->       withForeignPtr fq $ \q ->-      moveArray p q (arity (undefined :: n))+      moveArray p q (arity (Proxy :: Proxy n))   {-# INLINE move        #-}   unsafeRead (MVec fp) i     = unsafePrimToPrim@@ -169,16 +164,17 @@   {-# INLINE mappend #-}  instance (Arity n, Storable a) => Storable (Vec n a) where-  sizeOf    _ = arity (undefined :: n) * sizeOf (undefined :: a)+  sizeOf    _ = arity  (Proxy :: Proxy 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))+      moveArray p (castPtr ptr) (arity (Proxy :: Proxy n))     unsafeFreeze arr   poke ptr (Vec fp)     = withForeignPtr fp $ \p ->-      moveArray (castPtr ptr) p (arity (undefined :: n))+      moveArray (castPtr ptr) p (arity (Proxy :: Proxy n))  instance (Typeable n, Arity n, Storable a, Data a) => Data (Vec n a) where   gfoldl       = C.gfoldl

@@ -1,8 +1,10 @@ {-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-} {-# LANGUAGE DeriveDataTypeable    #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds             #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE StandaloneDeriving    #-} {-# LANGUAGE TypeFamilies          #-}@@ -23,18 +25,22 @@   , Unbox   ) where +import Control.Applicative   (Const(..)) import Control.Monad-import Control.DeepSeq (NFData(..))+import Control.DeepSeq       (NFData(..)) import Data.Complex-import Data.Monoid     (Monoid(..)) import Data.Data-import Data.Int        (Int8, Int16, Int32, Int64 )-import Data.Word       (Word,Word8,Word16,Word32,Word64)-import Foreign.Storable (Storable(..))-import Prelude (Show(..),Eq(..),Ord(..),Int,Double,Float,Char,Bool(..))-import Prelude ((++),(||),($),(.),seq)+import Data.Functor.Identity (Identity(..))+import Data.Int              (Int8, Int16, Int32, Int64 )+import Data.Monoid           (Monoid(..),Dual(..),Sum(..),Product(..),All(..),Any(..))+import Data.Ord              (Down(..))+import Data.Word             (Word,Word8,Word16,Word32,Word64)+import Foreign.Storable      (Storable(..))+import GHC.TypeLits+import Prelude               ( Show(..),Eq(..),Ord(..),Int,Double,Float,Char,Bool(..)+                             , (++),($),(.),seq) -import Data.Vector.Fixed (Dim,Vector(..),VectorN,S,Z,toList,eq,ord,replicate,zipWith,foldl,+import Data.Vector.Fixed (Dim,Vector(..),VectorN,toList,eq,ord,replicate,zipWith,foldl,                           defaultSizeOf,defaultAlignemnt,defaultPeek,defaultPoke                          ) import Data.Vector.Fixed.Mutable@@ -47,17 +53,17 @@ -- Data type ---------------------------------------------------------------- -data family Vec  n a-data family MVec n s a+data family Vec  (n :: Nat) a+data family MVec (n :: Nat) s a  deriving instance Typeable Vec deriving instance Typeable MVec -type Vec1 = Vec (S Z)-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)))))+type Vec1 = Vec 1+type Vec2 = Vec 2+type Vec3 = Vec 3+type Vec4 = Vec 4+type Vec5 = Vec 5  class (Arity n, IVector (Vec n) a, MVector (MVec n) a) => Unbox n a @@ -137,8 +143,6 @@ instance Arity n => Unbox n ()  instance Arity n => MVector (MVec n) () where-  overlaps _ _ = False-  {-# INLINE overlaps    #-}   new          = return MV_Unit   {-# INLINE new         #-}   copy _ _     = return ()@@ -169,8 +173,6 @@ instance Arity n => Unbox n Bool  instance Arity n => MVector (MVec n) Bool where-  overlaps (MV_Bool v) (MV_Bool w) = overlaps v w-  {-# INLINE overlaps    #-}   new          = MV_Bool `liftM` new   {-# INLINE new         #-}   copy (MV_Bool v) (MV_Bool w) = copy v w@@ -206,13 +208,11 @@ -- Primitive wrappers #define primMV(ty,con)                              \ instance Arity n => MVector (MVec n) ty where {     \-; overlaps (con v) (con w) = overlaps v w           \ ; new = con `liftM` new                             \ ; copy (con v) (con w) = copy v w                   \ ; move (con v) (con w) = move v w                   \ ; unsafeRead  (con v) i = unsafeRead v i            \ ; unsafeWrite (con v) i x = unsafeWrite v i x       \-; {-# INLINE overlaps    #-}                        \ ; {-# INLINE new         #-}                        \ ; {-# INLINE move        #-}                        \ ; {-# INLINE copy        #-}                        \@@ -265,8 +265,6 @@ instance (Unbox n a) => Unbox n (Complex a)  instance (Arity n, MVector (MVec n) a) => MVector (MVec n) (Complex a) where-  overlaps (MV_Complex v) (MV_Complex w) = overlaps v w-  {-# INLINE overlaps    #-}   new = MV_Complex `liftM` new   {-# INLINE new #-}   copy (MV_Complex v) (MV_Complex w) = copy v w@@ -280,7 +278,7 @@   {-# INLINE unsafeWrite #-}  instance (Arity n, IVector (Vec n) a) => IVector (Vec n) (Complex a) where-  unsafeFreeze (MV_Complex v) = V_Complex `liftM` unsafeFreeze v +  unsafeFreeze (MV_Complex v) = V_Complex `liftM` unsafeFreeze v   {-# INLINE unsafeFreeze #-}   unsafeThaw   (V_Complex  v) = MV_Complex `liftM` unsafeThaw v   {-# INLINE unsafeThaw   #-}@@ -298,8 +296,6 @@ instance (Unbox n a, Unbox n b) => Unbox n (a,b)  instance (Arity n, MVector (MVec n) a, MVector (MVec n) b) => MVector (MVec n) (a,b) where-  overlaps (MV_2 va vb) (MV_2 wa wb) = overlaps va wa || overlaps vb wb-  {-# INLINE overlaps    #-}   new = do as <- new            bs <- new            return $ MV_2 as bs@@ -340,9 +336,6 @@  instance (Arity n, MVector (MVec n) a, MVector (MVec n) b, MVector (MVec n) c          ) => MVector (MVec n) (a,b,c) where-  overlaps (MV_3 va vb vc) (MV_3 wa wb wc)-    = overlaps va wa || overlaps vb wb || overlaps vc wc-  {-# INLINE overlaps    #-}   new = do as <- new            bs <- new            cs <- new@@ -380,3 +373,111 @@   unsafeIndex  (V_3 v w u) i     = (unsafeIndex v i, unsafeIndex w i, unsafeIndex u i)   {-# INLINE unsafeIndex  #-}+++----------------------------------------------------------------+-- Newtype wrappers++newtype instance MVec n s (Const a b) = MV_Const (MVec n s a)+newtype instance Vec  n   (Const a b) = V_Const  (Vec  n   a)+instance Unbox n a => Unbox n (Const a b)++instance (Unbox n a) => MVector (MVec n) (Const a b) where+  new                                  = MV_Const `liftM` new+  copy (MV_Const v) (MV_Const w)       = copy v w+  move (MV_Const v) (MV_Const w)       = move v w+  unsafeRead  (MV_Const v) i           = Const `liftM` unsafeRead v i+  unsafeWrite (MV_Const v) i (Const x) = unsafeWrite v i x+  {-# INLINE new         #-}+  {-# INLINE move        #-}+  {-# INLINE copy        #-}+  {-# INLINE unsafeRead  #-}+  {-# INLINE unsafeWrite #-}++instance (Unbox n a) => IVector (Vec n) (Const a b) where+  unsafeFreeze (MV_Const v)   = V_Const  `liftM` unsafeFreeze v+  unsafeThaw   (V_Const  v)   = MV_Const `liftM` unsafeThaw   v+  unsafeIndex  (V_Const  v) i = Const (unsafeIndex v i)+  {-# INLINE unsafeFreeze #-}+  {-# INLINE unsafeThaw   #-}+  {-# INLINE unsafeIndex  #-}+++----------------------------------------------------------------+-- Newtype wrappers with kind * -> *++#define primNewMV(ty,con)                         \+instance Unbox n a => MVector (MVec n) (ty a) where {     \+; new = con `liftM` new                             \+; copy (con v) (con w) = copy v w                   \+; move (con v) (con w) = move v w                   \+; unsafeRead  (con v) i = ty `liftM` unsafeRead v i            \+; unsafeWrite (con v) i (ty x) = unsafeWrite v i x       \+; {-# INLINE new         #-}                        \+; {-# INLINE move        #-}                        \+; {-# INLINE copy        #-}                        \+; {-# INLINE unsafeRead  #-}                        \+; {-# INLINE unsafeWrite #-}                        \+}++#define primNewIV(ty,con,mcon)                             \+instance Unbox n a => IVector (Vec n) (ty a)  where {          \+; unsafeFreeze (mcon v)   = con  `liftM` unsafeFreeze v \+; unsafeThaw   (con  v)   = mcon `liftM` unsafeThaw   v \+; unsafeIndex  (con  v) i = ty (unsafeIndex v i)             \+; {-# INLINE unsafeFreeze #-}                           \+; {-# INLINE unsafeThaw   #-}                           \+; {-# INLINE unsafeIndex  #-}                           \+}++#define primNewWrap(ty,con,mcon) \+newtype instance MVec n s (ty a) = mcon (MVec n s a) ; \+newtype instance Vec  n   (ty a) = con  (Vec  n   a) ; \+instance Unbox n a => Unbox n (ty a) ; \+primNewMV(ty, mcon     )          ; \+primNewIV(ty, con, mcon)+++primNewWrap(Identity, V_Identity, MV_Identity)+primNewWrap(Down, V_Down, MV_Down)+primNewWrap(Dual, V_Dual, MV_Dual)+primNewWrap(Sum, V_Sum, MV_Sum)+primNewWrap(Product, V_Product, MV_Product)+++----------------------------------------------------------------+-- Monomorphic newtype wrappers++#define primNewMonoMV(ty,con)                         \+instance Arity n => MVector (MVec n) ty where {     \+; new = con `liftM` new                             \+; copy (con v) (con w) = copy v w                   \+; move (con v) (con w) = move v w                   \+; unsafeRead  (con v) i = ty `liftM` unsafeRead v i            \+; unsafeWrite (con v) i (ty x) = unsafeWrite v i x       \+; {-# INLINE new         #-}                        \+; {-# INLINE move        #-}                        \+; {-# INLINE copy        #-}                        \+; {-# INLINE unsafeRead  #-}                        \+; {-# INLINE unsafeWrite #-}                        \+}++#define primNewMonoIV(ty,con,mcon)                             \+instance Arity n => IVector (Vec n) ty where {          \+; unsafeFreeze (mcon v)   = con  `liftM` unsafeFreeze v \+; unsafeThaw   (con  v)   = mcon `liftM` unsafeThaw   v \+; unsafeIndex  (con  v) i = ty (unsafeIndex v i)             \+; {-# INLINE unsafeFreeze #-}                           \+; {-# INLINE unsafeThaw   #-}                           \+; {-# INLINE unsafeIndex  #-}                           \+}++#define primNewMonoWrap(ty,repr,con,mcon) \+newtype instance MVec n s ty = mcon (MVec n s repr) ; \+newtype instance Vec  n   ty = con  (Vec  n   repr) ; \+instance Arity n => Unbox n ty ; \+primNewMonoMV(ty, mcon     )          ; \+primNewMonoIV(ty, con, mcon)++primNewMonoWrap(Any, Bool, V_Any, MV_Any)+primNewMonoWrap(All, Bool, V_All, MV_All)

@@ -1,5 +1,5 @@ Name:           fixed-vector-Version:        0.9.0.0+Version:        1.0.0.0 Synopsis:       Generic vectors with statically known size. Description:   Generic library for vectors with statically known@@ -41,9 +41,6 @@   .   * Data.Vector.Fixed.Primitive   Unboxed vectors based on pritimive package.-  .-  * Data.Vector.Fixed.Monomorphic-  Wrappers for monomorphic vectors  Cabal-Version:  >= 1.8 License:        BSD3@@ -57,24 +54,19 @@   ChangeLog.md  source-repository head-  type:     hg-  location: http://bitbucket.org/Shimuuar/fixed-vector-source-repository head   type:     git   location: http://github.com/Shimuuar/fixed-vector  Library   Ghc-options:          -Wall-  Build-Depends:-    base >=4.7 && <5,-    deepseq,-    primitive+  Build-Depends: base      >=4.8 && <5+               , primitive >=0.6.2+               , deepseq   Exposed-modules:     -- API     Data.Vector.Fixed.Cont     Data.Vector.Fixed     Data.Vector.Fixed.Generic-    Data.Vector.Fixed.Monomorphic     -- Arrays     Data.Vector.Fixed.Mutable     Data.Vector.Fixed.Boxed@@ -88,9 +80,8 @@   Type:           exitcode-stdio-1.0   Hs-source-dirs: test   Main-is:        Doctests.hs-  Build-Depends:-    base >=3 && <5,-    primitive,-    -- Additional test dependencies.-    doctest   >= 0.9,-    filemanip == 0.3.6.*+  Build-Depends: base >=4.8 && <5+               , primitive >=0.6.2+                 -- Additional test dependencies.+               , doctest   >= 0.9+               , filemanip == 0.3.6.*