fixed-vector 1.2.3.0 → 2.1.1.0
raw patch · 18 files changed
Files
- ChangeLog.md +178/−160
- Data/Vector/Fixed.hs +396/−178
- Data/Vector/Fixed/Boxed.hs +81/−106
- Data/Vector/Fixed/Compat.hs +8/−0
- Data/Vector/Fixed/Cont.hs +489/−283
- Data/Vector/Fixed/Generic.hs +0/−1
- Data/Vector/Fixed/Internal.hs +68/−60
- Data/Vector/Fixed/Mono.hs +981/−0
- Data/Vector/Fixed/Mutable.hs +89/−77
- Data/Vector/Fixed/Primitive.hs +45/−75
- Data/Vector/Fixed/Storable.hs +63/−84
- Data/Vector/Fixed/Strict.hs +141/−0
- Data/Vector/Fixed/Unboxed.hs +222/−379
- Setup.hs +0/−2
- fixed-vector.cabal +118/−40
- test/Doctests.hs +58/−1
- test/Inspect/Obligations.hs +20/−0
- test/inspect.hs +91/−0
ChangeLog.md view
@@ -1,235 +1,253 @@-Changes in 1.2.3.0+2.1.1.0 [2026.02.28]+-------------+* Missing `Prod` and `Vector` instances are added for `ContVec`. - * Pattern `V1` added - * `COMPLETE` pragmas added for patterns `V1`,`V2`,`V3`,`V4`+2.1.0.0 [2026.01.27]+-------------+* New API for working with vectors that are not parametric in element:+ `Data.Vector.Fixed.Mono`. It support data types like `data V2 = V2 !Double+ !Double` as well as all existing data types.+* Support for GHC<9.2 dropped.+* `Prim` could be derived using `ViaFixed` by deriving via mechanism and add+ data types defined in library now has `Prim` instance.+* `Foldable1` could be derived using `ViaFixed`. All types for which it could be+ defined now has it. For GHC<9.6 `foldable1-classes-compat` is used.+* `ifoldl'` added. -Changes in 1.2.2.1+2.0.0.0 [2025.07.10]+------------------+* Type family `Dim` returns Peano numbers instead of standard type level+ naturals. - * Newtype `StorableViaFixed` for deriving `Storable` instances added.+ - `Index` type class restored and all indexing operation are performed in+ - `Arity` simplified+ - `CVecPeano` dropped and `ContVec` is parameterized using Peano numbers. +* In `ArityPeano` type class methods `reverseF` and `gunfoldF` are replaced+ with more general `accumPeano` and `reducePeano`. -Changes in 1.2.1.1+* `Unbox` vector are fully reworked. All uses of data types with `Unbox`+ instances which are defined in the library except `Bool` should work without+ changes. - * Fixed bug in `any` (#18)+* `Data.Vector.Fixed.Cont.arity` dropped. +* Type of `D.V.F.Cont.withFun` generalized. -Changes in 1.2.1.0+* Type class `VectorN` dropped. Use `QuantifiedConstraints` instead. - * Support for GHC7.10 dropped.+* Show instance now has form `[...]` instead of `fromList [...]`. - * Pattern synonyms `V2`,`V3`,`V4` added.+* `ViaFixed` newtype wrapper for deriving instances is+ added. `StorableViaFixed` is removed. - * `replicate{,M}` and `generate{,M}` added.+* `Data.Vector.Fixed.Storable.unsafeWith` ensures that pointer won't+ get GC'd while function runs. - * Functions `mk6`, `mk7`, `mk8` added.+* `Data.Vector.Fixed.sequenceA` is deprecated in favor of `sequence`. +* `foldl'` and `ifoldl'` functions added. -Changes in 1.2.0.0+* Implement `sum` as in terms of `foldl'`. - * `Show` instance for data type now respect precedence. -Changes in 1.1.0.0+1.2.3.0 [2023-10-31]+--------------------+* Pattern `V1` added+* `COMPLETE` pragmas added for patterns `V1`,`V2`,`V3`,`V4` - * GHC8.4 compatibility release. Semigroup instances added and- semigroup dependency added for GHC7.10 -Changes in 1.0.0.0+1.2.2.1 [2022-12-29]+--------------------+* Newtype `StorableViaFixed` for deriving `Storable` instances added. - * 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)+1.2.1.1 [2022-12-26]+--------------------+* Fixed bug in `any` (#18) - * Module `Data.Vector.Fixed.Monomorphic` is dropped. - * Construction of N-ary vectors reworked. `Make` type class is gone.+1.2.1.0 [2021-11-13]+--------------------+* Support for GHC7.10 dropped.+* Pattern synonyms `V2`,`V3`,`V4` added.+* `replicate{,M}` and `generate{,M}` added.+* Functions `mk6`, `mk7`, `mk8` added. - * Boxed arrays now use SmallArrays internally. - * `overlaps` is removed from API for mutable vectors.+1.2.0.0 [2018-09-02]+--------------------+* `Show` instance for data type now respect precedence. - * `Data.Vector.Fixed.defaultRnf` is added. - * `Data.Vector.Fixed.Mutable.lengthI` is dropped.+1.1.0.0 [2018-03-11]+--------------------+* GHC8.4 compatibility release. Semigroup instances added and+ semigroup dependency added for GHC7.10 -Changes in 0.9.0.0 - * Simplification of `Arity` type class. This change shouldn't affect client- code.-- * Support for GHC < 7.8 is droppped.-- * Fixed bug in `any`.+1.0.0.0 [2017-11-06]+--------------------+* 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.8.1.0-- * `find` function added.+0.9.0.0 [2016-09-14]+--------------------+* Simplification of `Arity` type class. This change shouldn't affect client+ code.+* Support for GHC < 7.8 is droppped.+* Fixed bug in `any`. -Changes in 0.8.0.0-- * NFData instances for all data type.-- * Storable instances for all data types and default implementation of- Storable's methods added.-- * {i,}zipWith3 and {i,}zipWithM_ added.+0.8.1.0 [2015-08-27]+--------------------+* `find` function added. -Changes in 0.7.0.3-- * GHC 7.10 support+0.8.0.0 [2015-04-06]+--------------------+* NFData instances for all data type.+* Storable instances for all data types and default implementation of+ Storable's methods added.+* {i,}zipWith3 and {i,}zipWithM_ added. -Changes in 0.7.0.0-- * Type level addition for unary numbers added-- * `concat` function added-- * More consistent naming for functions for working with `Fun`+0.7.0.3 [2015-01-03]+--------------------+* GHC 7.10 support -Changes in 0.6.4.0-- * Isomorphism between Peano numbers and Nat added. (GHC >= 7.8)+0.7.0.0 [2014-08-15]+--------------------+* Type level addition for unary numbers added+* `concat` function added+* More consistent naming for functions for working with `Fun` -Changes in 0.6.3.1-- * Documentation fixes.+0.6.4.0 [2014-04-15]+--------------------+* Isomorphism between Peano numbers and Nat added. (GHC >= 7.8) -Changes in 0.6.3.0-- * Left scans added.+0.6.3.1 [2014-03-12]+--------------------+* Documentation fixes. -Changes in 0.6.2.0-- * `Vec1` type synonym for boxed/unboxed/etc. vectors added.-- * Vector instance for Data.Typeable.Proxy (GHC >= 7.8)+0.6.3.0 [2014-02-22]+--------------------+* Left scans added. -Changes in 0.6.1.1-- * GHC 7.8 support+0.6.2.0 [2014-02-07]+--------------------+* `Vec1` type synonym for boxed/unboxed/etc. vectors added.+* Vector instance for Data.Typeable.Proxy (GHC >= 7.8) -Changes in 0.6.1.0-- * `distribute` `collect` and their monadic variants added.+0.6.1.1 [2014-02-04]+--------------------+* GHC 7.8 support -Changes in 0.6.0.0-- * Data instance for all array-based vectors added.-- * Storable instance added for `Storable.Vec`.-- * Monoid instances added for all vectors.+0.6.1.0 [2014-01-24]+--------------------+* `distribute` `collect` and their monadic variants added. -Changes in 0.5.1.0+0.6.0.0 [2013-11-17]+--------------------+* Data instance for all array-based vectors added.+* Storable instance added for `Storable.Vec`.+* Monoid instances added for all vectors. - * Zero-element vector `Empty'`is added.+0.5.1.0 [2013-08-06]+--------------------+* Zero-element vector `Empty'`is added. -Changes in 0.5.0.0-- * `ContVec` now behaves like normal vector. `Arity` type class is- reworked. `Id' data type is removed.-- * Construction of vector reworked.-- * `reverse`, `snoc`, `consV`, `fold` and `foldMap` are added.-- * Type changing maps and zips are added.-- * Vector indexing with type level numbers is added.-- * Twan van Laarhoven's lens added. (`element` and `elementTy`)-- * Ord instances added to vector data types defined in the library.+0.5.0.0 [2013-08-02]+--------------------+* `ContVec` now behaves like normal vector. `Arity` type class is+ reworked. `Id` data type is removed.+* Construction of vector reworked.+* `reverse`, `snoc`, `consV`, `fold` and `foldMap` are added.+* Type changing maps and zips are added.+* Vector indexing with type level numbers is added.+* Twan van Laarhoven's lens added. (`element` and `elementTy`)+* Ord instances added to vector data types defined in the library. -Changes in 0.4.4.0-- * Functor and Applicative instances are added to Id.+0.4.4.0 [2013-06-13]+--------------------+* Functor and Applicative instances are added to Id. -Changes in 0.4.3.0-- * Typeable instance for S and Z added.+0.4.3.0 [2013-05-18]+--------------------+* Typeable instance for S and Z added. -Changes in 0.4.2.0-- * 1-tuple `Only` added.-- * `fromList'` and fromListM added.-- * apply functions from Arity type class generalized.+0.4.2.0 [2013-05-01]+--------------------+* 1-tuple `Only` added.+* `fromList'` and fromListM added.+* apply functions from Arity type class generalized. -Changes in 0.4.1.0-- * `cons` function added.-- * Getter for `Fun` data type added.+0.4.1.0 [2013-04-29]+--------------------+* `cons` function added.+* Getter for `Fun` data type added. -Changes in 0.4.0.0-- * Wrapper for monomorphics vectors is added.-- * `VecList` is reimplemented as GADT and constructors are exported.-- * Constructor of `ContVecT` is exported-- * Empty `ContVecT` is implemented as `empty`.-- * Typeable, Foldable and Traversable instances are added where- appropriate+0.4.0.0 [2013-04-04]+--------------------+* Wrapper for monomorphics vectors is added.+* `VecList` is reimplemented as GADT and constructors are exported.+* Constructor of `ContVecT` is exported+* Empty `ContVecT` is implemented as `empty`.+* Typeable, Foldable and Traversable instances are added where+ appropriate -Changes in 0.3.0.0-- * Vector type class definition is moved to the D.V.F.Cont module.-- * Indexing function restored.-- * `unfoldr` added.+0.3.0.0 [2013-03-06]+--------------------+* Vector type class definition is moved to the D.V.F.Cont module.+* Indexing function restored.+* `unfoldr` added. -Changes in 0.2.0.0-- * Continuation-based vector added.-- * Right fold added.-- * tailWith, convertContinuation, and ! from- Data.Vector.Fixed removed.-- * Vector instance for tuples added.+0.2.0.0 [2013-02-10]+--------------------+* Continuation-based vector added.+* Right fold added.+* tailWith, convertContinuation, and ! from+ Data.Vector.Fixed removed.+* Vector instance for tuples added. -Changes in 0.1.2-- * imap, imapM, ifoldl, ifoldM, zipWithM, izipWithM- functions are added.-- * VectorN type class added.+0.1.2 [2013-01-26]+------------------+* imap, imapM, ifoldl, ifoldM, zipWithM, izipWithM+ functions are added.+* VectorN type class added. -Changes in 0.1.1-- * foldM and tailWith added. Type synonyms for numbers up to 6 are- added. Fun is reexported from Data.Vector.Fixed.+0.1.1 [2012-11-29]+------------------+* foldM and tailWith added. Type synonyms for numbers up to 6 are+ added. Fun is reexported from Data.Vector.Fixed.
Data/Vector/Fixed.hs view
@@ -1,37 +1,45 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ViewPatterns #-} -- |--- Generic API for vectors with fixed length.+-- @fixed-vector@ library provides general API for working with short+-- N-element arrays. Functions in this module work on data types which+-- are instances of 'Vector' type class. We provide instances for data+-- types from @base@: tuples, 'Data.Complex.Complex', and few others.+-- There are several length polymorphic arrays: ----- For encoding of vector size library uses Peano naturals defined in--- the library. At come point in the future it would make sense to--- switch to new GHC type level numerals.+-- * Lazy boxed arrays "Data.Vector.Fixed.Boxed". ----- [@Common pitfalls@]+-- * Strict boxed arrays "Data.Vector.Fixed.Strict". ----- Library provide instances for tuples. But there's a catch. Tuples--- are monomorphic in element type. Let consider 2-tuple @(Int,Int)@.--- Vector type @v@ is @(,) Int@ and only allowed element type is--- @Int@. Because of that we cannot change element type and following--- code will fail:+-- * Arrays backed by single @ByteArray@: "Data.Vector.Fixed.Primitive". --+-- * Arrays backed by pinned memory: "Data.Vector.Fixed.Storable".+--+-- * Arrays which infer array representation from element data type:+-- "Data.Vector.Fixed.Unboxed"+--+-- * Continuation based 'Data.Vector.Fixed.Cont.ContVec' which used+-- by library internally.+--+-- Type level naturals don't have support for induction so all type+-- level computation with length and indices are done using Peano+-- numerals ('PeanoNum'). Type level naturals are only used as type+-- parameters for defining length of arrays.+--+-- [@Instances for tuples@]+--+-- Library provides instances for tuples. They however come with caveat.+-- Let look at 'Vector' instance for 2-tuple:+--+-- > instance b ~ a => Vector ((,) b) a+--+-- Tuple could only be @Vector@ instance if all elements have same+-- type. so first element fixes type of second one. Thus functions+-- which change element type like 'map' won't work:+-- -- > >>> map (== 1) ((1,2) :: (Int,Int)) -- > -- > <interactive>:3:1:@@ -39,25 +47,29 @@ -- > In the expression: F.map (== 1) ((1, 2) :: (Int, Int)) -- > In an equation for `it': it = map (== 1) ((1, 2) :: (Int, Int)) ----- To make it work we need to change vector type as well. Functions--- from module "Data.Vector.Fixed.Generic" provide this functionality.+-- This could be solved either by switching to @ContVec@ manually: ----- > >>> map (== 1) ((1,2) :: (Int,Int)) :: (Bool,Bool)--- > (True,False)+-- >>> (vector . map (==1) . cvec) ((1, 2) :: Tuple2 Int) :: Tuple2 Bool+-- (True,False)+--+-- or by using functions genereic in vector type from module+-- "Data.Vector.Fixed.Generic". module Data.Vector.Fixed ( -- * Vector type class- -- ** Vector size- Dim- -- ** Type class- , Vector(..)- , VectorN+ Vector(..)+ , Dim , Arity+ , ArityPeano , Fun(..) , length- -- * Constructors+ -- ** Peano numbers+ , PeanoNum(..)+ , C.Peano+ , C.N1, C.N2, C.N3, C.N4, C.N5, C.N6, C.N7, C.N8+ -- * Construction and destructions -- $construction- -- ** Small dimensions- -- $smallDim++ -- ** Constructors , mk0 , mk1 , mk2@@ -68,24 +80,19 @@ , mk7 , mk8 , mkN- -- ** Pattern for low-dimension vectors+ -- ** Pattern synonyms , pattern V1 , pattern V2 , pattern V3 , pattern V4- -- ** Continuation-based vectors- , ContVec- , empty- , vector- , C.cvec- -- ** Functions+ -- * Functions+ -- ** Creation , replicate , replicateM , generate , generateM , unfoldr , basis- -- * Modifying vectors -- ** Transformations , head , tail@@ -94,15 +101,12 @@ , concat , reverse -- ** Indexing & lenses- -- , C.Index+ , C.Index , (!) , index , set , element , elementTy- -- ** Comparison- , eq- , ord -- ** Maps , map , mapM@@ -114,21 +118,22 @@ , scanl1 , sequence , sequence_- , sequenceA , traverse , distribute , collect- -- * Folding+ -- ** Folds , foldl+ , foldl' , foldr , foldl1 , fold , foldMap , ifoldl+ , ifoldl' , ifoldr , foldM , ifoldM- -- ** Special folds+ -- *** Special folds , sum , maximum , minimum@@ -137,7 +142,7 @@ , all , any , find- -- * Zips+ -- ** Zips , zipWith , zipWith3 , zipWithM@@ -146,16 +151,10 @@ , izipWith3 , izipWithM , izipWithM_- -- * Storable methods- -- $storable- , StorableViaFixed(..)- , defaultAlignemnt- , defaultSizeOf- , defaultPeek- , defaultPoke- -- * NFData- , defaultRnf- -- * Conversion+ -- *** Special zips+ , eq+ , ord+ -- ** Conversion , convert , toList , fromList@@ -172,26 +171,49 @@ , Tuple3 , Tuple4 , Tuple5+ -- ** Continuation-based vectors+ , ContVec+ , empty+ , vector+ , cvec+ -- * Instance deriving+ , ViaFixed(..)+ -- ** Storable+ -- $storable+ , defaultAlignemnt+ , defaultSizeOf+ , defaultPeek+ , defaultPoke+ -- ** NFData+ , defaultRnf+ -- * Deprecated functions+ , sequenceA ) where -import Control.Applicative (Applicative(..),(<$>))-import Control.DeepSeq (NFData(..))+import Control.Applicative (Applicative(..))+import Control.DeepSeq (NFData(..))+import Control.Monad.Primitive (PrimBase(..)) import Data.Coerce-import Data.Data (Typeable,Data)-import Data.Monoid (Monoid(..))-import Data.Semigroup (Semigroup(..))-import qualified Data.Foldable as F-import qualified Data.Traversable as T-import Foreign.Storable (Storable(..))-import Foreign.Ptr (castPtr)+import Data.Data (Data)+import Data.Monoid (Monoid(..))+import Data.Semigroup (Semigroup(..))+import Data.Foldable qualified as F+import Data.Traversable qualified as T+import Data.Foldable1 qualified as F1+import Data.Primitive.Types (Prim(..))+import Foreign.Storable (Storable(..)) import GHC.TypeLits+import GHC.Exts (Proxy#,proxy#,(*#),(+#),Int(..),Int#)+import GHC.ST (ST(..)) -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 Data.Vector.Fixed.Cont (Vector(..),Dim,length,ContVec,PeanoNum(..),+ vector,cvec,empty,Arity,ArityPeano,Fun(..),accum,apply)+import Data.Vector.Fixed.Cont qualified as C+import Data.Vector.Fixed.Mono qualified as FM+import Data.Vector.Fixed.Internal as I+import Data.Vector.Fixed.Compat -import Prelude (Show(..),Eq(..),Ord(..),Functor(..),id,(.),($),undefined)+import Prelude (Show(..),Eq(..),Ord(..),Num(..),Functor(..),id,(.),($),(<$>),undefined,flip) -- $construction@@ -203,28 +225,26 @@ -- >>> mk3 'a' 'b' 'c' :: (Char,Char,Char) -- ('a','b','c') ----- Alternatively one could use 'mkN'. See its documentation for--- examples.+-- Another way is to use pattern synonyms for construction and+-- inspection of vectors: ----- Another option is to create tuple and 'convert' it to desired--- vector type. For example:+-- >>> V2 'a' 'b' :: (Char,Char)+-- ('a','b') ----- > v = convert (x,y,z)+-- >>> case ('a','b') of V2 a b -> [a,b]+-- "ab" ----- It will work on if type of @v@ is know from elsewhere. Same trick--- could be used to pattern match on the vector with opaque--- representation using view patterns+-- Last option is to use 'convert' to convert between different vector+-- types of same length. For example ----- > function :: Vec N3 Double -> ...--- > function (convert -> (x,y,z)) = ...+-- > v = convert (x,y,z) ----- For small vectors pattern synonyms @V2@, @V3$, @V4@ are provided--- that use same trick internally.----- $smallDim+-- This could be used in view patterns as well: ----- Constructors for vectors with small dimensions.+-- > foo :: Vec3 Double -> Foo+-- > foo (convert -> (x,y,z)) = ...+--+-- Pattern synonyms use this trick internally. -- $storable@@ -233,7 +253,6 @@ -- that individual elements of vector are stored as N-element array. - -- | Type-based vector with statically known length parametrized by -- GHC's type naturals newtype VecList (n :: Nat) a = VecList (VecPeano (C.Peano n) a)@@ -243,89 +262,115 @@ 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 = defaultRnf- {-# INLINE rnf #-}--type instance Dim (VecList n) = n+type instance Dim (VecList n) = C.Peano n+type instance Dim (VecList n a) = C.Peano n+type instance Dim (VecPeano n) = n+type instance Dim (VecPeano n a) = n instance Arity n => Vector (VecList n) a where- construct = fmap VecList $ accum+ construct = VecList <$> construct @(VecPeano (C.Peano n)) @a+ inspect (VecList v) = inspect v+ {-# INLINE construct #-}+ {-# INLINE inspect #-}+instance Arity n => FM.Prod a (VecList n a) where+ construct = construct+ inspect = inspect+ {-# INLINE construct #-}+ {-# INLINE inspect #-}+instance Arity n => FM.Vector a (VecList n a) where+++instance C.ArityPeano n => Vector (VecPeano n) a where+ construct = accum (\(T_List f) a -> T_List (f . Cons a)) (\(T_List f) -> f Nil)- (T_List id :: T_List a (C.Peano n) (C.Peano n))- inspect (VecList v)+ (T_List id :: T_List a n n)+ inspect v = inspect (apply step (Flip v) :: C.ContVec n a) where 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+instance C.ArityPeano n => FM.Prod a (VecPeano n a) where+ construct = construct+ inspect = inspect+ {-# INLINE construct #-}+ {-# INLINE inspect #-}+instance C.ArityPeano n => FM.Vector a (VecPeano n a) where newtype Flip f a n = Flip (f n a) newtype T_List a n k = T_List (VecPeano k a -> VecPeano n a) --- Standard instances-instance (Show a, Arity n) => Show (VecList n a) where- show = show . foldr (:) []-instance (Eq a, Arity n) => Eq (VecList n a) where- (==) = eq-instance (Ord a, Arity n) => Ord (VecList n a) where- compare = ord-instance Arity n => Functor (VecList n) where- fmap = map-instance Arity n => Applicative (VecList n) where- pure = replicate- (<*>) = zipWith ($)-instance Arity n => F.Foldable (VecList n) where- foldr = foldr++deriving via ViaFixed (VecList n) instance (Arity n) => Functor (VecList n)+deriving via ViaFixed (VecList n) instance (Arity n) => Applicative (VecList n)+deriving via ViaFixed (VecList n) instance (Arity n) => F.Foldable (VecList n)+-- | @since @2.0.1.0+deriving via ViaFixed (VecList n)+ instance (Arity n, C.Peano n ~ S k) => F1.Foldable1 (VecList n)+ instance Arity n => T.Traversable (VecList n) where- sequenceA = sequenceA- traverse = traverse-instance (Arity n, Monoid a) => Monoid (VecList n a) where- mempty = replicate mempty- mappend = (<>)- {-# INLINE mempty #-}- {-# INLINE mappend #-}+ sequence = sequence+ sequenceA = sequence+ traverse = mapM+ mapM = mapM+ {-# INLINE sequence #-}+ {-# INLINE sequenceA #-}+ {-# INLINE mapM #-}+ {-# INLINE traverse #-} -instance (Arity n, Semigroup a) => Semigroup (VecList n a) where- (<>) = zipWith (<>)- {-# INLINE (<>) #-}+deriving via ViaFixed (VecList n) a instance (Arity n, Show a) => Show (VecList n a)+deriving via ViaFixed (VecList n) a instance (Arity n, Eq a) => Eq (VecList n a)+deriving via ViaFixed (VecList n) a instance (Arity n, Ord a) => Ord (VecList n a)+deriving via ViaFixed (VecList n) a instance (Arity n, NFData a) => NFData (VecList n a)+deriving via ViaFixed (VecList n) a instance (Arity n, Semigroup a) => Semigroup (VecList n a)+deriving via ViaFixed (VecList n) a instance (Arity n, Monoid a) => Monoid (VecList n a)+deriving via ViaFixed (VecList n) a instance (Arity n, Storable a) => Storable (VecList n a)+-- | @since 2.0.1.0+deriving via ViaFixed (VecList n) a instance (Arity n, Prim a) => Prim (VecList n a) -instance (Storable a, Arity n) => Storable (VecList n a) where- alignment = defaultAlignemnt- sizeOf = defaultSizeOf- peek = defaultPeek- poke = defaultPoke- {-# INLINE alignment #-}- {-# INLINE sizeOf #-}- {-# INLINE peek #-}- {-# INLINE poke #-} --- | Newtype for deriving 'Storable' instance for data types which has--- instance of 'Vector'-newtype StorableViaFixed v a = StorableViaFixed (v a)+deriving via ViaFixed (VecPeano n) instance (ArityPeano n) => Functor (VecPeano n)+deriving via ViaFixed (VecPeano n) instance (ArityPeano n) => Applicative (VecPeano n)+deriving via ViaFixed (VecPeano n) instance (ArityPeano n) => F.Foldable (VecPeano n)+-- | @since @2.0.1.0+deriving via ViaFixed (VecPeano n)+ instance (ArityPeano n, n ~ S k) => F1.Foldable1 (VecPeano n) -instance (Vector v a, Storable a) => Storable (StorableViaFixed v a) where- alignment = coerce (defaultAlignemnt @a @v)- sizeOf = coerce (defaultSizeOf @a @v)- peek = coerce (defaultPeek @a @v)- poke = coerce (defaultPoke @a @v)- {-# INLINE alignment #-}- {-# INLINE sizeOf #-}- {-# INLINE peek #-}- {-# INLINE poke #-}+instance ArityPeano n => T.Traversable (VecPeano n) where+ sequence = sequence+ sequenceA = sequence+ traverse = mapM+ mapM = mapM+ {-# INLINE sequence #-}+ {-# INLINE sequenceA #-}+ {-# INLINE mapM #-}+ {-# INLINE traverse #-} +deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Show a) => Show (VecPeano n a)+deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Eq a) => Eq (VecPeano n a)+deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Ord a) => Ord (VecPeano n a)+deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, NFData a) => NFData (VecPeano n a)+deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Semigroup a) => Semigroup (VecPeano n a)+deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Monoid a) => Monoid (VecPeano n a)+deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Storable a) => Storable (VecPeano n a)+-- | @since 2.0.1.0+deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Prim a) => Prim (VecPeano n a) ++ -- | Single-element tuple. newtype Only a = Only a- deriving (Show,Eq,Ord,Typeable,Data,Functor,F.Foldable,T.Traversable)+ deriving (Show,Eq,Ord,Data,Functor,F.Foldable,T.Traversable) +-- | @since @2.0.1.0+deriving via ViaFixed Only instance F1.Foldable1 Only++ instance Monoid a => Monoid (Only a) where mempty = Only mempty mappend = (<>)@@ -337,39 +382,49 @@ instance NFData a => NFData (Only a) where rnf (Only a) = rnf a -type instance Dim Only = 1+type instance Dim Only = C.N1+type instance Dim (Only a) = C.N1 instance Vector Only a where construct = Fun Only inspect (Only a) (Fun f) = f a {-# INLINE construct #-} {-# INLINE inspect #-}+instance FM.Prod a (Only a) where+ construct = construct+ inspect = inspect+ {-# INLINE construct #-}+ {-# INLINE inspect #-}+instance FM.Vector a (Only a) where instance (Storable a) => Storable (Only a) where- alignment _ = alignment (undefined :: a)- sizeOf _ = sizeOf (undefined :: a)- peek p = Only <$> peek (castPtr p)- poke p (Only a) = poke (castPtr p) a- {-# INLINE alignment #-}- {-# INLINE sizeOf #-}- {-# INLINE peek #-}- {-# INLINE poke #-}+ alignment = coerce (alignment @a)+ sizeOf = coerce (sizeOf @a)+ peek = coerce (peek @a)+ poke = coerce (poke @a) -- | Empty tuple. data Empty a = Empty- deriving (Show,Eq,Ord,Typeable,Data,Functor,F.Foldable,T.Traversable)+ deriving (Show,Eq,Ord,Data,Functor,F.Foldable,T.Traversable) instance NFData (Empty a) where rnf Empty = () -type instance Dim Empty = 0+type instance Dim Empty = 'Z+type instance Dim (Empty a) = 'Z instance Vector Empty a where construct = Fun Empty inspect _ (Fun b) = b {-# INLINE construct #-} {-# INLINE inspect #-}+instance FM.Prod a (Empty a) where+ construct = construct+ inspect = inspect+ {-# INLINE construct #-}+ {-# INLINE inspect #-}+instance FM.Vector a (Empty a) where type Tuple2 a = (a,a) type Tuple3 a = (a,a,a)@@ -378,44 +433,207 @@ ----------------------------------------------------------------+-- Deriving+----------------------------------------------------------------++-- | Newtype for deriving instance for data types which has instance+-- of 'Vector'. It supports 'Eq', 'Ord', 'Semigroup', 'Monoid',+-- 'Storable', 'NFData', 'Functor', 'Applicative', 'Foldable'.+newtype ViaFixed v a = ViaFixed (v a)++type instance Dim (ViaFixed v) = Dim v+type instance Dim (ViaFixed v a) = Dim v++instance Vector v a => Vector (ViaFixed v) a where+ construct = ViaFixed <$> construct+ inspect (ViaFixed v) = inspect v+ {-# INLINE construct #-}+ {-# INLINE inspect #-}++instance Vector v a => FM.Prod a (ViaFixed v a) where+ construct = ViaFixed <$> construct+ inspect (ViaFixed v) = inspect v+ {-# INLINE construct #-}+ {-# INLINE inspect #-}+instance Vector v a => FM.Vector a (ViaFixed v a) where++instance (Vector v a, Show a) => Show (ViaFixed v a) where+ showsPrec = coerce (I.showsPrec @v @a)++instance (Vector v a, Eq a) => Eq (ViaFixed v a) where+ (==) = coerce (eq @v @a)+ {-# INLINE (==) #-}++instance (Vector v a, Ord a) => Ord (ViaFixed v a) where+ compare = coerce (ord @v @a)+ {-# INLINE compare #-}++instance (Vector v a, NFData a) => NFData (ViaFixed v a) where+ rnf = coerce (defaultRnf @a @v)+ {-# INLINE rnf #-}++instance (Vector v a, Semigroup a) => Semigroup (ViaFixed v a) where+ (<>) = coerce (zipWith @v @a (<>))+ {-# INLINE (<>) #-}++instance (Vector v a, Monoid a) => Monoid (ViaFixed v a) where+ mempty = coerce (replicate @v @a mempty)+ {-# INLINE mempty #-}++instance (Vector v a, Storable a) => Storable (ViaFixed v a) where+ alignment = coerce (defaultAlignemnt @a @v)+ sizeOf = coerce (defaultSizeOf @a @v)+ peek = coerce (defaultPeek @a @v)+ poke = coerce (defaultPoke @a @v)+ {-# INLINE alignment #-}+ {-# INLINE sizeOf #-}+ {-# INLINE peek #-}+ {-# INLINE poke #-}++-- | @since 2.0.1.0+instance (Vector v a, Prim a) => Prim (ViaFixed v a) where+ sizeOf# _ = sizeOf# (undefined :: a) *# dim where+ dim = case C.peanoToInt (proxy# @(Dim v)) of I# i -> i+ alignment# _ = alignment# (undefined :: a)+ {-# INLINE sizeOf# #-}+ {-# INLINE alignment# #-}+ -- Bytearray+ indexByteArray# ba k+ = generate $ \(I# i) -> indexByteArray# ba (off +# i)+ where+ off = vectorOff (proxy# @(Dim v)) k+ readByteArray# ba k+ = internal+ $ generateM+ $ \(I# i) -> ST (\s -> readByteArray# ba (off +# i) s)+ where+ off = vectorOff (proxy# @(Dim v)) k+ writeByteArray# ba k (ViaFixed vec) =+ case loop of+ ST st -> \s -> case st s of+ (# s', () #) -> s'+ where+ off = vectorOff (proxy# @(Dim v)) k+ loop = flip imapM_ vec $ \(I# i) a -> ST $ \s ->+ (# writeByteArray# ba (off +# i) a s, () #)+ {-# INLINE indexByteArray# #-}+ {-# INLINE readByteArray# #-}+ {-# INLINE writeByteArray# #-}+ -- Addr+ indexOffAddr# addr k+ = generate $ \(I# i) -> indexOffAddr# addr (off +# i)+ where+ off = vectorOff (proxy# @(Dim v)) k+ readOffAddr# ba k+ = internal+ $ generateM+ $ \(I# i) -> ST (\s -> readOffAddr# ba (off +# i) s)+ where+ off = vectorOff (proxy# @(Dim v)) k+ writeOffAddr# addr k (ViaFixed vec) =+ case loop of+ ST st -> \s -> case st s of+ (# s', () #) -> s'+ where+ off = vectorOff (proxy# @(Dim v)) k+ loop = flip imapM_ vec $ \(I# i) a -> ST $ \s ->+ (# writeOffAddr# addr (off +# i) a s, () #)+ {-# INLINE indexOffAddr# #-}+ {-# INLINE readOffAddr# #-}+ {-# INLINE writeOffAddr# #-}+++vectorOff :: (ArityPeano n) => Proxy# n -> Int# -> Int#+{-# INLINE vectorOff #-}+vectorOff n k =+ case C.peanoToInt n of+ I# dim -> dim *# k+++instance (forall a. Vector v a) => Functor (ViaFixed v) where+ fmap = map+ {-# INLINE fmap #-}++instance (forall a. Vector v a) => Applicative (ViaFixed v) where+ pure = replicate+ (<*>) = zipWith ($)+ liftA2 = zipWith+ a <* _ = a+ _ *> b = b+ {-# INLINE pure #-}+ {-# INLINE (<*>) #-}+ {-# INLINE (<*) #-}+ {-# INLINE (*>) #-}+ {-# INLINE liftA2 #-}++instance (forall a. Vector v a) => F.Foldable (ViaFixed v) where+ foldMap' f = foldl' (\ acc a -> acc <> f a) mempty+ foldr = foldr+ foldl = foldl+ foldl' = foldl'+ toList = toList+ sum = sum+ product = foldl' (*) 0+ length = length+ {-# INLINE foldMap' #-}+ {-# INLINE foldr #-}+ {-# INLINE foldl #-}+ {-# INLINE foldl' #-}+ {-# INLINE toList #-}+ {-# INLINE sum #-}+ {-# INLINE product #-}+ {-# INLINE length #-}+++-- | @since @2.0.1.0+instance (forall a. Vector v a, Dim v ~ S k) => F1.Foldable1 (ViaFixed v) where+ fold1 = foldl1 (<>)+ foldMap1 f = F1.foldMap1 f . cvec+ foldMap1' f = F1.foldMap1' f . cvec+ toNonEmpty = F1.toNonEmpty . cvec+ head = head+ last = F1.last . cvec+ maximum = maximum+ minimum = minimum+ {-# INLINE fold1 #-}+ {-# INLINE foldMap1 #-}+ {-# INLINE foldMap1' #-}+ {-# INLINE toNonEmpty #-}+ {-# INLINE maximum #-}+ {-# INLINE minimum #-}+ {-# INLINE head #-}+ {-# INLINE last #-}+++---------------------------------------------------------------- -- Patterns ---------------------------------------------------------------- -pattern V1 :: (Vector v a, Dim v ~ 1) => a -> v a+pattern V1 :: (Vector v a, Dim v ~ C.N1) => a -> v a pattern V1 x <- (convert -> (Only x)) where V1 x = mk1 x-#if MIN_VERSION_base(4,16,0) {-# INLINE V1 #-} {-# COMPLETE V1 #-}-#endif -pattern V2 :: (Vector v a, Dim v ~ 2) => a -> a -> v a+pattern V2 :: (Vector v a, Dim v ~ C.N2) => a -> a -> v a pattern V2 x y <- (convert -> (x,y)) where V2 x y = mk2 x y-#if MIN_VERSION_base(4,16,0) {-# INLINE V2 #-} {-# COMPLETE V2 #-}-#endif -pattern V3 :: (Vector v a, Dim v ~ 3) => a -> a -> a -> v a+pattern V3 :: (Vector v a, Dim v ~ C.N3) => a -> a -> a -> v a pattern V3 x y z <- (convert -> (x,y,z)) where V3 x y z = mk3 x y z-#if MIN_VERSION_base(4,16,0) {-# INLINE V3 #-} {-# COMPLETE V3 #-}-#endif -pattern V4 :: (Vector v a, Dim v ~ 4) => a -> a -> a -> a -> v a+pattern V4 :: (Vector v a, Dim v ~ C.N4) => a -> a -> a -> a -> v a pattern V4 t x y z <- (convert -> (t,x,y,z)) where V4 t x y z = mk4 t x y z-#if MIN_VERSION_base(4,16,0) {-# INLINE V4 #-} {-# COMPLETE V4 #-}-#endif --- -- $setup -- -- >>> import Data.Char+-- >>> import Prelude (Int,Bool(..))
Data/Vector/Fixed/Boxed.hs view
@@ -1,14 +1,9 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-} -- |--- Vector which could hold any value.+-- Lazy vector which could hold any value. For strict variant see+-- "Data.Vector.Fixed.Strict". module Data.Vector.Fixed.Boxed ( -- * Immutable Vec@@ -27,104 +22,104 @@ import Data.Monoid (Monoid(..)) import Data.Semigroup (Semigroup(..)) import Data.Data+import Data.Primitive.Types (Prim) import qualified Data.Foldable as F+import qualified Data.Foldable1 as F1 import qualified Data.Traversable as T-import Foreign.Storable (Storable(..))+import Foreign.Storable (Storable) import GHC.TypeLits+import GHC.Exts (proxy#) import Prelude ( Show(..),Eq(..),Ord(..),Functor(..),Monad(..)- , ($),($!),error,seq)+ , ($!),error,(<$>)) +import Data.Vector.Fixed.Compat import Data.Vector.Fixed hiding (index)-import Data.Vector.Fixed.Mutable (Mutable, MVector(..), IVector(..), DimM, constructVec, inspectVec, arity, index)+import Data.Vector.Fixed.Mono qualified as FM+import Data.Vector.Fixed.Mutable (Mutable, MVector(..), IVector(..), DimM, constructVec, inspectVec, index) import qualified Data.Vector.Fixed.Cont as C-import qualified Data.Vector.Fixed.Internal as I-+import Data.Vector.Fixed.Cont (ArityPeano(..)) ---------------------------------------------------------------- -- Data type ---------------------------------------------------------------- --- | Vector with fixed length which can hold any value.+-- | Vector with fixed length which can hold any value. It's lazy and+-- doesn't evaluate elements. newtype Vec (n :: Nat) a = Vec (SmallArray a) -- | Mutable unboxed vector with fixed length newtype MVec (n :: Nat) s a = MVec (SmallMutableArray s a) -deriving instance Typeable Vec-deriving instance Typeable MVec- 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- gfoldl = C.gfoldl- gunfold = C.gunfold- toConstr _ = con_Vec- dataTypeOf _ = ty_Vec--ty_Vec :: DataType-ty_Vec = mkDataType "Data.Vector.Fixed.Boxed.Vec" [con_Vec]--con_Vec :: Constr-con_Vec = mkConstr ty_Vec "Vec" [] Prefix--instance (Storable a, Arity n) => Storable (Vec n a) where- alignment = defaultAlignemnt- sizeOf = defaultSizeOf- peek = defaultPeek- poke = defaultPoke- {-# INLINE alignment #-}- {-# INLINE sizeOf #-}- {-# INLINE peek #-}- {-# INLINE poke #-}--+type instance Mutable (Vec n) = MVec n+type instance Dim (Vec n) = Peano n+type instance Dim (Vec n a) = Peano n+type instance DimM (MVec n) = Peano n ---------------------------------------------------------------- -- Instances ---------------------------------------------------------------- -instance (Arity n, Show a) => Show (Vec n a) where- showsPrec = I.showsPrec+deriving via ViaFixed (Vec n) instance Arity n => Functor (Vec n)+deriving via ViaFixed (Vec n) instance Arity n => Applicative (Vec n)+deriving via ViaFixed (Vec n) instance Arity n => F.Foldable (Vec n)+-- | @since @2.0.1.0+deriving via ViaFixed (Vec n)+ instance (Arity n, Peano n ~ S k) => F1.Foldable1 (Vec n) -instance (Arity n, NFData a) => NFData (Vec n a) where- rnf = foldl (\r a -> r `seq` rnf a) ()- {-# INLINE rnf #-}+instance Arity n => T.Traversable (Vec n) where+ sequence = sequence+ sequenceA = sequence+ traverse = mapM+ mapM = mapM+ {-# INLINE sequence #-}+ {-# INLINE sequenceA #-}+ {-# INLINE mapM #-}+ {-# INLINE traverse #-} -type instance Mutable (Vec n) = MVec n+deriving via ViaFixed (Vec n) a instance (Arity n, Show a) => Show (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Eq a) => Eq (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Ord a) => Ord (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, NFData a) => NFData (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Semigroup a) => Semigroup (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Monoid a) => Monoid (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Storable a) => Storable (Vec n a)+-- | @since 2.0.1.0+deriving via ViaFixed (Vec n) a instance (Arity n, Prim a) => Prim (Vec n a) instance (Arity n) => MVector (MVec n) a where- new = do- v <- newSmallArray (arity (Proxy :: Proxy n)) uninitialised- return $ MVec v- {-# INLINE new #-}- copy = move- {-# INLINE copy #-}- move (MVec dst) (MVec src) = copySmallMutableArray dst 0 src 0 (arity (Proxy :: Proxy n))- {-# INLINE move #-}- unsafeRead (MVec v) i = readSmallArray v i- {-# INLINE unsafeRead #-}- unsafeWrite (MVec v) i x = writeSmallArray v i x- {-# INLINE unsafeWrite #-}+ basicNew =+ MVec <$> newSmallArray (peanoToInt (proxy# @(Peano n))) uninitialised+ basicReplicate a =+ MVec <$> newSmallArray (peanoToInt (proxy# @(Peano n))) a+ basicCopy (MVec dst) (MVec src) =+ copySmallMutableArray dst 0 src 0 (peanoToInt (proxy# @(Peano n)))+ basicClone (MVec src) =+ MVec <$> cloneSmallMutableArray src 0 (peanoToInt (proxy# @(Peano n)))+ basicUnsafeRead (MVec v) i = readSmallArray v i+ basicUnsafeWrite (MVec v) i x = writeSmallArray v i x+ {-# INLINE basicNew #-}+ {-# INLINE basicReplicate #-}+ {-# INLINE basicCopy #-}+ {-# INLINE basicClone #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-} instance (Arity n) => IVector (Vec n) a where- unsafeFreeze (MVec v) = do { a <- unsafeFreezeSmallArray v; return $! Vec a }- unsafeThaw (Vec v) = do { a <- unsafeThawSmallArray v; return $! MVec a }+ basicUnsafeFreeze (MVec v) = do { a <- unsafeFreezeSmallArray v; return $! Vec a }+ basicThaw (Vec v) =+ MVec <$> thawSmallArray v 0 (peanoToInt (proxy# @(Peano n))) unsafeIndex (Vec v) i = indexSmallArray v i- {-# INLINE unsafeFreeze #-}- {-# INLINE unsafeThaw #-}- {-# INLINE unsafeIndex #-}----type instance Dim (Vec n) = n-type instance DimM (MVec n) = n+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicThaw #-}+ {-# INLINE unsafeIndex #-} instance (Arity n) => Vector (Vec n) a where construct = constructVec@@ -133,44 +128,24 @@ {-# INLINE construct #-} {-# INLINE inspect #-} {-# INLINE basicIndex #-}-instance (Arity n) => VectorN Vec n a--instance (Arity n, Eq a) => Eq (Vec n a) where- (==) = eq- {-# INLINE (==) #-}-instance (Arity n, Ord a) => Ord (Vec n a) where- compare = ord- {-# INLINE compare #-}--instance (Arity n, Monoid a) => Monoid (Vec n a) where- mempty = replicate mempty- mappend = (<>)- {-# INLINE mempty #-}- {-# INLINE mappend #-}--instance (Arity n, Semigroup a) => Semigroup (Vec n a) where- (<>) = zipWith (<>)- {-# INLINE (<>) #-}--instance Arity n => Functor (Vec n) where- {-# INLINE fmap #-}- fmap = map+instance (Arity n) => FM.Prod a (Vec n a) where+ construct = constructVec+ inspect = inspectVec+ {-# INLINE construct #-}+ {-# INLINE inspect #-}+instance (Arity n) => FM.Vector a (Vec n a) -instance Arity n => Applicative (Vec n) where- pure = replicate- (<*>) = zipWith ($)- {-# INLINE pure #-}- {-# INLINE (<*>) #-}+instance (Typeable n, Arity n, Data a) => Data (Vec n a) where+ gfoldl = C.gfoldl+ gunfold = C.gunfold+ toConstr _ = con_Vec+ dataTypeOf _ = ty_Vec -instance Arity n => F.Foldable (Vec n) where- foldr = foldr- {-# INLINE foldr #-}+ty_Vec :: DataType+ty_Vec = mkDataType "Data.Vector.Fixed.Boxed.Vec" [con_Vec] -instance Arity n => T.Traversable (Vec n) where- sequenceA = sequenceA- traverse = traverse- {-# INLINE sequenceA #-}- {-# INLINE traverse #-}+con_Vec :: Constr+con_Vec = mkConstr ty_Vec "Vec" [] Prefix uninitialised :: a uninitialised = error "Data.Vector.Fixed.Boxed: uninitialised element"
+ Data/Vector/Fixed/Compat.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE CPP #-}+-- | Compatibility for old GHC+module Data.Vector.Fixed.Compat+ (+#if MIN_VERSION_base(4,17,0)+ type(~)+#endif+ ) where
Data/Vector/Fixed/Cont.hs view
@@ -1,18 +1,6 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE UndecidableInstances #-} -- | -- API for Church-encoded vectors. Implementation of function from -- "Data.Vector.Fixed" module uses these function internally in order@@ -20,6 +8,7 @@ module Data.Vector.Fixed.Cont ( -- * Type-level numbers PeanoNum(..)+ , N1,N2,N3,N4,N5,N6,N7,N8 , Peano , Add -- * N-ary functions@@ -27,9 +16,9 @@ , Fun(..) , Arity , ArityPeano(..)- , arity , apply , applyM+ , Index(..) -- ** Combinators , constFun , curryFirst@@ -39,16 +28,14 @@ , apLast , shuffleFun , withFun- -- * Vector type class+ , dimapFun+ -- * Vector type Boxedclass , Dim , Vector(..)- , VectorN , length -- * Vector as continuation , ContVec(..)- , CVecPeano(..) , consPeano- , toContVec , runContVec -- * Construction of ContVec , cvec@@ -108,9 +95,12 @@ , vector -- ** Folds , foldl+ , foldl' , foldl1+ , foldl1' , foldr , ifoldl+ , ifoldl' , ifoldr , foldM , ifoldM@@ -135,16 +125,19 @@ import Data.Kind (Type) 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 Data.Foldable qualified as F+import Data.Traversable qualified as T+import Data.List.NonEmpty qualified as NE+import Data.Foldable1 qualified as F1+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- , head,tail,mapM,mapM_,sequence,sequence_,concat+import GHC.Exts (Proxy#, proxy#)+import Prelude ( Bool(..), Int, Maybe(..), Either(..)+ , Eq(..), Ord(..), Num(..), Functor(..), Applicative(..), Monad(..)+ , Semigroup(..), Monoid(..)+ , (.), ($), (&&), (||), (<$>), id, error, otherwise, fst )-+import Data.Vector.Fixed.Compat ---------------------------------------------------------------- -- Naturals@@ -156,6 +149,16 @@ data PeanoNum = Z | S PeanoNum +type N1 = S Z+type N2 = S N1+type N3 = S N2+type N4 = S N3+type N5 = S N4+type N6 = S N5+type N7 = S N6+type N8 = S N7++ -- | Convert type level natural to Peano representation type family Peano (n :: Nat) :: PeanoNum where Peano 0 = 'Z@@ -177,8 +180,9 @@ 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 wrapper which is used to make 'Fn' injective. It's a+-- function which takes @n@ parameters of type @a@ and returns value+-- of type @b@. newtype Fun n a b = Fun { unFun :: Fn n a b } @@ -200,12 +204,14 @@ {-# INLINE pure #-} {-# INLINE (<*>) #-} +-- | Reader instance ArityPeano n => Monad (Fun n a) where return = pure f >>= g = shuffleFun g <*> f {-# INLINE return #-} {-# INLINE (>>=) #-} +newtype T_Flip a b n = T_Flip (Fun n a b) data T_ap a b c n = T_ap (Fn n a b) (Fn n a c) @@ -214,14 +220,10 @@ -- 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)- )+-- | Synonym for writing constrains using type level naturals.+type Arity n = ArityPeano (Peano n) --- | Type class for handling /n/-ary functions.+-- | Type class for defining and applying /n/-ary functions. class ArityPeano n where -- | Left fold over /n/ elements exposed as n-ary function. These -- elements are supplied as arguments to the function.@@ -230,12 +232,20 @@ -> t n -- ^ Initial value -> Fun n a b -- ^ Reduction function + -- | Same as @accum@ but allow use @ArityPeano@ at each step Note+ -- that in general case this will lead to /O(n²)/ compilation time.+ accumPeano+ :: (forall k. ArityPeano 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- -> (CVecPeano n a, t 'Z)+ -> (ContVec n a, t 'Z) -- | Apply all parameters to the function using monadic -- actions. Note that for identity monad it's same as@@ -245,80 +255,107 @@ 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)+ -> (f (ContVec n a), t 'Z) - -- | 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 - -- | 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+ -- | Perform N reduction steps. This function doesn't involve N-ary+ -- function directly.+ reducePeano :: (forall k. t ('S k) -> t k) -- ^ Reduction step+ -> t n+ -> t 'Z -newtype T_gunfold c r a n = T_gunfold (c (Fn n a r))+ -- | Conver peano number to int+ peanoToInt :: Proxy# n -> Int + -- | Provide @ArityPeano@ dictionary for previous Peano number. GHC+ -- cannot infer that when @ArityPeano n@ and @n ~ S k@ we have+ -- instance for @k@ as well. So we have to provide such dictionary+ -- manually.+ --+ -- It's not possible to have non-⊥ implementation for @Z@ but+ -- neither it's possible to call it.+ dictionaryPred :: (n ~ S k) => Proxy# n -> (ArityPeano k => r) -> r +newtype T_gunfold c r a n = T_gunfold (c (Fn n a r)) + -- | Apply all parameters to the function.-apply :: Arity n+apply :: ArityPeano n => (forall k. t ('S k) -> (a, t k)) -- ^ Get value to apply to function- -> t (Peano n) -- ^ Initial value+ -> t n -- ^ Initial value -> ContVec n a -- ^ N-ary function {-# INLINE apply #-}-apply step z = toContVec $ fst (applyFun step z)+apply step z = fst (applyFun step z) -- | Apply all parameters to the function using applicative actions.-applyM :: (Applicative f, Arity n)+applyM :: (Applicative f, ArityPeano n) => (forall k. t ('S k) -> (f a, t k)) -- ^ Get value to apply to function- -> t (Peano n) -- ^ Initial value+ -> t n -- ^ Initial value -> f (ContVec n a) {-# INLINE applyM #-}-applyM f t = fmap toContVec $ fst $ applyFunM f t+applyM f t = fst $ applyFunM f t --- | Arity of function.-arity :: KnownNat n => proxy n -> Int-{-# INLINE arity #-}-arity = fromIntegral . natVal +-- | Type class for indexing of vector of length @n@ with statically+-- known index @k@+class Index (k :: PeanoNum) (n :: PeanoNum) where+ getF :: Proxy# k -> Fun n a a+ putF :: Proxy# k -> a -> Fun n a r -> Fun n a r+ lensF :: Functor f => Proxy# k -> (a -> f a) -> Fun n a r -> Fun n a (f r)+++ instance ArityPeano 'Z where- accum _ g t = Fun $ g t- applyFun _ t = (CVecPeano unFun, t)- applyFunM _ t = (pure (CVecPeano unFun), t)- {-# INLINE accum #-}- {-# INLINE applyFun #-}- {-# INLINE applyFunM #-}- reverseF = id- gunfoldF _ (T_gunfold c) = c- {-# INLINE reverseF #-}- {-# INLINE gunfoldF #-}+ accum _ g t = Fun $ g t+ accumPeano _ g t = Fun $ g t+ applyFun _ t = (ContVec unFun, t)+ applyFunM _ t = (pure (ContVec unFun), t)+ reducePeano _ = id+ peanoToInt _ = 0+ {-# INLINE accum #-}+ {-# INLINE accumPeano #-}+ {-# INLINE applyFun #-}+ {-# INLINE applyFunM #-}+ {-# INLINE reducePeano #-}+ {-# INLINE peanoToInt #-}+ dictionaryPred _ _ = error "dictionaryPred: IMPOSSIBLE" instance ArityPeano n => ArityPeano ('S n) where- accum f g t = Fun $ \a -> unFun $ accum f g (f t a)- 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 #-}- reverseF f = Fun $ \a -> unFun (reverseF $ apLast f a)- gunfoldF f c = gunfoldF f (apGunfold f c)- {-# INLINE reverseF #-}- {-# INLINE gunfoldF #-}+ accum f g t = Fun $ \a -> unFun $ accum f g (f t a)+ accumPeano f g t = Fun $ \a -> unFun $ accumPeano f g (f t a)+ 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)+ reducePeano f t = reducePeano f (f t)+ peanoToInt _ = 1 + peanoToInt (proxy# @n)+ {-# INLINE accum #-}+ {-# INLINE applyFun #-}+ {-# INLINE applyFunM #-}+ {-# INLINE peanoToInt #-}+ {-# INLINE reducePeano #-}+ dictionaryPred _ r = r+ {-# INLINE dictionaryPred #-} -apGunfold :: Data a- => (forall b x. Data b => c (b -> x) -> c x)- -> T_gunfold c r a ('S n)- -> T_gunfold c r a n-apGunfold f (T_gunfold c) = T_gunfold $ f c-{-# INLINE apGunfold #-} +instance ArityPeano n => Index 'Z ('S n) where+ getF _ = uncurryFirst pure+ putF _ a f = Fun $ \_ -> unFun f a+ lensF _ f fun = Fun $ \a -> unFun $+ (\g -> g <$> f a) <$> shuffleFun (curryFirst fun)+ {-# INLINE getF #-}+ {-# INLINE putF #-}+ {-# INLINE lensF #-} -newtype T_Flip a b n = T_Flip (Fun n a b)+instance Index k n => Index (S k) (S n) where+ getF _ = uncurryFirst $ \_ -> getF (proxy# @k)+ putF _ a = withFun (putF (proxy# @k) a)+ lensF _ f fun = withFun (lensF (proxy# @k) f) fun+ {-# INLINE getF #-}+ {-# INLINE putF #-}+ {-# INLINE lensF #-} @@ -367,7 +404,7 @@ {-# 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 c) -> Fun ('S n) a b -> Fun ('S n) a c withFun f fun = Fun $ \a -> unFun $ f $ curryFirst fun a {-# INLINE withFun #-} @@ -382,18 +419,27 @@ newtype T_shuffle x a r n = T_shuffle (x -> Fn n a r) +-- | Apply function to parameters and result of @Fun@ simultaneously.+dimapFun :: ArityPeano n => (a -> b) -> (c -> d) -> Fun n b c -> Fun n a d+{-# INLINE dimapFun #-}+dimapFun fA fR fun+ = accum (\(T_Flip g) a -> T_Flip (curryFirst g (fA a)))+ (\(T_Flip x) -> fR (unFun x))+ (T_Flip fun) ++ ---------------------------------------------------------------- -- Type class for fixed vectors ---------------------------------------------------------------- --- | Size of vector expressed as type-level natural.-type family Dim (v :: Type -> Type) :: Nat+-- | Size of vector expressed as Peano natural.+type family Dim (v :: k) :: PeanoNum -- | 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 from @N@ elements and another+-- for vector deconstruction. They must obey following law: -- -- > inspect v construct = v --@@ -405,28 +451,23 @@ -- > 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 (Peano (Dim v)) a (v a)- -- | Deconstruction of vector.- inspect :: v a -> Fun (Peano (Dim v)) a b -> b+class ArityPeano (Dim v) => Vector v a where+ -- | N-ary function for creation of vectors. It takes @N@ elements+ -- of array as parameters and return vector.+ construct :: Fun (Dim v) a (v a)+ -- | Deconstruction of vector. It takes N-ary function as parameters+ -- and applies vector's elements to it.+ inspect :: v a -> Fun (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 basicIndex v i = index i (cvec v) {-# INLINE basicIndex #-} --- | Vector parametrized by length. In ideal world it should be:------ > forall n. (Arity n, Vector (v n) a, Dim (v n) ~ n) => VectorN v a------ Alas polymorphic constraints aren't allowed in haskell.-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. KnownNat (Dim v) => v a -> Int+length :: forall v a. ArityPeano (Dim v) => v a -> Int {-# INLINE length #-}-length _ = arity (Proxy :: Proxy (Dim v))+length _ = peanoToInt (proxy# @(Dim v)) ----------------------------------------------------------------@@ -435,62 +476,103 @@ -- | Vector represented as continuation. Alternative wording: it's -- Church encoded N-element vector.-newtype ContVec n a = ContVec (forall r. Fun (Peano n) a r -> r)--type instance Dim (ContVec n) = n+newtype ContVec n a = ContVec (forall r. Fun n a r -> r) --- | Same as 'ContVec' but its length is expressed as Peano number.-newtype CVecPeano n a = CVecPeano (forall r. Fun n a r -> r)+type instance Dim (ContVec n) = n+type instance Dim (ContVec n a) = n --- | Cons values to the @CVecPeano@.-consPeano :: a -> CVecPeano n a -> CVecPeano ('S n) a-consPeano a (CVecPeano cont) = CVecPeano $ \f -> cont $ curryFirst f a+-- | Cons values to the @ContVec@.+consPeano :: a -> ContVec n a -> ContVec ('S n) a+consPeano a (ContVec cont) = ContVec $ \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+instance ArityPeano n => Vector (ContVec n) a where construct = accum (\(T_mkN f) a -> T_mkN (f . consPeano a))- (\(T_mkN f) -> toContVec $ f (CVecPeano unFun))+ (\(T_mkN f) -> f (ContVec unFun)) (T_mkN id) inspect (ContVec c) f = c f {-# INLINE construct #-} {-# INLINE inspect #-} -newtype T_mkN n_tot a n = T_mkN (CVecPeano n a -> CVecPeano n_tot a)+newtype T_mkN n_tot a n = T_mkN (ContVec n a -> ContVec n_tot a) -instance Arity n => VectorN ContVec n a -instance (Arity n) => Functor (ContVec n) where+instance (Eq a, ArityPeano n) => Eq (ContVec n a) where+ a == b = and $ zipWith (==) a b+ {-# INLINE (==) #-}++instance (Ord a, ArityPeano n) => Ord (ContVec n a) where+ compare a b = foldl mappend mempty $ zipWith compare a b+ {-# INLINE compare #-}++instance (ArityPeano n, Monoid a) => Monoid (ContVec n a) where+ mempty = replicate mempty+ {-# INLINE mempty #-}++instance (ArityPeano n, Semigroup a) => Semigroup (ContVec n a) where+ (<>) = zipWith (<>)+ {-# INLINE (<>) #-}+++instance (ArityPeano n) => Functor (ContVec n) where fmap = map {-# INLINE fmap #-} -instance (Arity n) => Applicative (ContVec n) where+instance (ArityPeano n) => Applicative (ContVec n) where pure = replicate (<*>) = zipWith ($) {-# INLINE pure #-} {-# INLINE (<*>) #-} -instance (Arity n) => F.Foldable (ContVec n) where- foldr = foldr- {-# INLINE foldr #-}+instance (ArityPeano n) => F.Foldable (ContVec n) where+ foldMap' f = foldl' (\ acc a -> acc <> f a) mempty+ foldr = foldr+ foldl = foldl+ foldl' = foldl'+ toList = toList+ sum = sum+ product = foldl' (*) 0+ length = length+ {-# INLINE foldMap' #-}+ {-# INLINE foldr #-}+ {-# INLINE foldl #-}+ {-# INLINE foldl' #-}+ {-# INLINE toList #-}+ {-# INLINE sum #-}+ {-# INLINE product #-}+ {-# INLINE length #-} -instance (Arity n) => F.Traversable (ContVec n) where- sequenceA v = inspect v $ sequenceAF construct- {-# INLINE sequenceA #-} -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)- = accum (\(T_sequenceA f) a -> T_sequenceA (f <*> a))- (\(T_sequenceA f) -> f)- (T_sequenceA (pure f0) :: T_sequenceA f a b n)+instance (ArityPeano n, n ~ S k) => F1.Foldable1 (ContVec n) where+ fold1 = foldl1 (<>)+ foldMap1 f = foldl1 (<>) . map f+ foldMap1' f = foldl1' (<>) . map f+ toNonEmpty v = dictionaryPred (proxy# @n)+ $ head v NE.:| toList (tail v)+ maximum = maximum+ minimum = minimum+ head = head+ last = F1.last . F1.toNonEmpty+ {-# INLINE fold1 #-}+ {-# INLINE foldMap1 #-}+ {-# INLINE foldMap1' #-}+ {-# INLINE toNonEmpty #-}+ {-# INLINE maximum #-}+ {-# INLINE minimum #-}+ {-# INLINE head #-}+ {-# INLINE last #-} -newtype T_sequenceA f a b n = T_sequenceA (f (Fn n a b))+instance (ArityPeano n) => T.Traversable (ContVec n) where+ sequence = sequence+ sequenceA = sequence+ traverse = mapM+ mapM = mapM+ {-# INLINE sequence #-}+ {-# INLINE sequenceA #-}+ {-# INLINE mapM #-}+ {-# INLINE traverse #-} @@ -499,19 +581,19 @@ ---------------------------------------------------------------- -- | Convert regular vector to continuation based one.-cvec :: (Vector v a, Dim v ~ n) => v a -> ContVec n a+cvec :: (Vector v a) => v a -> ContVec (Dim v) a cvec v = ContVec (inspect v) {-# INLINE[0] cvec #-} -- | Create empty vector.-empty :: ContVec 0 a+empty :: ContVec 'Z a {-# INLINE empty #-} empty = ContVec (\(Fun r) -> r) -- | Convert list to continuation-based vector. Will throw error if -- list is shorter than resulting vector.-fromList :: Arity n => [a] -> ContVec n a+fromList :: ArityPeano n => [a] -> ContVec n a {-# INLINE fromList #-} fromList xs = apply step (Const xs)@@ -521,22 +603,22 @@ -- | 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+fromList' :: forall n a. ArityPeano n => [a] -> ContVec n a {-# INLINE fromList' #-} 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+ in case applyFun step (Const xs :: Const [a] n) of+ (v,Const []) -> 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)+fromListM :: forall n a. ArityPeano n => [a] -> Maybe (ContVec n a) {-# INLINE fromListM #-}-fromListM xs = case applyFunM step (Const xs :: Const [a] (Peano n)) of- (Just v, Const []) -> Just (toContVec v)+fromListM xs = case applyFunM step (Const xs :: Const [a] n) of+ (Just v, Const []) -> Just v _ -> Nothing where step (Const [] ) = (Nothing, Const [])@@ -544,46 +626,46 @@ -- | Convert vector to the list-toList :: (Arity n) => ContVec n a -> [a]+toList :: (ArityPeano n) => ContVec n a -> [a] toList = foldr (:) [] {-# INLINE toList #-} -- | Execute monadic action for every element of vector. Synonym for 'pure'.-replicate :: (Arity n) => a -> ContVec n a+replicate :: (ArityPeano n) => a -> ContVec n a {-# INLINE replicate #-} replicate a = apply (\Proxy -> (a, Proxy)) Proxy -- | Execute monadic action for every element of vector.-replicateM :: (Arity n, Applicative f) => f a -> f (ContVec n a)+replicateM :: (ArityPeano n, Applicative f) => f a -> f (ContVec n a) {-# INLINE replicateM #-} replicateM act = 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+generate :: (ArityPeano n) => (Int -> a) -> ContVec n a {-# INLINE generate #-} generate f = apply (\(Const n) -> (f n, Const (n + 1))) (Const 0) -- | Generate vector from monadic function which maps element's index -- to its value.-generateM :: (Applicative f, Arity n) => (Int -> f a) -> f (ContVec n a)+generateM :: (Applicative f, ArityPeano n) => (Int -> f a) -> f (ContVec n a) {-# INLINE generateM #-} generateM f = applyM (\(Const n) -> (f n, Const (n + 1))) (Const 0) -- | Unfold vector.-unfoldr :: Arity n => (b -> (a,b)) -> b -> ContVec n a+unfoldr :: ArityPeano n => (b -> (a,b)) -> b -> ContVec n a {-# INLINE unfoldr #-} unfoldr f b0 = 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+basis :: (Num a, ArityPeano n) => Int -> ContVec n a {-# INLINE basis #-} basis n0 = apply (\(Const n) -> (if n == 0 then 1 else 0, Const (n - 1)))@@ -591,35 +673,35 @@ -mk1 :: a -> ContVec 1 a+mk1 :: a -> ContVec N1 a mk1 a1 = ContVec $ \(Fun f) -> f a1 {-# INLINE mk1 #-} -mk2 :: a -> a -> ContVec 2 a+mk2 :: a -> a -> ContVec N2 a mk2 a1 a2 = ContVec $ \(Fun f) -> f a1 a2 {-# INLINE mk2 #-} -mk3 :: a -> a -> a -> ContVec 3 a+mk3 :: a -> a -> a -> ContVec N3 a mk3 a1 a2 a3 = ContVec $ \(Fun f) -> f a1 a2 a3 {-# INLINE mk3 #-} -mk4 :: a -> a -> a -> a -> ContVec 4 a+mk4 :: a -> a -> a -> a -> ContVec N4 a mk4 a1 a2 a3 a4 = ContVec $ \(Fun f) -> f a1 a2 a3 a4 {-# INLINE mk4 #-} -mk5 :: a -> a -> a -> a -> a -> ContVec 5 a+mk5 :: a -> a -> a -> a -> a -> ContVec N5 a mk5 a1 a2 a3 a4 a5 = ContVec $ \(Fun f) -> f a1 a2 a3 a4 a5 {-# INLINE mk5 #-} -mk6 :: a -> a -> a -> a -> a -> a -> ContVec 6 a+mk6 :: a -> a -> a -> a -> a -> a -> ContVec N6 a mk6 a1 a2 a3 a4 a5 a6 = ContVec $ \(Fun f) -> f a1 a2 a3 a4 a5 a6 {-# INLINE mk6 #-} -mk7 :: a -> a -> a -> a -> a -> a -> a -> ContVec 7 a+mk7 :: a -> a -> a -> a -> a -> a -> a -> ContVec N7 a mk7 a1 a2 a3 a4 a5 a6 a7 = ContVec $ \(Fun f) -> f a1 a2 a3 a4 a5 a6 a7 {-# INLINE mk7 #-} -mk8 :: a -> a -> a -> a -> a -> a -> a -> a -> ContVec 8 a+mk8 :: a -> a -> a -> a -> a -> a -> a -> a -> ContVec N8 a mk8 a1 a2 a3 a4 a5 a6 a7 a8 = ContVec $ \(Fun f) -> f a1 a2 a3 a4 a5 a6 a7 a8 {-# INLINE mk8 #-} @@ -629,23 +711,26 @@ ---------------------------------------------------------------- -- | Map over vector. Synonym for 'fmap'-map :: (Arity n) => (a -> b) -> ContVec n a -> ContVec n b+map :: (ArityPeano n) => (a -> b) -> ContVec n a -> ContVec n b {-# INLINE map #-}-map = imap . const+map f (ContVec contA) = ContVec $+ contA . mapF f -- | Apply function to every element of the vector and its index.-imap :: (Arity n) => (Int -> a -> b) -> ContVec n a -> ContVec n b+imap :: (ArityPeano n) => (Int -> a -> b) -> ContVec n a -> ContVec n b {-# INLINE imap #-} imap f (ContVec contA) = ContVec $ contA . imapF f -- | Effectful map over vector.-mapM :: (Arity n, Applicative f) => (a -> f b) -> ContVec n a -> f (ContVec n b)+mapM :: (ArityPeano n, Applicative f) => (a -> f b) -> ContVec n a -> f (ContVec n b) {-# INLINE mapM #-}-mapM = imapM . const+mapM f v+ = inspect v+ $ mapMF f construct -- | Apply monadic function to every element of the vector and its index.-imapM :: (Arity n, Applicative f)+imapM :: (ArityPeano n, Applicative f) => (Int -> a -> f b) -> ContVec n a -> f (ContVec n b) {-# INLINE imapM #-} imapM f v@@ -653,45 +738,65 @@ $ imapMF f construct -- | Apply monadic action to each element of vector and ignore result.-mapM_ :: (Arity n, Applicative f) => (a -> f b) -> ContVec n a -> f ()+mapM_ :: (ArityPeano n, Applicative f) => (a -> f b) -> ContVec n a -> f () {-# INLINE mapM_ #-} 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, Applicative f) => (Int -> a -> f b) -> ContVec n a -> f ()+imapM_ :: (ArityPeano n, Applicative f) => (Int -> a -> f b) -> ContVec n a -> f () {-# INLINE imapM_ #-} imapM_ f = ifoldl (\m i a -> m *> f i a *> pure ()) (pure ()) ++mapMF :: (ArityPeano n, Applicative f)+ => (a -> f b) -> Fun n b r -> Fun n a (f r)+{-# INLINE mapMF #-}+mapMF f (Fun funB) =+ accum (\(T_mapM m) a -> T_mapM (($) <$> m <*> f a))+ (\(T_mapM m) -> m)+ (T_mapM (pure funB))+ 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) $ ($) <$> m <*> f i a)- (\(T_mapM _ m) -> m)- (T_mapM 0 (pure funB))+ accum (\(T_imapM i m) a -> T_imapM (i+1) $ ($) <$> m <*> f i a)+ (\(T_imapM _ m) -> m)+ (T_imapM 0 (pure funB)) -data T_mapM a m r n = T_mapM Int (m (Fn n a r))+newtype T_mapM a m r n = T_mapM (m (Fn n a r))+data T_imapM a m r n = T_imapM Int (m (Fn n a r)) ++mapF :: ArityPeano n+ => (a -> b) -> Fun n b r -> Fun n a r+{-# INLINE mapF #-}+mapF f (Fun funB) =+ accum (\(T_map g) b -> T_map (g (f b)))+ (\(T_map r) -> r)+ ( T_map funB)+ imapF :: ArityPeano n => (Int -> a -> b) -> Fun n b r -> Fun n a r {-# INLINE imapF #-} imapF f (Fun funB) =- accum (\(T_map i g) b -> T_map (i+1) (g (f i b)))- (\(T_map _ r) -> r)- ( T_map 0 funB)+ accum (\(T_imap i g) b -> T_imap (i+1) (g (f i b)))+ (\(T_imap _ r) -> r)+ ( T_imap 0 funB) -data T_map a r n = T_map Int (Fn n a r)+newtype T_map a r n = T_map (Fn n a r)+data T_imap a r n = T_imap Int (Fn n a r) -- | Left scan over vector-scanl :: (Arity n) => (b -> a -> b) -> b -> ContVec n a -> ContVec (n+1) b+scanl :: (ArityPeano n) => (b -> a -> b) -> b -> ContVec n a -> ContVec ('S n) b {-# INLINE scanl #-} scanl f b0 (ContVec cont) = ContVec $ cont . scanlF f b0 -- | Left scan over vector-scanl1 :: (Arity n) => (a -> a -> a) -> ContVec n a -> ContVec n a+scanl1 :: (ArityPeano n) => (a -> a -> a) -> ContVec n a -> ContVec n a {-# INLINE scanl1 #-} scanl1 f (ContVec cont) = ContVec $ cont . scanl1F f@@ -719,17 +824,17 @@ -- | Evaluate every action in the vector from left to right.-sequence :: (Arity n, Applicative f) => ContVec n (f a) -> f (ContVec n a)+sequence :: (ArityPeano 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, Applicative f) => ContVec n (f a) -> f ()+sequence_ :: (ArityPeano n, Applicative f) => ContVec n (f a) -> f () sequence_ = mapM_ id {-# INLINE sequence_ #-} -- | The dual of sequenceA-distribute :: (Functor f, Arity n) => f (ContVec n a) -> ContVec n (f a)+distribute :: (Functor f, ArityPeano n) => f (ContVec n a) -> ContVec n (f a) {-# INLINE distribute #-} distribute f0 = apply step start@@ -740,64 +845,77 @@ , 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 :: (Functor f, ArityPeano n) => (a -> ContVec n b) -> f a -> ContVec n (f b) collect f = distribute . fmap f {-# INLINE collect #-} -- | /O(1)/ Tail of vector.-tail :: {-FIXME-} Arity n => ContVec (n+1) a -> ContVec n a+tail :: ContVec (S n) a -> ContVec n a tail (ContVec cont) = ContVec $ \f -> cont $ constFun f {-# INLINE tail #-} -- | /O(1)/ Prepend element to vector-cons :: {-FIXME-} Arity n => a -> ContVec n a -> ContVec (n+1) a+cons :: a -> ContVec n a -> ContVec ('S n) a cons a (ContVec cont) = ContVec $ \f -> cont $ curryFirst f a {-# INLINE cons #-} -- | Prepend single element vector to another vector.-consV :: {-FIXME-} Arity n => ContVec 1 a -> ContVec n a -> ContVec (n+1) a+consV :: ArityPeano n => ContVec N1 a -> ContVec n a -> ContVec ('S n) 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 (n+1) a+snoc :: ArityPeano n => a -> ContVec n a -> ContVec ('S n) a snoc a (ContVec cont) = ContVec $ \f -> cont $ apLast f a {-# INLINE snoc #-} + -- | Concatenate vector-concat :: ( Arity n- , Arity k- , Arity (n + k)- -- Tautology- , Peano (n + k) ~ Add (Peano n) (Peano k)+concat :: ( ArityPeano n+ , ArityPeano k+ , ArityPeano (n `Add` k) )- => ContVec n a -> ContVec k a -> ContVec (n + k) a+ => ContVec n a -> ContVec k a -> ContVec (Add n k) a {-# INLINE concat #-} concat v u = inspect u $ inspect v $ curryMany construct -- | Reverse order of elements in the vector-reverse :: Arity n => ContVec n a -> ContVec n a+reverse :: ArityPeano n => ContVec n a -> ContVec n a reverse (ContVec cont) = ContVec $ cont . reverseF {-# INLINE reverse #-} +reverseF :: forall n a b. ArityPeano n => Fun n a b -> Fun n a b+reverseF (Fun fun0) = accumPeano+ step+ (\(T_map b) -> b)+ (T_map fun0 :: T_map a b n)+ where+ step :: forall k. ArityPeano k => T_map a b (S k) -> a -> T_map a b k+ step (T_map f) a = T_map $ unFun $ apLast (Fun f :: Fun (S k) a b) a++ -- | Zip two vector together using function.-zipWith :: (Arity n) => (a -> b -> c)+zipWith :: (ArityPeano n) => (a -> b -> c) -> ContVec n a -> ContVec n b -> ContVec n c {-# INLINE zipWith #-}-zipWith = izipWith . const+zipWith f vecA vecB = ContVec $ \funC ->+ inspect vecB+ $ inspect vecA+ $ zipWithF f funC -- | Zip three vectors together-zipWith3 :: (Arity n) => (a -> b -> c -> d)+zipWith3 :: (ArityPeano n) => (a -> b -> c -> d) -> ContVec n a -> ContVec n b -> ContVec n c -> ContVec n d {-# INLINE zipWith3 #-}-zipWith3 f v1 v2 v3 = zipWith (\a (b, c) -> f a b c) v1 (zipWith (,) v2 v3)+zipWith3 f v1 v2 v3+ = zipWith ($) (zipWith f v1 v2) v3 -- | Zip two vector together using function which takes element index -- as well.-izipWith :: (Arity n) => (Int -> a -> b -> c)+izipWith :: (ArityPeano n) => (Int -> a -> b -> c) -> ContVec n a -> ContVec n b -> ContVec n c {-# INLINE izipWith #-} izipWith f vecA vecB = ContVec $ \funC ->@@ -806,53 +924,86 @@ $ izipWithF f funC -- | Zip three vectors together-izipWith3 :: (Arity n) => (Int -> a -> b -> c -> d)+izipWith3 :: (ArityPeano n) => (Int -> a -> b -> c -> d) -> ContVec n a -> ContVec n b -> ContVec n c -> ContVec n d {-# INLINE izipWith3 #-} 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, Applicative f) => (a -> b -> f c)+zipWithM :: (ArityPeano 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, Applicative f)+zipWithM_ :: (ArityPeano 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, Applicative f) => (Int -> a -> b -> f c)+izipWithM :: (ArityPeano 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, Applicative f)+izipWithM_ :: (ArityPeano 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) +-- NOTE: [zipWith]+-- ~~~~~~~~~~~~~~~+--+-- It turns out it's very difficult to implement zipWith using+-- accum/apply. Key problem is we need to implement:+--+-- > zipF :: Fun n (a,b) r → Fun n a (Fun b r)+--+-- Induction step would be implementing+--+-- > ((a,b) → Fun n (a,b) r) → (a → Fun n a (b → Fun b r))+--+-- in terms of zipF above. It will give us `Fun n a (Fun b r)` but+-- we'll need to move parameter `b` _inside_ `Fun n a`. This requires+-- `ArityPeano` constraint while accum's parameter has note. Even+-- worse this implementation has quadratic complexity.+--+-- It's possible to make zipF method of ArityPeano but quadratic+-- complexity won't go away and starts cause slowdown even for modest+-- values of `n`: 5-6. For n above 10 compilation starts to fail with+-- "simplifier ticks exhausted error".+--+-- It turns out easiest way is materialize list and then deconstruct.+-- GHC is able to eliminate it and it's very hard to beat this approach++zipWithF :: (ArityPeano n)+ => (a -> b -> c) -> Fun n c r -> Fun n a (Fun n b r)+{-# INLINE zipWithF #-}+zipWithF f (Fun g0)+ = makeList+ $ \v -> accum (\(T_zip (a:as) g) b -> T_zip as (g $ f a b))+ (\(T_zip _ x) -> x)+ (T_zip v g0)+ izipWithF :: (ArityPeano n) => (Int -> a -> b -> c) -> Fun n c r -> Fun n a (Fun n b r) {-# INLINE izipWithF #-}-izipWithF f (Fun g0) =- fmap (\v -> accum- (\(T_izip i (a:as) g) b -> T_izip (i+1) as (g $ f i a b))- (\(T_izip _ _ x) -> x)- (T_izip 0 v g0)- ) makeList-+izipWithF f (Fun g0)+ = makeList+ $ \v -> accum (\(T_izip i (a:as) g) b -> T_izip (i+1) as (g $ f i a b))+ (\(T_izip _ _ x) -> x)+ (T_izip 0 v g0) -makeList :: ArityPeano n => Fun n a [a]+makeList :: ArityPeano n => ([a] -> b) -> Fun n a b {-# INLINE makeList #-}-makeList = accum+makeList cont = accum (\(Const xs) x -> Const (xs . (x:)))- (\(Const xs) -> xs [])+ (\(Const xs) -> cont (xs [])) (Const id) data T_izip a c r n = T_izip Int [a] (Fn n c r)+data T_zip a c r n = T_zip [a] (Fn n c r) @@ -862,29 +1013,27 @@ -- | Run continuation vector. It's same as 'inspect' but with -- arguments flipped.-runContVec :: Fun (Peano n) a r+runContVec :: Fun n a r -> ContVec n a -> r runContVec f (ContVec c) = c f {-# INLINE runContVec #-} -- | Convert continuation to the vector.-vector :: (Vector v a, Dim v ~ n) => ContVec n a -> v a+vector :: (Vector v a) => ContVec (Dim v) a -> v a vector = runContVec construct {-# INLINE[1] vector #-} -- | Finalizer function for getting head of the vector.-head :: (Arity n, 1<=n) => ContVec n a -> a+head :: forall n k a. (ArityPeano n, n ~ 'S k) => ContVec n a -> a {-# INLINE head #-} head- = runContVec- $ accum (\(Const m) a -> Const $ case m of { Nothing -> Just a; x -> x })- (\(Const (Just x)) -> x)- (Const Nothing)-+ = dictionaryPred (proxy# @n)+ $ runContVec+ $ uncurryFirst pure -- | /O(n)/ Get value at specified index.-index :: Arity n => Int -> ContVec n a -> a+index :: ArityPeano n => Int -> ContVec n a -> a {-# INLINE index #-} index n | n < 0 = error "Data.Vector.Fixed.Cont.index: index out of range"@@ -902,7 +1051,7 @@ -- | Twan van Laarhoven lens for continuation based vector-element :: (Arity n, Functor f)+element :: (ArityPeano n, Functor f) => Int -> (a -> f a) -> ContVec n a -> f (ContVec n a) {-# INLINE element #-} element i f v = inspect v@@ -931,107 +1080,153 @@ -- | Left fold over continuation vector.-foldl :: Arity n => (b -> a -> b) -> b -> ContVec n a -> b+foldl :: ArityPeano n => (b -> a -> b) -> b -> ContVec n a -> b {-# INLINE foldl #-}-foldl f = ifoldl (\b _ a -> f b a)+foldl f b0 = runContVec (foldlF f b0) +-- | Strict left fold over continuation vector.+foldl' :: ArityPeano n => (b -> a -> b) -> b -> ContVec n a -> b+{-# INLINE foldl' #-}+foldl' f b0 = runContVec (foldlF' f b0)+ -- | Left fold over continuation vector.-ifoldl :: Arity n => (b -> Int -> a -> b) -> b -> ContVec n a -> b+ifoldl :: ArityPeano n => (b -> Int -> a -> b) -> b -> ContVec n a -> b {-# INLINE ifoldl #-} ifoldl f b v = inspect v $ accum (\(T_ifoldl i r) a -> T_ifoldl (i+1) (f r i a))- (\(T_ifoldl _ r) -> r)+ (\(T_ifoldl _ r) -> r) (T_ifoldl 0 b) +-- | Strict left fold over continuation vector.+ifoldl' :: ArityPeano n => (b -> Int -> a -> b) -> b -> ContVec n a -> b+{-# INLINE ifoldl' #-}+ifoldl' f b v+ = inspect v+ $ accum (\(T_ifoldl i !r) a -> T_ifoldl (i+1) (f r i a))+ (\(T_ifoldl _ r) -> r)+ (T_ifoldl 0 b)+ -- | Monadic left fold over continuation vector.-foldM :: (Arity n, Monad m)+foldM :: (ArityPeano n, Monad m) => (b -> a -> m b) -> b -> ContVec n a -> m b {-# INLINE foldM #-} foldM f x = foldl (\m a -> do{ b <- m; f b a}) (return x) -- | Monadic left fold over continuation vector.-ifoldM :: (Arity n, Monad m)+ifoldM :: (ArityPeano n, Monad m) => (b -> Int -> a -> m b) -> b -> ContVec n a -> m b {-# INLINE ifoldM #-} ifoldM f x = ifoldl (\m i a -> do{ b <- m; f b i a}) (return x) -data T_ifoldl b n = T_ifoldl !Int b --- Implementation of foldl1 is quite ugly. It could be expressed in--- terms of foldlF (worker function for foldl)------ > foldl1F f = Fun $ \a -> case foldlF f a :: Fun n a a of Fun g -> g------ But it require constraint `Arity n` whereas `Vector v a` gives--- `Arity (S n)`. Latter imply former but GHC cannot infer it.---- | Left fold.-foldl1 :: (Arity n, 1 <= n) => (a -> a -> a) -> ContVec n a -> a+-- | Left fold without base case. It's total because it requires vector to be nonempty+foldl1 :: forall n k a. (ArityPeano n, n ~ 'S k)+ => (a -> a -> a) -> ContVec n a -> a {-# INLINE foldl1 #-} foldl1 f- = runContVec- $ accum (\(Const r ) a -> Const $ Just $ maybe a (flip f a) r)- (\(Const (Just x)) -> x)- (Const Nothing)+ = dictionaryPred (proxy# @n)+ $ runContVec+ $ uncurryFirst (foldlF f) +-- | Left fold without base case. It's total because it requires vector to be nonempty+foldl1' :: forall n k a. (ArityPeano n, n ~ 'S k)+ => (a -> a -> a) -> ContVec n a -> a+{-# INLINE foldl1' #-}+foldl1' f+ = dictionaryPred (proxy# @n)+ $ runContVec+ $ uncurryFirst (foldlF' f)+++foldlF :: ArityPeano n => (b -> a -> b) -> b -> Fun n a b+{-# INLINE foldlF #-}+foldlF f b0+ = accum (\(T_foldl b) a -> T_foldl (f b a))+ (\(T_foldl b) -> b)+ (T_foldl b0)++foldlF' :: ArityPeano n => (b -> a -> b) -> b -> Fun n a b+{-# INLINE foldlF' #-}+foldlF' f b0+ = accum (\(T_foldl !b) a -> T_foldl (f b a))+ (\(T_foldl b) -> b)+ (T_foldl b0)++newtype T_foldl b n = T_foldl b+data T_ifoldl b n = T_ifoldl !Int b++ -- | Right fold over continuation vector-foldr :: Arity n => (a -> b -> b) -> b -> ContVec n a -> b+foldr :: ArityPeano n => (a -> b -> b) -> b -> ContVec n a -> b {-# INLINE foldr #-}-foldr = ifoldr . const+foldr f b0 = runContVec $ foldrF f b0 -- | Right fold over continuation vector-ifoldr :: Arity n => (Int -> a -> b -> b) -> b -> ContVec n a -> b+ifoldr :: ArityPeano n => (Int -> a -> b -> b) -> b -> ContVec n a -> b {-# INLINE ifoldr #-}-ifoldr f z- = runContVec- $ accum (\(T_ifoldr i g) a -> T_ifoldr (i+1) (g . f i a))- (\(T_ifoldr _ g) -> g z)- (T_ifoldr 0 id)+ifoldr f b0 = runContVec $ ifoldrF f b0 ++foldrF :: ArityPeano n => (a -> b -> b) -> b -> Fun n a b+{-# INLINE foldrF #-}+foldrF f b0 = accum+ (\(T_foldr g) a -> T_foldr (g . f a))+ (\(T_foldr g) -> g b0)+ (T_foldr id)++ifoldrF :: ArityPeano n => (Int -> a -> b -> b) -> b -> Fun n a b+{-# INLINE ifoldrF #-}+ifoldrF f b0 = accum+ (\(T_ifoldr i g) a -> T_ifoldr (i+1) (g . f i a))+ (\(T_ifoldr _ g) -> g b0)+ (T_ifoldr 0 id)++data T_foldr b n = T_foldr (b -> b) data T_ifoldr b n = T_ifoldr Int (b -> b) + -- | Sum all elements in the vector.-sum :: (Num a, Arity n) => ContVec n a -> a-sum = foldl (+) 0+sum :: (Num a, ArityPeano n) => ContVec n a -> a+sum = foldl' (+) 0 {-# INLINE sum #-} -- | Minimal element of vector.-minimum :: (Ord a, Arity n, 1<=n) => ContVec n a -> a+minimum :: (Ord a, ArityPeano n, n ~ 'S k) => ContVec n a -> a minimum = foldl1 min {-# INLINE minimum #-} -- | Maximal element of vector.-maximum :: (Ord a, Arity n, 1<=n) => ContVec n a -> a+maximum :: (Ord a, ArityPeano n, n ~ 'S k) => ContVec n a -> a maximum = foldl1 max {-# INLINE maximum #-} -- | Conjunction of elements of a vector.-and :: Arity n => ContVec n Bool -> Bool+and :: ArityPeano n => ContVec n Bool -> Bool and = foldr (&&) True {-# INLINE and #-} -- | Disjunction of all elements of a vector.-or :: Arity n => ContVec n Bool -> Bool+or :: ArityPeano n => ContVec n Bool -> Bool or = foldr (||) False {-# INLINE or #-} -- | Determines whether all elements of vector satisfy predicate.-all :: Arity n => (a -> Bool) -> ContVec n a -> Bool+all :: ArityPeano n => (a -> Bool) -> ContVec n a -> Bool all f = foldr (\x b -> f x && b) True {-# INLINE all #-} -- | Determines whether any of element of vector satisfy predicate.-any :: Arity n => (a -> Bool) -> ContVec n a -> Bool+any :: ArityPeano n => (a -> Bool) -> ContVec n a -> Bool any f = foldr (\x b -> f x || b) False {-# INLINE any #-} -- | The 'find' function takes a predicate and a vector and returns -- the leftmost element of the vector matching the predicate, -- or 'Nothing' if there is no such element.-find :: Arity n => (a -> Bool) -> ContVec n a -> Maybe a+find :: ArityPeano n => (a -> Bool) -> ContVec n a -> Maybe a find f = foldl (\r x -> r <|> if f x then Just x else Nothing) Nothing {-# INLINE find #-} @@ -1042,7 +1237,7 @@ -> v a -> c (v a) gfoldl f inj v = inspect v- $ gfoldlF f (inj $ unFun (construct :: Fun (Peano (Dim v)) a (v a)))+ $ gfoldlF f (inj $ unFun (construct :: Fun (Dim v) a (v a))) -- | Generic 'Data.Data.gunfoldl' which could work with any -- vector. Since vector can only have one constructor argument for@@ -1051,22 +1246,24 @@ => (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> con -> c (v a)-gunfold f inj _- = gunfoldF f gun+gunfold f inj _ =+ case reducePeano step gun of+ T_gunfold c -> c where- con = construct :: Fun (Peano (Dim v)) a (v a)- gun = T_gunfold (inj $ unFun con) :: T_gunfold c (v a) a (Peano (Dim v))-+ con = construct @v @a+ gun = T_gunfold (inj $ unFun con) :: T_gunfold c (v a) a (Dim v)+ --+ step :: forall k r. T_gunfold c r a ('S k) -> T_gunfold c r a k+ step (T_gunfold c) = T_gunfold (f c) 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)- (T_gfoldl c0)+ (\(T_mapM c) x -> T_mapM (f c x))+ (\(T_mapM c) -> c)+ (T_mapM c0) -newtype T_gfoldl c r a n = T_gfoldl (c (Fn n a r)) ----------------------------------------------------------------@@ -1105,7 +1302,8 @@ -- Instances ---------------------------------------------------------------- -type instance Dim Complex = 2+type instance Dim Complex = N2+type instance Dim (Complex a) = N2 instance Vector Complex a where construct = Fun (:+)@@ -1114,7 +1312,8 @@ {-# INLINE inspect #-} -type instance Dim Identity = 1+type instance Dim Identity = N1+type instance Dim (Identity a) = N1 instance Vector Identity a where construct = Fun Identity@@ -1123,7 +1322,8 @@ {-# INLINE inspect #-} -type instance Dim ((,) a) = 2+type instance Dim ((,) a) = N2+type instance Dim ((,) a b) = N2 -- | Note this instance (and other instances for tuples) is -- essentially monomorphic in element type. Vector type /v/ of 2@@ -1136,7 +1336,8 @@ {-# INLINE inspect #-} -type instance Dim ((,,) a b) = 3+type instance Dim ((,,) a b) = N3+type instance Dim ((,,) a b c) = N3 instance (b~a, c~a) => Vector ((,,) b c) a where construct = Fun (,,)@@ -1145,7 +1346,8 @@ {-# INLINE inspect #-} -type instance Dim ((,,,) a b c) = 4+type instance Dim ((,,,) a b c) = N4+type instance Dim ((,,,) a b c d) = N4 instance (b~a, c~a, d~a) => Vector ((,,,) b c d) a where construct = Fun (,,,)@@ -1154,7 +1356,8 @@ {-# INLINE inspect #-} -type instance Dim ((,,,,) a b c d) = 5+type instance Dim ((,,,,) a b c d) = N5+type instance Dim ((,,,,) a b c d e) = N5 instance (b~a, c~a, d~a, e~a) => Vector ((,,,,) b c d e) a where construct = Fun (,,,,)@@ -1163,7 +1366,8 @@ {-# INLINE inspect #-} -type instance Dim ((,,,,,) a b c d e) = 6+type instance Dim ((,,,,,) a b c d e) = N6+type instance Dim ((,,,,,) a b c d e f) = N6 instance (b~a, c~a, d~a, e~a, f~a) => Vector ((,,,,,) b c d e f) a where construct = Fun (,,,,,)@@ -1172,7 +1376,8 @@ {-# INLINE inspect #-} -type instance Dim ((,,,,,,) a b c d e f) = 7+type instance Dim ((,,,,,,) a b c d e f) = N7+type instance Dim ((,,,,,,) a b c d e f g) = N7 instance (b~a, c~a, d~a, e~a, f~a, g~a) => Vector ((,,,,,,) b c d e f g) a where construct = Fun (,,,,,,)@@ -1180,7 +1385,8 @@ {-# INLINE construct #-} {-# INLINE inspect #-} -type instance Dim Proxy = 0+type instance Dim Proxy = Z+type instance Dim (Proxy a) = Z instance Vector Proxy a where construct = Fun Proxy
Data/Vector/Fixed/Generic.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE TypeFamilies #-} -- | -- More generic version of function from "Data.Vector.Fixed" -- module. They do not require that all vector have same type, only
Data/Vector/Fixed/Internal.hs view
@@ -1,26 +1,18 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PolyKinds #-} -- | -- Implementation of fixed-vectors module Data.Vector.Fixed.Internal where 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 GHC.Exts (proxy#) -import Data.Vector.Fixed.Cont (Vector(..),Dim,Arity,vector,Add)+import Data.Vector.Fixed.Cont (Vector(..),Dim,vector,Add,PeanoNum(..),+ Peano,Index,ArityPeano) import qualified Data.Vector.Fixed.Cont as C import Prelude hiding ( replicate,map,zipWith,maximum,minimum,and,or,all,any@@ -33,39 +25,39 @@ -- Constructors ---------------------------------------------------------------- -mk0 :: (Vector v a, Dim v ~ 0) => v a+mk0 :: (Vector v a, Dim v ~ 'Z) => v a mk0 = vector C.empty {-# INLINE mk0 #-} -mk1 :: (Vector v a, Dim v ~ 1) => a -> v a+mk1 :: (Vector v a, Dim v ~ C.N1) => a -> v a mk1 a1 = vector $ C.mk1 a1 {-# INLINE mk1 #-} -mk2 :: (Vector v a, Dim v ~ 2) => a -> a -> v a+mk2 :: (Vector v a, Dim v ~ C.N2) => a -> a -> v a mk2 a1 a2 = vector $ C.mk2 a1 a2 {-# INLINE mk2 #-} -mk3 :: (Vector v a, Dim v ~ 3) => a -> a -> a -> v a+mk3 :: (Vector v a, Dim v ~ C.N3) => a -> a -> a -> v a mk3 a1 a2 a3 = vector $ C.mk3 a1 a2 a3 {-# INLINE mk3 #-} -mk4 :: (Vector v a, Dim v ~ 4) => a -> a -> a -> a -> v a+mk4 :: (Vector v a, Dim v ~ C.N4) => 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 ~ 5) => a -> a -> a -> a -> a -> v a+mk5 :: (Vector v a, Dim v ~ C.N5) => a -> a -> a -> a -> a -> v a mk5 a1 a2 a3 a4 a5 = vector $ C.mk5 a1 a2 a3 a4 a5 {-# INLINE mk5 #-} -mk6 :: (Vector v a, Dim v ~ 6) => a -> a -> a -> a -> a -> a -> v a+mk6 :: (Vector v a, Dim v ~ C.N6) => a -> a -> a -> a -> a -> a -> v a mk6 a1 a2 a3 a4 a5 a6 = vector $ C.mk6 a1 a2 a3 a4 a5 a6 {-# INLINE mk6 #-} -mk7 :: (Vector v a, Dim v ~ 7) => a -> a -> a -> a -> a -> a -> a -> v a+mk7 :: (Vector v a, Dim v ~ C.N7) => a -> a -> a -> a -> a -> a -> a -> v a mk7 a1 a2 a3 a4 a5 a6 a7 = vector $ C.mk7 a1 a2 a3 a4 a5 a6 a7 {-# INLINE mk7 #-} -mk8 :: (Vector v a, Dim v ~ 8) => a -> a -> a -> a -> a -> a -> a -> a -> v a+mk8 :: (Vector v a, Dim v ~ C.N8) => a -> a -> a -> a -> a -> a -> a -> a -> v a mk8 a1 a2 a3 a4 a5 a6 a7 a8 = vector $ C.mk8 a1 a2 a3 a4 a5 a6 a7 a8 {-# INLINE mk8 #-} @@ -77,14 +69,14 @@ -- -- or using @TypeApplications@ syntax: ----- > v = mkN (Proxy @ (Int,Int,Int)) 1 2 3+-- > v = mkN (Proxy @(Int,Int,Int)) 1 2 3 -- -- or if type of @v@ 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))+ => proxy (v a) -> C.Fn (Dim v) a (v a)+mkN _ = C.unFun (construct :: C.Fun (Dim v) a (v a)) ---------------------------------------------------------------- -- Generic functions@@ -96,14 +88,14 @@ -- -- >>> import Data.Vector.Fixed.Boxed (Vec2) -- >>> replicate 1 :: Vec2 Int--- fromList [1,1]+-- [1,1] -- -- >>> replicate 2 :: (Double,Double,Double) -- (2.0,2.0,2.0) -- -- >>> import Data.Vector.Fixed.Boxed (Vec4) -- >>> replicate "foo" :: Vec4 String--- fromList ["foo","foo","foo","foo"]+-- ["foo","foo","foo","foo"] replicate :: Vector v a => a -> v a {-# INLINE replicate #-} replicate@@ -116,11 +108,11 @@ -- -- >>> import Data.Vector.Fixed.Boxed (Vec2,Vec3) -- >>> replicateM (Just 3) :: Maybe (Vec3 Int)--- Just (fromList [3,3,3])+-- Just [3,3,3] -- >>> replicateM (putStrLn "Hi!") :: IO (Vec2 ()) -- Hi! -- Hi!--- fromList [(),()]+-- [(),()] replicateM :: (Vector v a, Applicative f) => f a -> f (v a) {-# INLINE replicateM #-} replicateM@@ -134,11 +126,11 @@ -- -- >>> import Data.Vector.Fixed.Boxed (Vec3) -- >>> basis 0 :: Vec3 Int--- fromList [1,0,0]+-- [1,0,0] -- >>> basis 1 :: Vec3 Int--- fromList [0,1,0]+-- [0,1,0] -- >>> basis 3 :: Vec3 Int--- fromList [0,0,0]+-- [0,0,0] basis :: (Vector v a, Num a) => Int -> v a {-# INLINE basis #-} basis = vector . C.basis@@ -157,7 +149,7 @@ -- -- >>> import Data.Vector.Fixed.Unboxed (Vec4) -- >>> generate (^2) :: Vec4 Int--- fromList [0,1,4,9]+-- [0,1,4,9] generate :: (Vector v a) => (Int -> a) -> v a {-# INLINE generate #-} generate = vector . C.generate@@ -181,7 +173,7 @@ -- >>> let x = mk3 1 2 3 :: Vec3 Int -- >>> head x -- 1-head :: (Vector v a, 1 <= Dim v) => v a -> a+head :: (Vector v a, Dim v ~ 'S k) => v a -> a {-# INLINE head #-} head = C.head . C.cvec @@ -193,27 +185,25 @@ -- >>> import Data.Complex -- >>> tail (1,2,3) :: Complex Double -- 2.0 :+ 3.0-tail :: (Vector v a, Vector w a, Dim v ~ (Dim w + 1))+tail :: (Vector v a, Vector w a, Dim v ~ 'S (Dim w)) => v a -> w a {-# INLINE tail #-} tail = vector . C.tail . C.cvec -- | Cons element to the vector-cons :: (Vector v a, Vector w a, Dim w ~ (Dim v + 1))+cons :: (Vector v a, Vector w a, Dim w ~ 'S (Dim v)) => 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, Dim w ~ (Dim v + 1))+snoc :: (Vector v a, Vector w a, Dim w ~ 'S (Dim v)) => 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- , (Dim v + Dim u) ~ Dim w- -- Tautology- , C.Peano (Dim v + Dim u) ~ Add (C.Peano (Dim v)) (C.Peano (Dim u))+ , (Dim v `Add` Dim u) ~ Dim w ) => v a -> u a -> w a {-# INLINE concat #-}@@ -228,10 +218,10 @@ -- /O(n)/ but more efficient one is used when possible. (!) :: (Vector v a) => v a -> Int -> a {-# INLINE (!) #-}-v ! n = runIndex n (C.cvec v)+(!) v n = runIndex n (C.cvec v) -- Used in rewriting of index function.-runIndex :: Arity n => Int -> C.ContVec n r -> r+runIndex :: ArityPeano n => Int -> C.ContVec n r -> r runIndex = C.index {-# INLINE[0] runIndex #-} @@ -259,16 +249,18 @@ -- | Get element from vector at statically known index-index :: (Vector v a, KnownNat k, k + 1 <= Dim v)+index :: forall k v a proxy. (Vector v a, Index (Peano k) (Dim v)) => v a -> proxy k -> a {-# INLINE index #-}-index v k = v ! fromIntegral (natVal k)+index v _ = inspect v (C.getF (proxy# @(Peano k))) -- | Set n'th element in the vector-set :: (Vector v a, KnownNat k, k + 1 <= Dim v) => proxy k -> a -> v a -> v a+set :: forall k v a proxy. (Vector v a, Index (Peano k) (Dim v))+ => proxy k -> a -> v a -> v a {-# INLINE set #-}-set k a = runIdentity . element (fromIntegral (natVal k))- (const (Identity a))+set _ a v+ = inspect v+ $ C.putF (proxy# @(Peano k)) a construct -- | Twan van Laarhoven's lens for element of vector element :: (Vector v a, Functor f) => Int -> (a -> f a) -> (v a -> f (v a))@@ -277,10 +269,11 @@ -- | Twan van Laarhoven's lens for element of vector with statically -- known index.-elementTy :: (Vector v a, KnownNat k, k + 1 <= Dim v, Functor f)+elementTy :: forall k v a f proxy. (Vector v a, Index (Peano k) (Dim v), Functor f) => proxy k -> (a -> f a) -> (v a -> f (v a)) {-# INLINE elementTy #-}-elementTy k = element (fromIntegral (natVal k))+elementTy _ f v+ = inspect v (C.lensF (proxy# @(Peano k)) f construct) -- | Left fold over vector foldl :: Vector v a => (b -> a -> b) -> b -> v a -> b@@ -288,6 +281,12 @@ foldl f x = C.foldl f x . C.cvec +-- | Strict left fold over vector+foldl' :: Vector v a => (b -> a -> b) -> b -> v a -> b+{-# INLINE foldl' #-}+foldl' f x = C.foldl' f x+ . C.cvec+ -- | Right fold over vector foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b {-# INLINE foldr #-}@@ -296,7 +295,7 @@ -- | Left fold over vector-foldl1 :: (Vector v a, 1 <= Dim v) => (a -> a -> a) -> v a -> a+foldl1 :: (Vector v a, Dim v ~ 'S k) => (a -> a -> a) -> v a -> a {-# INLINE foldl1 #-} foldl1 f = C.foldl1 f . C.cvec@@ -328,6 +327,13 @@ ifoldl f z = C.ifoldl f z . C.cvec +-- | Strict left fold over vector. Function is applied to each element+-- and its index.+ifoldl' :: Vector v a => (b -> Int -> a -> b) -> b -> v a -> b+{-# INLINE ifoldl' #-}+ifoldl' f z = C.ifoldl' f z+ . C.cvec+ -- | Monadic fold over vector. foldM :: (Vector v a, Monad m) => (b -> a -> m b) -> b -> v a -> m b {-# INLINE foldM #-}@@ -356,7 +362,7 @@ -- >>> let x = mk3 1 2 3 :: Vec3 Int -- >>> maximum x -- 3-maximum :: (Vector v a, 1 <= Dim v, Ord a) => v a -> a+maximum :: (Vector v a, Dim v ~ S k, Ord a) => v a -> a maximum = C.maximum . C.cvec {-# INLINE maximum #-} @@ -368,7 +374,7 @@ -- >>> let x = mk3 1 2 3 :: Vec3 Int -- >>> minimum x -- 1-minimum :: (Vector v a, 1 <= Dim v, Ord a) => v a -> a+minimum :: (Vector v a, Dim v ~ S k, Ord a) => v a -> a minimum = C.minimum . C.cvec {-# INLINE minimum #-} @@ -484,7 +490,7 @@ . C.cvec -- | Left scan over vector-scanl :: (Vector v a, Vector w b, Dim w ~ (Dim v + 1))+scanl :: (Vector v a, Vector w b, Dim w ~ 'S (Dim v)) => (b -> a -> b) -> b -> v a -> w b {-# INLINE scanl #-} scanl f x0 = vector . C.scanl f x0 . C.cvec@@ -499,7 +505,8 @@ sequenceA :: (Vector v a, Vector v (f a), Applicative f) => v (f a) -> f (v a) {-# INLINE sequenceA #-}-sequenceA = fmap vector . T.sequenceA . C.cvec+sequenceA = sequence+{-# DEPRECATED sequenceA "Use sequence instead" #-} -- | Analog of 'T.traverse' from 'T.Traversable'. traverse :: (Vector v a, Vector v b, Applicative f)@@ -531,11 +538,11 @@ -- >>> let b2 = basis 2 :: Vec3 Int -- >>> let vplus x y = zipWith (+) x y -- >>> vplus b0 b1--- fromList [1,1,0]+-- [1,1,0] -- >>> vplus b0 b2--- fromList [1,0,1]+-- [1,0,1] -- >>> vplus b1 b2--- fromList [0,1,1]+-- [0,1,1] zipWith :: (Vector v a, Vector v b, Vector v c) => (a -> b -> c) -> v a -> v b -> v c {-# INLINE zipWith #-}@@ -598,7 +605,7 @@ -- | Zip two vector elementwise using monadic function and discard -- result izipWithM_- :: (Vector v a, Vector v b, Vector v c, Applicative f, Vector v (f c))+ :: (Vector v a, Vector v b, Vector v c, Applicative f) => (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)@@ -612,12 +619,13 @@ defaultAlignemnt _ = alignment (undefined :: a) {-# INLINE defaultAlignemnt #-} + -- | Default implementation of 'sizeOf` for 'Storable' type class for -- fixed vectors defaultSizeOf :: forall a v. (Storable a, Vector v a) => v a -> Int-defaultSizeOf _ = sizeOf (undefined :: a) * C.arity (Proxy :: Proxy (Dim v))+defaultSizeOf _ = sizeOf (undefined :: a) * C.peanoToInt (proxy# @(Dim v)) {-# INLINE defaultSizeOf #-} -- | Default implementation of 'peek' for 'Storable' type class for@@ -676,5 +684,5 @@ -- | Generic definition of 'Prelude.showsPrec' showsPrec :: (Vector v a, Show a) => Int -> v a -> ShowS-showsPrec d v = showParen (d > 10) $ showString "fromList " . Prelude.showsPrec 11 (toList v)+showsPrec _ = shows . toList {-# INLINE showsPrec #-}
+ Data/Vector/Fixed/Mono.hs view
@@ -0,0 +1,981 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-}+module Data.Vector.Fixed.Mono+ ( -- * Vector type class+ Prod(..)+ , Vector+ , Dim+ , C.Arity+ , C.ArityPeano+ , C.Fun(..)+ , length+ -- ** Peano numbers+ , PeanoNum(..)+ , Peano+ , N1, N2, N3, N4, N5, N6, N7, N8+ -- * Construction and destructions+ -- $construction++ -- ** Constructors+ , mk0+ , mk1+ , mk2+ , mk3+ , mk4+ , mk5+ , mk6+ , mk7+ , mk8+ , mkN+ -- ** Pattern synonyms+ , pattern V1+ , pattern V2+ , pattern V3+ , pattern V4+ -- * Functions+ -- ** Creation+ , replicate+ , replicateM+ , generate+ , generateM+ , unfoldr+ , basis+ -- ** Transformations+ , head+ , tail+ , cons+ , snoc+ , concat+ , reverse+ -- ** Indexing & lenses+ , C.Index+ , (!)+ , index+ , set+ , element+ , elementTy+ -- ** Maps+ , map+ , gmap+ , mapM+ , gmapM+ , mapM_+ , imap+ , igmap+ , imapM+ , igmapM+ , imapM_+ , scanl+ , scanl1+ -- , traverse+ -- ** Folds+ , foldl+ , foldl'+ , foldr+ , foldl1+ , fold+ , foldMap+ , ifoldl+ , ifoldl'+ , ifoldr+ , foldM+ , ifoldM+ -- *** Special folds+ , sum+ , maximum+ , minimum+ , and+ , or+ , all+ , any+ , find+ -- ** Zips+ , zipWith+ , zipWith3+ , zipWithM+ , zipWithM_+ , izipWith+ , izipWith3+ , izipWithM+ , izipWithM_+ -- *** Special zips+ , eq+ , ord+ -- ** Conversion+ , convert+ , toList+ , fromList+ , fromList'+ , fromListM+ , fromFoldable+ -- ** Continuation-based vectors+ , C.ContVec+ , vector+ , cvec+ -- * Instance deriving+ , ViaFixed(..)+ ) where++import Control.DeepSeq (NFData(..))+import Control.Monad.Primitive (PrimBase(..))+import Data.Complex+import Data.Foldable qualified as T+import Data.Primitive.Types (Prim(..))+import Foreign.Ptr (castPtr)+import Foreign.Storable (Storable(..))++import GHC.Exts (Proxy#,proxy#,Int(..),Int#,(+#),(*#))+import GHC.ST (ST(..))++import Prelude (Eq(..),Ord(..),Show(..),Num(..),Functor,Applicative,Monad+ ,Semigroup(..),Monoid(..)+ ,Bool,Maybe(..),Ordering+ ,fmap,(<$>),(.),($),shows,flip,undefined+ )++import Data.Vector.Fixed.Compat+import Data.Vector.Fixed.Cont qualified as C+import Data.Vector.Fixed.Cont (Dim,Add,ArityPeano,Peano,Index,PeanoNum(..),+ N1,N2,N3,N4,N5,N6,N7,N8)++++----------------------------------------------------------------+-- Classes+----------------------------------------------------------------+++class C.ArityPeano (Dim v) => Prod a v | v -> a where+ inspect :: v -> C.Fun (Dim v) a r -> r+ construct :: C.Fun (Dim v) a v++class Prod a v => Vector a v++-- | Convert regular vector to continuation based one.+cvec :: (Prod a v) => v -> C.ContVec (Dim v) a+cvec v = C.ContVec (inspect v)+{-# INLINE[0] cvec #-}++-- | Convert continuation to the vector.+vector :: (Prod a v) => C.ContVec (Dim v) a -> v+vector = C.runContVec construct+{-# INLINE[1] vector #-}++{-# RULES+"cvec/vector[mono]" forall v.+ cvec (vector v) = v+ #-}++++----------------------------------------------------------------+-- Constructors+----------------------------------------------------------------++mk0 :: forall v a. (Vector a v, Dim v ~ 'Z) => v+mk0 = vector C.empty+{-# INLINE mk0 #-}++mk1 :: forall v a. (Vector a v, Dim v ~ N1) => a -> v+mk1 a1 = vector $ C.mk1 a1+{-# INLINE mk1 #-}++mk2 :: forall v a. (Vector a v, Dim v ~ N2) => a -> a -> v+mk2 a1 a2 = vector $ C.mk2 a1 a2+{-# INLINE mk2 #-}++mk3 :: forall v a. (Vector a v, Dim v ~ N3) => a -> a -> a -> v+mk3 a1 a2 a3 = vector $ C.mk3 a1 a2 a3+{-# INLINE mk3 #-}++mk4 :: forall v a. (Vector a v, Dim v ~ N4) => a -> a -> a -> a -> v+mk4 a1 a2 a3 a4 = vector $ C.mk4 a1 a2 a3 a4+{-# INLINE mk4 #-}++mk5 :: forall v a. (Vector a v, Dim v ~ N5) => a -> a -> a -> a -> a -> v+mk5 a1 a2 a3 a4 a5 = vector $ C.mk5 a1 a2 a3 a4 a5+{-# INLINE mk5 #-}++mk6 :: forall v a. (Vector a v, Dim v ~ N6) => a -> a -> a -> a -> a -> a -> v+mk6 a1 a2 a3 a4 a5 a6 = vector $ C.mk6 a1 a2 a3 a4 a5 a6+{-# INLINE mk6 #-}++mk7 :: forall v a. (Vector a v, Dim v ~ N7) => a -> a -> a -> a -> a -> a -> a -> v+mk7 a1 a2 a3 a4 a5 a6 a7 = vector $ C.mk7 a1 a2 a3 a4 a5 a6 a7+{-# INLINE mk7 #-}++mk8 :: forall v a. (Vector a v, Dim v ~ N8) => a -> a -> a -> a -> a -> a -> a -> a -> v+mk8 a1 a2 a3 a4 a5 a6 a7 a8 = vector $ C.mk8 a1 a2 a3 a4 a5 a6 a7 a8+{-# INLINE mk8 #-}++-- | 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 :: Proxy (Int,Int,Int)) 1 2 3+--+-- or using @TypeApplications@ syntax:+--+-- > v = mkN (Proxy @(Int,Int,Int)) 1 2 3+--+-- or if type of @v@ is fixed elsewhere+--+-- > v = mkN [v] 1 2 3+mkN :: forall proxy v a. (Vector a v)+ => proxy v -> C.Fn (Dim v) a v+mkN _ = C.unFun (construct :: C.Fun (Dim v) a v)++----------------------------------------------------------------+-- Generic functions+----------------------------------------------------------------++-- | Length of vector. Function doesn't evaluate its argument.+length :: forall v. C.ArityPeano (Dim v) => v -> Int+{-# INLINE length #-}+length _ = C.peanoToInt (proxy# @(Dim v))++-- | Replicate value /n/ times.+--+-- Examples:+--+-- >>> import Data.Vector.Fixed.Boxed (Vec2)+-- >>> replicate 1 :: Vec2 Int+-- [1,1]+--+-- >>> replicate 2 :: (Double,Double,Double)+-- (2.0,2.0,2.0)+--+-- >>> import Data.Vector.Fixed.Boxed (Vec4)+-- >>> replicate "foo" :: Vec4 String+-- ["foo","foo","foo","foo"]+replicate :: forall v a. Vector a v => a -> v+{-# INLINE replicate #-}+replicate+ = vector . C.replicate+++-- | Execute monadic action for every element of vector.+--+-- Examples:+--+-- >>> import Data.Vector.Fixed.Boxed (Vec2,Vec3)+-- >>> replicateM (Just 3) :: Maybe (Vec3 Int)+-- Just [3,3,3]+-- >>> replicateM (putStrLn "Hi!") :: IO (Vec2 ())+-- Hi!+-- Hi!+-- [(),()]+replicateM :: forall v f a. (Vector a v, Applicative f) => f a -> f (v)+{-# INLINE replicateM #-}+replicateM+ = fmap vector . C.replicateM+++-- | Unit vector along Nth axis. If index is larger than vector+-- dimensions returns zero vector.+--+-- Examples:+--+-- >>> import Data.Vector.Fixed.Boxed (Vec3)+-- >>> basis 0 :: Vec3 Int+-- [1,0,0]+-- >>> basis 1 :: Vec3 Int+-- [0,1,0]+-- >>> basis 3 :: Vec3 Int+-- [0,0,0]+basis :: forall v a. (Vector a v, Num a) => Int -> v+{-# INLINE basis #-}+basis = vector . C.basis+++-- | Unfold vector.+unfoldr :: forall v a b. (Vector a v) => (b -> (a,b)) -> b -> v+{-# INLINE unfoldr #-}+unfoldr f = vector . C.unfoldr f+++-- | Generate vector from function which maps element's index to its+-- value.+--+-- Examples:+--+-- >>> import Data.Vector.Fixed.Unboxed (Vec4)+-- >>> generate (^2) :: Vec4 Int+-- [0,1,4,9]+generate :: forall v a. (Vector a v) => (Int -> a) -> v+{-# INLINE generate #-}+generate = vector . C.generate+++-- | Generate vector from monadic function which maps element's index+-- to its value.+generateM :: forall v f a. (Applicative f, Vector a v) => (Int -> f a) -> f v+{-# INLINE generateM #-}+generateM = fmap vector . C.generateM++++----------------------------------------------------------------++-- | First element of vector.+--+-- Examples:+--+-- >>> import Data.Vector.Fixed.Boxed (Vec3)+-- >>> let x = mk3 1 2 3 :: Vec3 Int+-- >>> head x+-- 1+head :: forall v k a. (Vector a v, Dim v ~ 'S k) => v -> a+{-# INLINE head #-}+head = C.head . cvec+++-- | Tail of vector.+--+-- Examples:+--+-- >>> import Data.Complex+-- >>> tail (1,2,3) :: Complex Double+-- 2.0 :+ 3.0+tail :: forall v w a. (Vector a v, Vector a w, Dim v ~ 'S (Dim w))+ => v -> w+{-# INLINE tail #-}+tail = vector . C.tail . cvec++-- | Cons element to the vector+cons :: forall v w a. (Vector a v, Vector a w, Dim w ~ 'S (Dim v))+ => a -> v -> w+{-# INLINE cons #-}+cons a = vector . C.cons a . cvec++-- | Append element to the vector+snoc :: forall v w a. (Vector a v, Vector a w, Dim w ~ 'S (Dim v))+ => a -> v -> w+{-# INLINE snoc #-}+snoc a = vector . C.snoc a . cvec++concat :: forall v u w a.+ ( Vector a v, Vector a u, Vector a w+ , (Dim v `Add` Dim u) ~ Dim w+ )+ => v -> u -> w+{-# INLINE concat #-}+concat v u = vector $ C.concat (cvec v) (cvec u)++-- | Reverse order of elements in the vector+reverse :: forall v a. Vector a v => v -> v+reverse = vector . C.reverse . cvec+{-# INLINE reverse #-}+++-- | Retrieve vector's element at index. Generic implementation is+-- /O(n)/ but more efficient one is used when possible.+(!) :: forall v a. (Vector a v) => v -> Int -> a+{-# INLINE (!) #-}+v ! i = C.index i (cvec v)++-- | Get element from vector at statically known index+index :: forall v k a proxy. (Vector a v, Index (Peano k) (Dim v))+ => v -> proxy k -> a+{-# INLINE index #-}+index v _ = inspect v (C.getF (proxy# @(Peano k)))++-- | Set n'th element in the vector+set :: forall v k a proxy. (Vector a v, Index (Peano k) (Dim v))+ => proxy k -> a -> v -> v+{-# INLINE set #-}+set _ a v+ = inspect v+ $ C.putF (proxy# @(Peano k)) a construct++-- | Twan van Laarhoven's lens for element of vector+element :: forall v f a. (Vector a v, Functor f) => Int -> (a -> f a) -> (v -> f v)+{-# INLINE element #-}+element i f v = vector `fmap` C.element i f (cvec v)++-- | Twan van Laarhoven's lens for element of vector with statically+-- known index.+elementTy+ :: forall v f k a proxy. (Vector a v, Index (Peano k) (Dim v), Functor f)+ => proxy k -> (a -> f a) -> (v -> f v)+{-# INLINE elementTy #-}+elementTy _ f v+ = inspect v (C.lensF (proxy# @(Peano k)) f construct)++-- | Left fold over vector+foldl :: forall v b a. Vector a v => (b -> a -> b) -> b -> v -> b+{-# INLINE foldl #-}+foldl f x = C.foldl f x+ . cvec++-- | Strict left fold over vector+foldl' :: forall v b a. Vector a v => (b -> a -> b) -> b -> v -> b+{-# INLINE foldl' #-}+foldl' f x = C.foldl' f x+ . cvec++-- | Right fold over vector+foldr :: forall v b a. Vector a v => (a -> b -> b) -> b -> v -> b+{-# INLINE foldr #-}+foldr f x = C.foldr f x+ . cvec+++-- | Left fold over vector+foldl1 :: forall v a k. (Vector a v, Dim v ~ 'S k) => (a -> a -> a) -> v -> a+{-# INLINE foldl1 #-}+foldl1 f = C.foldl1 f+ . cvec++-- | Combine the elements of a structure using a monoid. Similar to+-- 'T.fold'+fold :: forall v m. (Vector m v, Monoid m) => v -> m+{-# INLINE fold #-}+fold = T.fold+ . cvec++-- | Map each element of the structure to a monoid,+-- and combine the results. Similar to 'T.foldMap'+foldMap :: forall v m a. (Vector a v, Monoid m) => (a -> m) -> v -> m+{-# INLINE foldMap #-}+foldMap f = T.foldMap f+ . cvec++-- | Right fold over vector+ifoldr :: forall v b a. Vector a v => (Int -> a -> b -> b) -> b -> v -> b+{-# INLINE ifoldr #-}+ifoldr f x = C.ifoldr f x+ . cvec++-- | Left fold over vector. Function is applied to each element and+-- its index.+ifoldl :: forall v b a. Vector a v => (b -> Int -> a -> b) -> b -> v -> b+{-# INLINE ifoldl #-}+ifoldl f z = C.ifoldl f z+ . cvec++-- | Strict left fold over vector. Function is applied to each element+-- and its index.+ifoldl' :: forall v b a. Vector a v => (b -> Int -> a -> b) -> b -> v -> b+{-# INLINE ifoldl' #-}+ifoldl' f z = C.ifoldl' f z+ . cvec++-- | Monadic fold over vector.+foldM :: forall v m b a. (Vector a v, Monad m) => (b -> a -> m b) -> b -> v -> m b+{-# INLINE foldM #-}+foldM f x = C.foldM f x . cvec++-- | Left monadic fold over vector. Function is applied to each element and+-- its index.+ifoldM :: forall v m b a. (Vector a v, Monad m) => (b -> Int -> a -> m b) -> b -> v -> m b+{-# INLINE ifoldM #-}+ifoldM f x = C.ifoldM f x . cvec+++----------------------------------------------------------------++-- | Sum all elements in the vector.+sum :: forall v a. (Vector a v, Num a) => v -> a+sum = C.sum . cvec+{-# INLINE sum #-}++-- | Maximal element of vector.+--+-- Examples:+--+-- >>> import Data.Vector.Fixed.Boxed (Vec3)+-- >>> let x = mk3 1 2 3 :: Vec3 Int+-- >>> maximum x+-- 3+maximum :: forall v a k. (Vector a v, Dim v ~ S k, Ord a) => v -> a+maximum = C.maximum . cvec+{-# INLINE maximum #-}++-- | Minimal element of vector.+--+-- Examples:+--+-- >>> import Data.Vector.Fixed.Boxed (Vec3)+-- >>> let x = mk3 1 2 3 :: Vec3 Int+-- >>> minimum x+-- 1+minimum :: forall v a k. (Vector a v, Dim v ~ S k, Ord a) => v -> a+minimum = C.minimum . cvec+{-# INLINE minimum #-}++-- | Conjunction of all elements of a vector.+and :: forall v. (Vector Bool v) => v -> Bool+and = C.and . cvec+{-# INLINE and #-}++-- | Disjunction of all elements of a vector.+or :: forall v. (Vector Bool v) => v -> Bool+or = C.or . cvec+{-# INLINE or #-}++-- | Determines whether all elements of vector satisfy predicate.+all :: forall v a. (Vector a v) => (a -> Bool) -> v -> Bool+all f = (C.all f) . cvec+{-# INLINE all #-}++-- | Determines whether any of element of vector satisfy predicate.+any :: forall v a. (Vector a v) => (a -> Bool) -> v -> Bool+any f = (C.any f) . cvec+{-# INLINE any #-}++-- | The 'find' function takes a predicate and a vector and returns+-- the leftmost element of the vector matching the predicate,+-- or 'Nothing' if there is no such element.+find :: forall v a. (Vector a v) => (a -> Bool) -> v -> Maybe a+find f = (C.find f) . cvec+{-# INLINE find #-}++----------------------------------------------------------------++-- | Test two vectors for equality.+--+-- Examples:+--+-- >>> import Data.Vector.Fixed.Boxed (Vec2)+-- >>> let v0 = basis 0 :: Vec2 Int+-- >>> let v1 = basis 1 :: Vec2 Int+-- >>> v0 `eq` v0+-- True+-- >>> v0 `eq` v1+-- False+eq :: (Vector a v, Eq a) => v -> v -> Bool+{-# INLINE eq #-}+eq v w = C.and+ $ C.zipWith (==) (cvec v) (cvec w)+++-- | Lexicographic ordering of two vectors.+ord :: (Vector a v, Ord a) => v -> v -> Ordering+{-# INLINE ord #-}+ord v w = C.foldl mappend mempty+ $ C.zipWith compare (cvec v) (cvec w)+++----------------------------------------------------------------++-- | Map over vector+map :: forall v a. (Vector a v) => (a -> a) -> v -> v+{-# INLINE map #-}+map f = vector+ . C.map f+ . cvec++-- | Map over vector+gmap :: forall v w a b. (Vector a v, Vector b w, Dim v ~ Dim w) => (a -> b) -> v -> w+{-# INLINE gmap #-}+gmap f = vector+ . C.map f+ . cvec++-- | Effectful map over vector.+mapM :: forall v f a. (Vector a v, Applicative f) => (a -> f a) -> v -> f v+{-# INLINE mapM #-}+mapM f = fmap vector+ . C.mapM f+ . cvec++-- | Effectful map over vector.+gmapM :: forall v w f a b. (Vector a v, Vector b w, Applicative f, Dim v ~ Dim w)+ => (a -> f b) -> v -> f w+{-# INLINE gmapM #-}+gmapM f = fmap vector+ . C.mapM f+ . cvec++-- | Apply monadic action to each element of vector and ignore result.+mapM_ :: forall v f b a. (Vector a v, Applicative f) => (a -> f b) -> v -> f ()+{-# INLINE mapM_ #-}+mapM_ f = C.mapM_ f+ . cvec+++-- | Apply function to every element of the vector and its index.+imap :: forall v a. (Vector a v) => (Int -> a -> a) -> v -> v+{-# INLINE imap #-}+imap f = vector+ . C.imap f+ . cvec++-- | Apply function to every element of the vector and its index.+igmap :: forall v w a b. (Vector a v, Vector b w, Dim v ~ Dim w)+ => (Int -> a -> b) -> v -> w+{-# INLINE igmap #-}+igmap f = vector+ . C.imap f+ . cvec++-- | Apply monadic function to every element of the vector and its index.+imapM :: forall v f a. (Vector a v, Applicative f)+ => (Int -> a -> f a) -> v -> f v+{-# INLINE imapM #-}+imapM f = fmap vector+ . C.imapM f+ . cvec++-- | Apply monadic function to every element of the vector and its index.+igmapM :: forall v w f a b. (Vector a v, Vector b w, Dim v ~ Dim w, Applicative f)+ => (Int -> a -> f b) -> v -> f w+{-# INLINE igmapM #-}+igmapM f = fmap vector+ . C.imapM f+ . cvec++-- | Apply monadic function to every element of the vector and its+-- index and discard result.+imapM_ :: forall v f b a. (Vector a v, Applicative f) => (Int -> a -> f b) -> v -> f ()+{-# INLINE imapM_ #-}+imapM_ f = C.imapM_ f+ . cvec++-- | Left scan over vector+scanl :: forall v w a b. (Vector a v, Vector b w, Dim w ~ 'S (Dim v))+ => (b -> a -> b) -> b -> v -> w+{-# INLINE scanl #-}+scanl f x0 = vector . C.scanl f x0 . cvec++-- | Left scan over vector+scanl1 :: forall v a. (Vector a v)+ => (a -> a -> a) -> v -> v+{-# INLINE scanl1 #-}+scanl1 f = vector . C.scanl1 f . cvec++++----------------------------------------------------------------++-- | Zip two vector together using function.+--+-- Examples:+--+-- >>> import Data.Vector.Fixed.Boxed (Vec3)+-- >>> let b0 = basis 0 :: Vec3 Int+-- >>> let b1 = basis 1 :: Vec3 Int+-- >>> let b2 = basis 2 :: Vec3 Int+-- >>> let vplus x y = zipWith (+) x y+-- >>> vplus b0 b1+-- [1,1,0]+-- >>> vplus b0 b2+-- [1,0,1]+-- >>> vplus b1 b2+-- [0,1,1]+zipWith :: forall v a. (Vector a v)+ => (a -> a -> a) -> v -> v -> v+{-# INLINE zipWith #-}+zipWith f v u = vector+ $ C.zipWith f (cvec v) (cvec u)++-- | Zip three vector together+zipWith3+ :: forall v a. (Vector a v)+ => (a -> a -> a -> a)+ -> v -> v -> v -> v+{-# INLINE zipWith3 #-}+zipWith3 f v1 v2 v3+ = vector+ $ C.zipWith3 f (cvec v1) (cvec v2) (cvec v3)++-- | Zip two vector together using monadic function.+zipWithM :: forall v f a. (Vector a v, Applicative f)+ => (a -> a -> f a) -> v -> v -> f v+{-# INLINE zipWithM #-}+zipWithM f v u = fmap vector+ $ C.zipWithM f (cvec v) (cvec u)++-- | Zip two vector elementwise using monadic function and discard+-- result+zipWithM_+ :: forall v f b a. (Vector a v, Applicative f)+ => (a -> a -> f b) -> v -> v -> f ()+{-# INLINE zipWithM_ #-}+zipWithM_ f xs ys = C.zipWithM_ f (cvec xs) (cvec ys)++-- | Zip two vector together using function which takes element index+-- as well.+izipWith :: forall v a. (Vector a v)+ => (Int -> a -> a -> a) -> v -> v -> v+{-# INLINE izipWith #-}+izipWith f v u = vector+ $ C.izipWith f (cvec v) (cvec u)++-- | Zip three vector together+izipWith3+ :: forall v a. (Vector a v)+ => (Int -> a -> a -> a -> a)+ -> v -> v -> v+ -> v+{-# INLINE izipWith3 #-}+izipWith3 f v1 v2 v3+ = vector+ $ C.izipWith3 f (cvec v1) (cvec v2) (cvec v3)++-- | Zip two vector together using monadic function which takes element+-- index as well..+izipWithM :: forall v f a. (Vector a v, Applicative f)+ => (Int -> a -> a -> f a) -> v -> v -> f v+{-# INLINE izipWithM #-}+izipWithM f v u = fmap vector+ $ C.izipWithM f (cvec v) (cvec u)++-- | Zip two vector elementwise using monadic function and discard+-- result+izipWithM_+ :: forall v f b a. (Vector a v, Applicative f)+ => (Int -> a -> a -> f b) -> v -> v -> f ()+{-# INLINE izipWithM_ #-}+izipWithM_ f xs ys = C.izipWithM_ f (cvec xs) (cvec ys)+++----------------------------------------------------------------++-- | Convert between different vector types+convert :: forall v w a. (Vector a v, Vector a w, Dim v ~ Dim w) => v -> w+{-# INLINE convert #-}+convert = vector . cvec++-- | Convert vector to the list+toList :: forall v a. (Vector a v) => v -> [a]+toList = foldr (:) []+{-# INLINE toList #-}++-- | Create vector form list. Will throw error if list is shorter than+-- resulting vector.+fromList :: forall v a. (Vector a v) => [a] -> v+{-# INLINE fromList #-}+fromList = vector . C.fromList++-- | Create vector form list. Will throw error if list has different+-- length from resulting vector.+fromList' :: forall v a. (Vector a v) => [a] -> v+{-# INLINE fromList' #-}+fromList' = vector . C.fromList'++-- | Create vector form list. Will return @Nothing@ if list has different+-- length from resulting vector.+fromListM :: forall v a. (Vector a v) => [a] -> Maybe v+{-# INLINE 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.+fromFoldable :: forall v f a. (Vector a v, T.Foldable f) => f a -> Maybe v+{-# INLINE fromFoldable #-}+fromFoldable = fromListM . T.toList+++++----------------------------------------------------------------+--+----------------------------------------------------------------++-- | Newtype for deriving instances.+newtype ViaFixed a v = ViaFixed v++instance (Prod a v) => Prod a (ViaFixed a v) where+ inspect (ViaFixed v) = inspect v+ construct = ViaFixed <$> construct+instance (Prod a v) => Vector a (ViaFixed a v)++type instance Dim (ViaFixed a v) = Dim v++instance (Prod a v, Show a) => Show (ViaFixed a v) where+ showsPrec _ = shows . toList++instance (Prod a v, Eq a) => Eq (ViaFixed a v) where+ (==) = eq+ {-# INLINE (==) #-}++instance (Prod a v, Ord a) => Ord (ViaFixed a v) where+ compare = ord+ {-# INLINE compare #-}++instance (Prod a v, NFData a) => NFData (ViaFixed a v) where+ rnf = foldl (\() a -> rnf a) ()+ {-# INLINE rnf #-}++instance (Prod a v, Semigroup a) => Semigroup (ViaFixed a v) where+ (<>) = zipWith (<>)+ {-# INLINE (<>) #-}++instance (Prod a v, Monoid a) => Monoid (ViaFixed a v) where+ mempty = replicate mempty+ {-# INLINE mempty #-}++instance (Prod a v, Storable a) => Storable (ViaFixed a v) where+ alignment _ = alignment (undefined :: a)+ sizeOf _ = sizeOf (undefined :: a) * C.peanoToInt (proxy# @(Dim v))+ peek p = generateM (peekElemOff (castPtr p))+ poke p = imapM_ (pokeElemOff (castPtr p))+ {-# INLINE alignment #-}+ {-# INLINE sizeOf #-}+ {-# INLINE peek #-}+ {-# INLINE poke #-}++instance (Prod a v, Prim a) => Prim (ViaFixed a v) where+ sizeOf# _ = sizeOf# (undefined :: a) *# dim where+ dim = case C.peanoToInt (proxy# @(Dim v)) of I# i -> i+ alignment# _ = alignment# (undefined :: a)+ {-# INLINE sizeOf# #-}+ {-# INLINE alignment# #-}+ -- Bytearray+ indexByteArray# ba k+ = generate $ \(I# i) -> indexByteArray# ba (off +# i)+ where+ off = vectorOff (proxy# @(Dim v)) k+ readByteArray# ba k+ = internal+ $ generateM+ $ \(I# i) -> ST (\s -> readByteArray# ba (off +# i) s)+ where+ off = vectorOff (proxy# @(Dim v)) k+ writeByteArray# ba k vec =+ case loop of+ ST st -> \s -> case st s of+ (# s', () #) -> s'+ where+ off = vectorOff (proxy# @(Dim v)) k+ loop = flip imapM_ vec $ \(I# i) a -> ST $ \s ->+ (# writeByteArray# ba (off +# i) a s, () #)+ {-# INLINE indexByteArray# #-}+ {-# INLINE readByteArray# #-}+ {-# INLINE writeByteArray# #-}+ -- Addr+ indexOffAddr# addr k+ = generate $ \(I# i) -> indexOffAddr# addr (off +# i)+ where+ off = vectorOff (proxy# @(Dim v)) k+ readOffAddr# ba k+ = internal+ $ generateM+ $ \(I# i) -> ST (\s -> readOffAddr# ba (off +# i) s)+ where+ off = vectorOff (proxy# @(Dim v)) k+ writeOffAddr# addr k vec =+ case loop of+ ST st -> \s -> case st s of+ (# s', () #) -> s'+ where+ off = vectorOff (proxy# @(Dim v)) k+ loop = flip imapM_ vec $ \(I# i) a -> ST $ \s ->+ (# writeOffAddr# addr (off +# i) a s, () #)+ {-# INLINE indexOffAddr# #-}+ {-# INLINE readOffAddr# #-}+ {-# INLINE writeOffAddr# #-}+++vectorOff :: (ArityPeano n) => Proxy# n -> Int# -> Int#+{-# INLINE vectorOff #-}+vectorOff n k =+ case C.peanoToInt n of+ I# dim -> dim *# k++----------------------------------------------------------------+-- Patterns+----------------------------------------------------------------++pattern V1 :: (Vector a v, Dim v ~ N1) => a -> v+pattern V1 x <- (head -> x) where+ V1 x = mk1 x+{-# INLINE V1 #-}+{-# COMPLETE V1 #-}++pattern V2 :: (Vector a v, Dim v ~ N2) => a -> a -> v+pattern V2 x y <- (convert -> (x,y)) where+ V2 x y = mk2 x y+{-# INLINE V2 #-}+{-# COMPLETE V2 #-}++pattern V3 :: (Vector a v, Dim v ~ N3) => a -> a -> a -> v+pattern V3 x y z <- (convert -> (x,y,z)) where+ V3 x y z = mk3 x y z+{-# INLINE V3 #-}+{-# COMPLETE V3 #-}++pattern V4 :: (Vector a v, Dim v ~ N4) => a -> a -> a -> a -> v+pattern V4 t x y z <- (convert -> (t,x,y,z)) where+ V4 t x y z = mk4 t x y z+{-# INLINE V4 #-}+{-# COMPLETE V4 #-}++----------------------------------------------------------------+-- Instances+----------------------------------------------------------------++instance (ArityPeano n) => Prod a (C.ContVec n a) where+ inspect = C.inspect+ construct = C.construct+ {-# INLINE inspect #-}+ {-# INLINE construct #-}+instance (ArityPeano n) => Vector a (C.ContVec n a) where++instance Prod a (Complex a) where+ inspect (r :+ i) (C.Fun f) = f r i+ construct = C.Fun (:+)+ {-# INLINE inspect #-}+ {-# INLINE construct #-}+instance Vector a (Complex a)++instance (a1 ~ a2) => Prod a1 (a1, a2) where+ inspect (a1, a2) (C.Fun f) = f a1 a2+ construct = C.Fun (,)+ {-# INLINE inspect #-}+ {-# INLINE construct #-}++instance (a1 ~ a2, a2 ~ a3) => Prod a1 (a1, a2, a3) where+ inspect (a1, a2, a3) (C.Fun f) = f a1 a2 a3+ construct = C.Fun (,,)+ {-# INLINE inspect #-}+ {-# INLINE construct #-}++instance (a1 ~ a2, a2 ~ a3, a3 ~ a4) => Prod a1 (a1, a2, a3, a4) where+ inspect (a1, a2, a3, a4) (C.Fun f) = f a1 a2 a3 a4+ construct = C.Fun (,,,)+ {-# INLINE inspect #-}+ {-# INLINE construct #-}++instance (a1 ~ a2, a2 ~ a3, a3 ~ a4, a4 ~ a5) => Prod a1 (a1, a2, a3, a4, a5) where+ inspect (a1, a2, a3, a4, a5) (C.Fun f) = f a1 a2 a3 a4 a5+ construct = C.Fun (,,,,)+ {-# INLINE inspect #-}+ {-# INLINE construct #-}++instance (a1 ~ a2, a2 ~ a3, a3 ~ a4, a4 ~ a5, a5 ~ a6+ ) => Prod a1 (a1, a2, a3, a4, a5, a6) where+ inspect (a1, a2, a3, a4, a5, a6) (C.Fun f) = f a1 a2 a3 a4 a5 a6+ construct = C.Fun (,,,,,)+ {-# INLINE inspect #-}+ {-# INLINE construct #-}++instance (a1 ~ a2, a2 ~ a3, a3 ~ a4, a4 ~ a5, a5 ~ a6, a6 ~ a7+ ) => Prod a1 (a1, a2, a3, a4, a5, a6, a7) where+ inspect (a1, a2, a3, a4, a5, a6, a7) (C.Fun f) = f a1 a2 a3 a4 a5 a6 a7+ construct = C.Fun (,,,,,,)+ {-# INLINE inspect #-}+ {-# INLINE construct #-}++++instance (a1 ~ a2) => Vector a1 (a1, a2)+instance (a1 ~ a2, a2 ~ a3) => Vector a1 (a1, a2, a3)+instance (a1 ~ a2, a2 ~ a3, a3 ~ a4) => Vector a1 (a1, a2, a3, a4)+instance (a1 ~ a2, a2 ~ a3, a3 ~ a4, a4 ~ a5) => Vector a1 (a1, a2, a3, a4, a5)+instance (a1 ~ a2, a2 ~ a3, a3 ~ a4, a4 ~ a5, a5 ~ a6+ ) => Vector a1 (a1, a2, a3, a4, a5, a6)+instance (a1 ~ a2, a2 ~ a3, a3 ~ a4, a4 ~ a5, a5 ~ a6, a6 ~ a7+ ) => Vector a1 (a1, a2, a3, a4, a5, a6, a7)+++-- $setup+--+-- >>> import Data.Char+-- >>> import Prelude (Int,Bool(..),Double,IO,(^),String,putStrLn)+
Data/Vector/Fixed/Mutable.hs view
@@ -1,10 +1,5 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PolyKinds #-} -- | -- 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@@ -12,14 +7,17 @@ module Data.Vector.Fixed.Mutable ( -- * Mutable vectors Arity- , arity , Mutable , DimM , MVector(..) , lengthM+ , new+ , clone+ , copy , read , write- , clone+ , unsafeRead+ , unsafeWrite -- * Creation , replicate , replicateM@@ -32,6 +30,7 @@ , index , freeze , thaw+ , unsafeFreeze -- * Vector API , constructVec , inspectVec@@ -40,13 +39,14 @@ import Control.Applicative (Const(..)) import Control.Monad.ST import Control.Monad.Primitive-import Data.Typeable (Proxy(..)) import Data.Kind (Type)-import GHC.TypeLits-import Data.Vector.Fixed.Cont (Dim,PeanoNum(..),Peano,Arity,Fun(..),Vector(..),ContVec,arity,apply,accum,length) import Prelude hiding (read,length,replicate)+import GHC.Exts (proxy#) +import Data.Vector.Fixed.Cont (Dim,PeanoNum(..),Arity,ArityPeano(..),Fun(..),Vector(..),+ ContVec,apply,accum,length) + ---------------------------------------------------------------- -- Type classes ----------------------------------------------------------------@@ -55,34 +55,60 @@ type family Mutable (v :: Type -> Type) :: Type -> Type -> Type -- | Dimension for mutable vector.-type family DimM (v :: Type -> Type -> Type) :: Nat+type family DimM (v :: Type -> Type -> Type) :: PeanoNum -- | Type class for mutable vectors.-class (Arity (DimM v)) => MVector v a where- -- | 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- => v (PrimState m) a -- ^ Target- -> v (PrimState m) a -- ^ Source- -> m ()- -- | Copy vector. The two vectors may overlap. Since vectors' length- -- is encoded in the type there is no need in runtime checks.- move :: PrimMonad m- => v (PrimState m) a -- ^ Target- -> v (PrimState m) a -- ^ Source- -> m ()- -- | Allocate new vector- new :: PrimMonad m => m (v (PrimState m) a)- -- | Read value at index without bound checks.- unsafeRead :: PrimMonad m => v (PrimState m) a -> Int -> m a- -- | Write value at index without bound checks.- unsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m ()-+class (ArityPeano (DimM v)) => MVector v a where+ -- | Copy vector. The two vectors may not overlap. Shouldn't be used+ -- directly, use 'copy' instead.+ basicCopy :: v s a -- ^ Target+ -> v s a -- ^ Source+ -> ST s ()+ -- | Allocate new uninitialized vector. Shouldn't be used+ -- directly, use 'new' instead.+ basicNew :: ST s (v s a)+ -- | Allocate new vector initialized with given element. Shouldn't be used+ -- directly, use 'replicate' instead.+ basicReplicate :: a -> ST s (v s a)+ {-# INLINE basicReplicate #-}+ basicReplicate a = do+ v <- basicNew+ forI v $ \i -> basicUnsafeWrite v i a+ pure v+ -- | Create copy of existing vector. Shouldn't be used+ -- directly, use 'clone' instead.+ basicClone :: v s a -> ST s (v s a)+ {-# INLINE basicClone #-}+ basicClone src = do+ dst <- basicNew+ basicCopy dst src+ pure src+ -- | Read value at index without bound checks. Shouldn't be used+ -- directly, use 'unsafeRead' instead.+ basicUnsafeRead :: v s a -> Int -> ST s a+ -- | Write value at index without bound checks. Shouldn't be used+ -- directly, use 'unsafeWrite' instead.+ basicUnsafeWrite :: v s a -> Int -> a -> ST s () -- | Length of mutable vector. Function doesn't evaluate its argument.-lengthM :: forall v s a. (Arity (DimM v)) => v s a -> Int-lengthM _ = arity (Proxy :: Proxy (DimM v))+lengthM :: forall v s a. (ArityPeano (DimM v)) => v s a -> Int+lengthM _ = peanoToInt (proxy# @(DimM v)) +-- | Create new uninitialized mutable vector.+new :: (MVector v a, PrimMonad m) => m (v (PrimState m) a)+new = stToPrim basicNew+{-# INLINE new #-}++-- | Copy vector. The two vectors may not overlap. Since vectors'+-- length is encoded in the type there is no need in runtime+-- checks of length.+copy :: (MVector v a, PrimMonad m)+ => v (PrimState m) a -- ^ Target+ -> v (PrimState m) a -- ^ Source+ -> m ()+{-# INLINE copy #-}+copy tgt src = stToPrim $ basicCopy tgt src+ -- | Create copy of vector. -- -- Examples:@@ -93,14 +119,21 @@ -- >>> import qualified Data.Vector.Fixed.Mutable as M -- >>> let x = runST (do { v <- M.replicate 100; v' <- clone v; M.write v' 0 2; M.unsafeFreeze v' }) :: Vec3 Int -- >>> x--- fromList [2,100,100]+-- [2,100,100] clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a) {-# INLINE clone #-}-clone v = do- u <- new- move u v- return u+clone = stToPrim . basicClone +-- | Read value at index without bound checks.+unsafeRead :: (MVector v a, PrimMonad m) => v (PrimState m) a -> Int -> m a+{-# INLINE unsafeRead #-}+unsafeRead v i = stToPrim $ basicUnsafeRead v i++-- | Write value at index without bound checks.+unsafeWrite :: (MVector v a, PrimMonad m) => v (PrimState m) a -> Int -> a -> m ()+{-# INLINE unsafeWrite #-}+unsafeWrite v i a = stToPrim $ basicUnsafeWrite v i a+ -- | Read value at index with bound checks. read :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a {-# INLINE read #-}@@ -119,10 +152,7 @@ -- | Create new vector with all elements set to given value. replicate :: (PrimMonad m, MVector v a) => a -> m (v (PrimState m) a) {-# INLINE replicate #-}-replicate a = do- v <- new- forI v $ \i -> unsafeWrite v i a- pure v+replicate = stToPrim . basicReplicate -- | Create new vector with all elements are generated by provided -- monadic action.@@ -167,37 +197,19 @@ class (Dim v ~ DimM (Mutable v), MVector (Mutable v) a) => IVector v a where -- | Convert vector to immutable state. Mutable vector must not be -- modified afterwards.- unsafeFreeze :: PrimMonad m => Mutable v (PrimState m) a -> m (v a)- -- | /O(1)/ Unsafely convert immutable vector to mutable without- -- copying. Note that this is a very dangerous function and- -- generally it's only safe to read from the resulting vector. In- -- this case, the immutable vector could be used safely as well.- --- -- Problems with mutation happen because GHC has a lot of freedom to- -- introduce sharing. As a result mutable vectors produced by- -- @unsafeThaw@ may or may not share the same underlying buffer. For- -- example:- --- -- > foo = do- -- > let vec = F.generate 10 id- -- > mvec <- M.unsafeThaw vec- -- > do_something mvec- --- -- Here GHC could lift @vec@ outside of foo which means that all calls to- -- @do_something@ will use same buffer with possibly disastrous- -- results. Whether such aliasing happens or not depends on the program in- -- question, optimization levels, and GHC flags.- --- -- All in all, attempts to modify a vector produced by @unsafeThaw@- -- fall out of domain of software engineering and into realm of- -- black magic, dark rituals, and unspeakable horrors. The only- -- advice that could be given is: "Don't attempt to mutate a vector- -- produced by @unsafeThaw@ unless you know how to prevent GHC from- -- aliasing buffers accidentally. We don't."- unsafeThaw :: PrimMonad m => v a -> m (Mutable v (PrimState m) a)+ basicUnsafeFreeze :: Mutable v s a -> ST s (v a)+ -- | Convert immutable vector to mutable by copying it.+ basicThaw :: v a -> ST s (Mutable v s a) -- | Get element at specified index without bounds check. unsafeIndex :: v a -> Int -> a ++-- | Convert vector to immutable state. Mutable vector must not be+-- modified afterwards.+unsafeFreeze :: (IVector v a, PrimMonad m) => Mutable v (PrimState m) a -> m (v a)+{-# INLINE unsafeFreeze #-}+unsafeFreeze = stToPrim . basicUnsafeFreeze+ index :: IVector v a => v a -> Int -> a {-# INLINE index #-} index v i | i < 0 || i >= length v = error "Data.Vector.Fixed.Mutable.!: index out of bounds"@@ -212,7 +224,7 @@ -- | Safely convert immutable vector to mutable. thaw :: (PrimMonad m, IVector v a) => v a -> m (Mutable v (PrimState m) a) {-# INLINE thaw #-}-thaw v = clone =<< unsafeThaw v+thaw = stToPrim . basicThaw @@ -221,22 +233,22 @@ ---------------------------------------------------------------- -- | Generic inspect implementation for array-based vectors.-inspectVec :: forall v a b. (Arity (Dim v), IVector v a) => v a -> Fun (Peano (Dim v)) a b -> b+inspectVec :: forall v a b. (ArityPeano (Dim v), IVector v a) => v a -> Fun (Dim v) a b -> b {-# INLINE inspectVec #-} inspectVec v = 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 0 :: Const Int (Dim v)) -- | Generic construct implementation for array-based vectors.-constructVec :: forall v a. (Arity (Dim v), IVector v a) => Fun (Peano (Dim v)) a (v a)+constructVec :: forall v a. (ArityPeano (Dim v), IVector v a) => Fun (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 (Peano (Dim v)))+ (T_new 0 new :: T_new v a (Dim v)) data T_new v a n = T_new Int (forall s. ST s (Mutable v s a))
Data/Vector/Fixed/Primitive.hs view
@@ -1,12 +1,6 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-} -- | -- Unboxed vectors with fixed length. Vectors from -- "Data.Vector.Fixed.Unboxed" provide more flexibility at no@@ -32,17 +26,19 @@ import Data.Semigroup (Semigroup(..)) import Data.Primitive.ByteArray import Data.Primitive-import qualified Foreign.Storable as Foreign (Storable(..))+import Data.Kind (Type)+import Foreign.Storable (Storable) import GHC.TypeLits+import GHC.Exts (proxy#) import Prelude (Show(..),Eq(..),Ord(..),Num(..))-import Prelude (($),($!),undefined,seq)+import Prelude (($),($!),undefined,seq,(<$>)) import Data.Vector.Fixed hiding (index)-import Data.Vector.Fixed.Mutable (Mutable, MVector(..), IVector(..), DimM, constructVec, inspectVec, arity, index)+import Data.Vector.Fixed.Mono qualified as FM+import Data.Vector.Fixed.Mutable (Mutable, MVector(..), IVector(..), DimM, constructVec, inspectVec, index) import qualified Data.Vector.Fixed.Cont as C-import qualified Data.Vector.Fixed.Internal as I-+import Data.Vector.Fixed.Cont (ArityPeano(..)) ----------------------------------------------------------------@@ -50,62 +46,59 @@ ---------------------------------------------------------------- -- | Unboxed vector with fixed length-newtype Vec (n :: Nat) a = Vec ByteArray+newtype Vec (n :: Nat) (a :: Type) = Vec ByteArray -- | Mutable unboxed vector with fixed length newtype MVec (n :: Nat) s a = MVec (MutableByteArray s) -deriving instance Typeable Vec-deriving instance Typeable MVec- type Vec1 = Vec 1 type Vec2 = Vec 2 type Vec3 = Vec 3 type Vec4 = Vec 4 type Vec5 = Vec 5 +type instance Mutable (Vec n) = MVec n+type instance Dim (Vec n) = Peano n+type instance Dim (Vec n a) = Peano n+type instance DimM (MVec n) = Peano n ---------------------------------------------------------------- -- Instances ---------------------------------------------------------------- -instance (Arity n, Prim a, Show a) => Show (Vec n a) where- showsPrec = I.showsPrec- instance (Arity n, Prim a, NFData a) => NFData (Vec n a) where- rnf = foldl (\r a -> r `seq` rnf a) ()- {-# INLINE rnf #-}+ rnf x = seq x () -type instance Mutable (Vec n) = MVec n+deriving via ViaFixed (Vec n) a instance (Arity n, Prim a, Show a) => Show (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Prim a, Eq a) => Eq (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Prim a, Ord a) => Ord (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Prim a, Semigroup a) => Semigroup (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Prim a, Monoid a) => Monoid (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Prim a, Storable a) => Storable (Vec n a)+-- | @since 2.0.1.0+deriving via ViaFixed (Vec n) a instance (Arity n, Prim a) => Prim (Vec n a) instance (Arity n, Prim a) => MVector (MVec n) a where- new = do- v <- newByteArray $! arity (Proxy :: Proxy n)+ basicNew = do+ v <- newByteArray $! peanoToInt (proxy# @(Peano n)) * sizeOf (undefined :: a) return $ MVec v- {-# INLINE new #-}- copy = move- {-# INLINE copy #-}- 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 #-}- unsafeWrite (MVec v) i x = writeByteArray v i x- {-# INLINE unsafeWrite #-}+ {-# INLINE basicNew #-}+ basicCopy (MVec dst) (MVec src) = copyMutableByteArray dst 0 src 0 (peanoToInt (proxy# @(Peano n)))+ {-# INLINE basicCopy #-}+ basicUnsafeRead (MVec v) i = readByteArray v i+ {-# INLINE basicUnsafeRead #-}+ basicUnsafeWrite (MVec v) i x = writeByteArray v i x+ {-# INLINE basicUnsafeWrite #-} instance (Arity n, Prim a) => IVector (Vec n) a where- unsafeFreeze (MVec v) = do { a <- unsafeFreezeByteArray v; return $! Vec a }- unsafeThaw (Vec v) = do { a <- unsafeThawByteArray v; return $! MVec a }- unsafeIndex (Vec v) i = indexByteArray v i- {-# INLINE unsafeFreeze #-}- {-# INLINE unsafeThaw #-}- {-# INLINE unsafeIndex #-}----type instance Dim (Vec n) = n-type instance DimM (MVec n) = n+ basicUnsafeFreeze (MVec v) = do { a <- unsafeFreezeByteArray v; return $! Vec a }+ basicThaw (Vec v) = MVec <$> thawByteArray v 0 (peanoToInt (proxy# @(Peano n)))+ unsafeIndex (Vec v) i = indexByteArray v i+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicThaw #-}+ {-# INLINE unsafeIndex #-} instance (Arity n, Prim a) => Vector (Vec n) a where construct = constructVec@@ -114,25 +107,12 @@ {-# INLINE construct #-} {-# INLINE inspect #-} {-# INLINE basicIndex #-}-instance (Arity n, Prim a) => VectorN Vec n a--instance (Arity n, Prim a, Eq a) => Eq (Vec n a) where- (==) = eq- {-# INLINE (==) #-}-instance (Arity n, Prim a, Ord a) => Ord (Vec n a) where- compare = ord- {-# INLINE compare #-}--instance (Arity n, Prim a, Monoid a) => Monoid (Vec n a) where- mempty = replicate mempty- mappend = (<>)- {-# INLINE mempty #-}- {-# INLINE mappend #-}--instance (Arity n, Prim a, Semigroup a) => Semigroup (Vec n a) where- (<>) = zipWith (<>)- {-# INLINE (<>) #-}-+instance (Arity n, Prim a) => FM.Prod a (Vec n a) where+ construct = constructVec+ inspect = inspectVec+ {-# INLINE construct #-}+ {-# INLINE inspect #-}+instance (Arity n, Prim a) => FM.Vector a (Vec n a) instance (Typeable n, Arity n, Prim a, Data a) => Data (Vec n a) where gfoldl = C.gfoldl@@ -145,13 +125,3 @@ con_Vec :: Constr con_Vec = mkConstr ty_Vec "Vec" [] Prefix--instance (Foreign.Storable a, Prim a, Arity n) => Foreign.Storable (Vec n a) where- alignment = defaultAlignemnt- sizeOf = defaultSizeOf- peek = defaultPeek- poke = defaultPoke- {-# INLINE alignment #-}- {-# INLINE sizeOf #-}- {-# INLINE peek #-}- {-# INLINE poke #-}
Data/Vector/Fixed/Storable.hs view
@@ -1,12 +1,6 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-} -- | -- Storable-based unboxed vectors. module Data.Vector.Fixed.Storable (@@ -32,20 +26,24 @@ import Data.Monoid (Monoid(..)) import Data.Semigroup (Semigroup(..)) import Data.Data+import Data.Primitive.Types (Prim) import Foreign.Ptr (castPtr) import Foreign.Storable-import Foreign.ForeignPtr import Foreign.Marshal.Array ( copyArray, moveArray )-import GHC.ForeignPtr ( ForeignPtr(..), mallocPlainForeignPtrBytes )+import GHC.ForeignPtr ( mallocPlainForeignPtrBytes ) import GHC.Ptr ( Ptr(..) )+import GHC.Exts ( proxy# ) import GHC.TypeLits+import GHC.ForeignPtr ( unsafeWithForeignPtr )+import Foreign.ForeignPtr ( ForeignPtr, withForeignPtr ) import Prelude ( Show(..),Eq(..),Ord(..),Num(..),Monad(..),IO,Int- , ($),undefined,seq)+ , ($),undefined,seq,pure) import Data.Vector.Fixed hiding (index)-import Data.Vector.Fixed.Mutable (Mutable, MVector(..), IVector(..), DimM, constructVec, inspectVec, arity, index)+import Data.Vector.Fixed.Mono qualified as FM+import Data.Vector.Fixed.Mutable (Mutable, MVector(..), IVector(..), DimM, constructVec, inspectVec, index, new,unsafeFreeze) import qualified Data.Vector.Fixed.Cont as C-import qualified Data.Vector.Fixed.Internal as I+import Data.Vector.Fixed.Cont (ArityPeano(..)) @@ -59,15 +57,16 @@ -- | Storable-based mutable vector with fixed length newtype MVec (n :: Nat) s a = MVec (ForeignPtr a) -deriving instance Typeable Vec-deriving instance Typeable MVec- type Vec1 = Vec 1 type Vec2 = Vec 2 type Vec3 = Vec 3 type Vec4 = Vec 4 type Vec5 = Vec 5 +type instance Mutable (Vec n) = MVec n+type instance Dim (Vec n) = Peano n+type instance Dim (Vec n a) = Peano n+type instance DimM (MVec n) = Peano n ----------------------------------------------------------------@@ -84,9 +83,11 @@ {-# INLINE unsafeFromForeignPtr #-} unsafeFromForeignPtr = Vec +-- | Pass pointer to the vector's data to the IO action. The data may+-- not be modified through the 'Ptr. unsafeWith :: (Ptr a -> IO b) -> Vec n a -> IO b {-# INLINE unsafeWith #-}-unsafeWith f (Vec fp) = f (getPtr fp)+unsafeWith f (Vec fp) = withForeignPtr fp f @@ -94,55 +95,47 @@ -- Instances ---------------------------------------------------------------- -instance (Arity n, Storable a, Show a) => Show (Vec n a) where- showsPrec = I.showsPrec- instance (Arity n, Storable a, NFData a) => NFData (Vec n a) where- rnf = foldl (\r a -> r `seq` rnf a) ()- {-# INLINE rnf #-}+ rnf x = seq x () -type instance Mutable (Vec n) = MVec n+deriving via ViaFixed (Vec n) a instance (Arity n, Storable a, Show a) => Show (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Storable a, Eq a) => Eq (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Storable a, Ord a) => Ord (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Storable a, Semigroup a) => Semigroup (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Storable a, Monoid a) => Monoid (Vec n a) instance (Arity n, Storable a) => MVector (MVec n) a where- new = unsafePrimToPrim $ do- fp <- mallocVector $ arity (Proxy :: Proxy n)+ basicNew = unsafePrimToPrim $ do+ fp <- mallocVector (peanoToInt (proxy# @(Peano n))) return $ MVec fp- {-# INLINE new #-}- copy (MVec fp) (MVec fq)- = unsafePrimToPrim- $ withForeignPtr fp $ \p ->- withForeignPtr fq $ \q ->- copyArray p q (arity (Proxy :: Proxy n))- {-# INLINE copy #-}- move (MVec fp) (MVec fq)+ {-# INLINE basicNew #-}+ basicCopy (MVec fp) (MVec fq) = unsafePrimToPrim- $ withForeignPtr fp $ \p ->- withForeignPtr fq $ \q ->- moveArray p q (arity (Proxy :: Proxy n))- {-# INLINE move #-}- unsafeRead (MVec fp) i+ $ unsafeWithForeignPtr fp $ \p ->+ unsafeWithForeignPtr fq $ \q ->+ copyArray p q (peanoToInt (proxy# @(Peano n)))+ {-# INLINE basicCopy #-}+ basicUnsafeRead (MVec fp) i = unsafePrimToPrim- $ withForeignPtr fp (`peekElemOff` i)- {-# INLINE unsafeRead #-}- unsafeWrite (MVec fp) i x+ $ unsafeWithForeignPtr fp (`peekElemOff` i)+ {-# INLINE basicUnsafeRead #-}+ basicUnsafeWrite (MVec fp) i x = unsafePrimToPrim- $ withForeignPtr fp $ \p -> pokeElemOff p i x- {-# INLINE unsafeWrite #-}-+ $ unsafeWithForeignPtr fp $ \p -> pokeElemOff p i x+ {-# INLINE basicUnsafeWrite #-} instance (Arity n, Storable a) => IVector (Vec n) a where- unsafeFreeze (MVec fp) = return $ Vec fp- unsafeThaw (Vec fp) = return $ MVec fp+ basicUnsafeFreeze (MVec fp) = return $ Vec fp+ basicThaw (Vec fp) = do+ mv <- basicNew+ basicCopy mv (MVec fp)+ pure mv unsafeIndex (Vec fp) i = unsafeInlineIO- $ withForeignPtr fp (`peekElemOff` i)- {-# INLINE unsafeFreeze #-}- {-# INLINE unsafeThaw #-}- {-# INLINE unsafeIndex #-}---type instance Dim (Vec n) = n-type instance DimM (MVec n) = n+ $ unsafeWithForeignPtr fp (`peekElemOff` i)+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicThaw #-}+ {-# INLINE unsafeIndex #-} instance (Arity n, Storable a) => Vector (Vec n) a where construct = constructVec@@ -151,38 +144,28 @@ {-# INLINE construct #-} {-# INLINE inspect #-} {-# INLINE basicIndex #-}-instance (Arity n, Storable a) => VectorN Vec n a--instance (Arity n, Storable a, Eq a) => Eq (Vec n a) where- (==) = eq- {-# INLINE (==) #-}-instance (Arity n, Storable a, Ord a) => Ord (Vec n a) where- compare = ord- {-# INLINE compare #-}--instance (Arity n, Storable a, Monoid a) => Monoid (Vec n a) where- mempty = replicate mempty- mappend = (<>)- {-# INLINE mempty #-}- {-# INLINE mappend #-}--instance (Arity n, Storable a, Semigroup a) => Semigroup (Vec n a) where- (<>) = zipWith (<>)- {-# INLINE (<>) #-}+instance (Arity n, Storable a) => FM.Prod a (Vec n a) where+ construct = constructVec+ inspect = inspectVec+ {-# INLINE construct #-}+ {-# INLINE inspect #-}+instance (Arity n, Storable a) => FM.Vector a (Vec n a) instance (Arity n, Storable a) => Storable (Vec n a) where- sizeOf _ = arity (Proxy :: Proxy n)- * sizeOf (undefined :: a)- alignment _ = alignment (undefined :: a)+ sizeOf = defaultSizeOf+ alignment = defaultAlignemnt peek ptr = do arr@(MVec fp) <- new- withForeignPtr fp $ \p ->- moveArray p (castPtr ptr) (arity (Proxy :: Proxy n))+ unsafeWithForeignPtr fp $ \p ->+ moveArray p (castPtr ptr) (peanoToInt (proxy# @(Peano n))) unsafeFreeze arr poke ptr (Vec fp)- = withForeignPtr fp $ \p ->- moveArray (castPtr ptr) p (arity (Proxy :: Proxy n))+ = unsafeWithForeignPtr fp $ \p ->+ moveArray (castPtr ptr) p (peanoToInt (proxy# @(Peano n))) +-- | @since 2.0.1.0+deriving via ViaFixed (Vec n) a instance (Arity n, Storable a, Prim a) => Prim (Vec n a)+ instance (Typeable n, Arity n, Storable a, Data a) => Data (Vec n a) where gfoldl = C.gfoldl gunfold = C.gunfold@@ -208,7 +191,3 @@ {-# INLINE mallocVector #-} mallocVector size = mallocPlainForeignPtrBytes (size * sizeOf (undefined :: a))--getPtr :: ForeignPtr a -> Ptr a-{-# INLINE getPtr #-}-getPtr (ForeignPtr addr _) = Ptr addr
+ Data/Vector/Fixed/Strict.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+-- |+-- Strict boxed vector which could hold any value. For lazy variant see+-- "Data.Vector.Fixed.Boxed".+module Data.Vector.Fixed.Strict where++import Control.Applicative (Applicative(..))+import Control.DeepSeq (NFData(..))+import Data.Primitive.SmallArray+import Data.Monoid (Monoid(..))+import Data.Semigroup (Semigroup(..))+import Data.Data+import Data.Primitive.Types (Prim)+import qualified Data.Foldable as F+import qualified Data.Foldable1 as F1+import qualified Data.Traversable as T+import Foreign.Storable (Storable)+import GHC.TypeLits+import GHC.Exts (proxy#)+import Prelude ( Show(..),Eq(..),Ord(..),Functor(..),Monad(..)+ , ($!),error,(<$>))+ +import Data.Vector.Fixed hiding (index)+import Data.Vector.Fixed.Compat+import Data.Vector.Fixed.Mono qualified as FM+import Data.Vector.Fixed.Mutable (Mutable, MVector(..), IVector(..), DimM, constructVec, inspectVec, index)+import qualified Data.Vector.Fixed.Cont as C+import Data.Vector.Fixed.Cont (ArityPeano(..))+++----------------------------------------------------------------+-- Data type+----------------------------------------------------------------++-- | Vector with fixed length which can hold any value. It's strict+-- and ensures that elements are evaluated to WHNF.+newtype Vec (n :: Nat) a = Vec (SmallArray a)++-- | Mutable unboxed vector with fixed length+newtype MVec (n :: Nat) s a = MVec (SmallMutableArray s a)++type Vec1 = Vec 1+type Vec2 = Vec 2+type Vec3 = Vec 3+type Vec4 = Vec 4+type Vec5 = Vec 5++type instance Mutable (Vec n) = MVec n+type instance Dim (Vec n) = Peano n+type instance Dim (Vec n a) = Peano n+type instance DimM (MVec n) = Peano n+++----------------------------------------------------------------+-- Instances+----------------------------------------------------------------++deriving via ViaFixed (Vec n) instance Arity n => Functor (Vec n)+deriving via ViaFixed (Vec n) instance Arity n => Applicative (Vec n)+deriving via ViaFixed (Vec n) instance Arity n => F.Foldable (Vec n)+-- | @since @2.0.1.0+deriving via ViaFixed (Vec n)+ instance (Arity n, Peano n ~ S k) => F1.Foldable1 (Vec n)++instance Arity n => T.Traversable (Vec n) where+ sequence = sequence+ sequenceA = sequence+ traverse = mapM+ mapM = mapM+ {-# INLINE sequence #-}+ {-# INLINE sequenceA #-}+ {-# INLINE mapM #-}+ {-# INLINE traverse #-}++deriving via ViaFixed (Vec n) a instance (Arity n, Show a) => Show (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Eq a) => Eq (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Ord a) => Ord (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, NFData a) => NFData (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Semigroup a) => Semigroup (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Monoid a) => Monoid (Vec n a)+deriving via ViaFixed (Vec n) a instance (Arity n, Storable a) => Storable (Vec n a)+-- | @since 2.0.1.0+deriving via ViaFixed (Vec n) a instance (Arity n, Prim a) => Prim (Vec n a)++instance (Arity n) => MVector (MVec n) a where+ basicNew =+ MVec <$> newSmallArray (peanoToInt (proxy# @(Peano n))) uninitialised+ basicReplicate a =+ MVec <$> newSmallArray (peanoToInt (proxy# @(Peano n))) a+ basicCopy (MVec dst) (MVec src) =+ copySmallMutableArray dst 0 src 0 (peanoToInt (proxy# @(Peano n)))+ basicClone (MVec src) =+ MVec <$> cloneSmallMutableArray src 0 (peanoToInt (proxy# @(Peano n)))+ basicUnsafeRead (MVec v) i = readSmallArray v i+ basicUnsafeWrite (MVec v) i !x = writeSmallArray v i x+ {-# INLINE basicNew #-}+ {-# INLINE basicReplicate #-}+ {-# INLINE basicCopy #-}+ {-# INLINE basicClone #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}++instance (Arity n) => IVector (Vec n) a where+ basicUnsafeFreeze (MVec v) = do { a <- unsafeFreezeSmallArray v; return $! Vec a }+ basicThaw (Vec v) =+ MVec <$> thawSmallArray v 0 (peanoToInt (proxy# @(Peano n)))+ unsafeIndex (Vec v) i = indexSmallArray v i+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicThaw #-}+ {-# INLINE unsafeIndex #-}++instance (Arity n) => Vector (Vec n) a where+ construct = constructVec+ inspect = inspectVec+ basicIndex = index+ {-# INLINE construct #-}+ {-# INLINE inspect #-}+ {-# INLINE basicIndex #-}+instance (Arity n) => FM.Prod a (Vec n a) where+ construct = constructVec+ inspect = inspectVec+ {-# INLINE construct #-}+ {-# INLINE inspect #-}+instance (Arity n) => FM.Vector a (Vec n a)++instance (Typeable n, Arity n, Data a) => Data (Vec n a) where+ gfoldl = C.gfoldl+ gunfold = C.gunfold+ toConstr _ = con_Vec+ dataTypeOf _ = ty_Vec++ty_Vec :: DataType+ty_Vec = mkDataType "Data.Vector.Fixed.Strict.Vec" [con_Vec]++con_Vec :: Constr+con_Vec = mkConstr ty_Vec "Vec" [] Prefix++uninitialised :: a+uninitialised = error "Data.Vector.Fixed.Strict: uninitialised element"
Data/Vector/Fixed/Unboxed.hs view
@@ -1,53 +1,57 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UndecidableInstances #-} -- |--- Unboxed vectors with fixed length.+-- Adaptive array type which picks vector representation from type of+-- element of array. For example arrays of @Double@ are backed by+-- @ByteArray@, arrays of @Bool@ are represented as bit-vector, arrays+-- of tuples are products of arrays. 'Unbox' type class is used to+-- describe representation of an array. module Data.Vector.Fixed.Unboxed(- -- * Immutable- Vec+ -- * Data type+ Vec(..) , Vec1 , Vec2 , Vec3 , Vec4 , Vec5- -- * Mutable- , MVec- -- * Type classes+ -- * Type classes & derivation , Unbox+ , UnboxViaPrim+ -- * Concrete representations+ , BitVec+ , T2(..)+ , T3(..) ) where import Control.Applicative (Const(..))-import Control.Monad import Control.DeepSeq (NFData(..))+import Data.Bits import Data.Complex+import Data.Coerce import Data.Data+import Data.Kind import Data.Functor.Identity (Identity(..)) import Data.Int (Int8, Int16, Int32, Int64 ) import Data.Monoid (Monoid(..),Dual(..),Sum(..),Product(..),All(..),Any(..)) import Data.Semigroup (Semigroup(..)) import Data.Ord (Down(..)) import Data.Word (Word,Word8,Word16,Word32,Word64)-import Foreign.Storable (Storable(..))+import Data.Primitive.Types (Prim)+import Foreign.Storable (Storable) import GHC.TypeLits-import Prelude ( Show(..),Eq(..),Ord(..),Int,Double,Float,Char,Bool(..)- , ($),(.),seq)+import GHC.Exts (Proxy#, proxy#)+import Prelude ( Show(..),Eq(..),Ord(..),Num(..),Applicative(..)+ , Int,Double,Float,Char,Bool(..),($),id) -import Data.Vector.Fixed (Dim,Vector(..),VectorN,eq,ord,replicate,zipWith,foldl,- defaultSizeOf,defaultAlignemnt,defaultPeek,defaultPoke- )-import Data.Vector.Fixed.Mutable (Mutable, MVector(..), IVector(..), DimM, constructVec, inspectVec, Arity, index)-import qualified Data.Vector.Fixed.Cont as C-import qualified Data.Vector.Fixed.Primitive as P-import qualified Data.Vector.Fixed.Internal as I+import Data.Vector.Fixed (Dim,Vector(..),ViaFixed(..))+import Data.Vector.Fixed qualified as F+import Data.Vector.Fixed.Compat+import Data.Vector.Fixed.Cont qualified as C+import Data.Vector.Fixed.Mono qualified as FM+import Data.Vector.Fixed.Cont (Peano,Arity,ArityPeano,Fun(..),curryFirst)+import Data.Vector.Fixed.Primitive qualified as P @@ -55,11 +59,9 @@ -- Data type ---------------------------------------------------------------- -data family Vec (n :: Nat) a-data family MVec (n :: Nat) s a--deriving instance Typeable Vec-deriving instance Typeable MVec+-- | Adaptive array of dimension @n@ and containing elements of type+-- @a@.+newtype Vec (n :: Nat) a = Vec { getVecRepr :: VecRepr n a (EltRepr a) } type Vec1 = Vec 1 type Vec2 = Vec 2@@ -67,52 +69,61 @@ type Vec4 = Vec 4 type Vec5 = Vec 5 -class (Arity n, IVector (Vec n) a, MVector (MVec n) a) => Unbox n a---------------------------------------------------------------------- Generic instances-------------------------------------------------------------------instance (Arity n, Show a, Unbox n a) => Show (Vec n a) where- showsPrec = I.showsPrec--instance (Arity n, Unbox n a, NFData a) => NFData (Vec n a) where- rnf = foldl (\r a -> r `seq` rnf a) ()- {-# INLINE rnf #-}+-- | Type class which selects internal representation of unboxed vector.+--+-- Crucial design constraint is this type class must be+-- GND-derivable. And this rules out anything mentioning 'Fun',+-- since all it's parameters has @nominal@ role. Thus 'Vector' is+-- not GND-derivable and we have to take somewhat roundabout+-- approach.+class ( Dim (VecRepr n a) ~ Peano n+ , Vector (VecRepr n a) (EltRepr a)+ ) => Unbox n a where+ -- | Vector data type to use as a representation.+ type VecRepr n a :: Type -> Type+ -- | Element data type to use as a representation.+ type EltRepr a :: Type+ -- | Convert element to its representation+ toEltRepr :: Proxy# n -> a -> EltRepr a+ -- | Convert element from its representation+ fromEltRepr :: Proxy# n -> EltRepr a -> a -type instance Mutable (Vec n) = MVec n+type instance Dim (Vec n) = Peano n+type instance Dim (Vec n a) = Peano n -type instance Dim (Vec n) = n-type instance DimM (MVec n) = n+instance (Arity n, Unbox n a) => Vector (Vec n) a where+ inspect (Vec v) f+ = inspect v+ (C.dimapFun (fromEltRepr (proxy# @n)) id f)+ construct+ = C.dimapFun (toEltRepr (proxy# @n)) Vec+ (construct @(VecRepr n a) @(EltRepr a))+ {-# INLINE inspect #-}+ {-# INLINE construct #-} -instance (Unbox n a) => Vector (Vec n) a where- construct = constructVec- inspect = inspectVec- basicIndex = index+instance (Arity n, Unbox n a) => FM.Prod a (Vec n a) where+ construct = construct+ inspect = inspect {-# INLINE construct #-} {-# INLINE inspect #-}- {-# INLINE basicIndex #-} +instance (Arity n, Unbox n a) => FM.Vector a (Vec n a) -instance (Unbox n a) => VectorN Vec n a -instance (Unbox n a, Eq a) => Eq (Vec n a) where- (==) = eq- {-# INLINE (==) #-}-instance (Unbox n a, Ord a) => Ord (Vec n a) where- compare = ord- {-# INLINE compare #-} -instance (Unbox n a, Monoid a) => Monoid (Vec n a) where- mempty = replicate mempty- mappend = (<>)- {-# INLINE mempty #-}- {-# INLINE mappend #-}+----------------------------------------------------------------+-- Generic instances+---------------------------------------------------------------- -instance (Unbox n a, Semigroup a) => Semigroup (Vec n a) where- (<>) = zipWith (<>)- {-# INLINE (<>) #-}+deriving via ViaFixed (Vec n) a instance (Unbox n a, Show a) => Show (Vec n a)+deriving via ViaFixed (Vec n) a instance (Unbox n a, Eq a) => Eq (Vec n a)+deriving via ViaFixed (Vec n) a instance (Unbox n a, Ord a) => Ord (Vec n a)+deriving via ViaFixed (Vec n) a instance (Unbox n a, NFData a) => NFData (Vec n a)+deriving via ViaFixed (Vec n) a instance (Unbox n a, Semigroup a) => Semigroup (Vec n a)+deriving via ViaFixed (Vec n) a instance (Unbox n a, Monoid a) => Monoid (Vec n a)+deriving via ViaFixed (Vec n) a instance (Unbox n a, Storable a) => Storable (Vec n a)+-- | @since 2.0.1.0+deriving via ViaFixed (Vec n) a instance (Unbox n a, Prim a) => Prim (Vec n a) instance (Typeable n, Unbox n a, Data a) => Data (Vec n a) where gfoldl = C.gfoldl@@ -126,364 +137,196 @@ con_Vec :: Constr con_Vec = mkConstr ty_Vec "Vec" [] Prefix -instance (Storable a, Unbox n a) => Storable (Vec n a) where- alignment = defaultAlignemnt- sizeOf = defaultSizeOf- peek = defaultPeek- poke = defaultPoke- {-# INLINE alignment #-}- {-# INLINE sizeOf #-}- {-# INLINE peek #-}- {-# INLINE poke #-} -- ---------------------------------------------------------------- -- Data instances ---------------------------------------------------------------- --- Unit type-data instance MVec n s () = MV_Unit-data instance Vec n () = V_Unit+instance F.Arity n => Unbox n () where+ type VecRepr n () = VecUnit n+ type EltRepr () = ()+ toEltRepr _ = id+ fromEltRepr _ = id+ {-# INLINE toEltRepr #-}+ {-# INLINE fromEltRepr #-} -instance Arity n => Unbox n ()+data VecUnit (n :: Nat) a = VecUnit -instance Arity n => MVector (MVec n) () where- new = return MV_Unit- {-# INLINE new #-}- copy _ _ = return ()- {-# INLINE move #-}- move _ _ = return ()- {-# INLINE copy #-}- unsafeRead _ _ = return ()- {-# INLINE unsafeRead #-}- unsafeWrite _ _ _ = return ()- {-# INLINE unsafeWrite #-}+type instance Dim (VecUnit n) = Peano n+type instance Dim (VecUnit n a) = Peano n -instance Arity n => IVector (Vec n) () where- unsafeFreeze _ = return V_Unit- unsafeThaw _ = return MV_Unit- unsafeIndex _ _ = ()- {-# INLINE unsafeFreeze #-}- {-# INLINE unsafeThaw #-}- {-# INLINE unsafeIndex #-}+instance F.Arity n => Vector (VecUnit n) () where+ inspect _ fun+ = C.runContVec fun+ $ C.apply (\Proxy -> ((),Proxy)) Proxy+ construct+ = pure VecUnit+ {-# INLINE inspect #-}+ {-# INLINE construct #-} ---------------------------------------------------------------- -- Boolean -newtype instance MVec n s Bool = MV_Bool (P.MVec n s Word8)-newtype instance Vec n Bool = V_Bool (P.Vec n Word8)+-- | Bit vector represented as 64-bit word. This puts upper limit on+-- length of vector. It's not a big problem. 64-element will strain+-- GHC quite a bit.+data BitVec (n :: Nat) a = BitVec Word64 -instance Arity n => Unbox n Bool+type instance Dim (BitVec n) = Peano n+type instance Dim (BitVec n a) = Peano n -instance Arity n => MVector (MVec n) Bool where- new = MV_Bool `liftM` new- {-# INLINE new #-}- copy (MV_Bool v) (MV_Bool w) = copy v w- {-# INLINE copy #-}- move (MV_Bool v) (MV_Bool w) = move v w- {-# INLINE move #-}- unsafeRead (MV_Bool v) i = toBool `liftM` unsafeRead v i- {-# INLINE unsafeRead #-}- unsafeWrite (MV_Bool v) i b = unsafeWrite v i (fromBool b)- {-# INLINE unsafeWrite #-}+instance (n <= 64, Arity n, a ~ Bool) => Vector (BitVec n) a where+ inspect (BitVec w) = inspect (C.generate (testBit w))+ construct = C.accum+ (\(Const (i,w)) -> \case+ True -> Const (i+1, setBit w i)+ False -> Const (i+1, w))+ (\(Const (_,w)) -> BitVec w)+ (Const (0,0)) -instance Arity n => IVector (Vec n) Bool where- unsafeFreeze (MV_Bool v) = V_Bool `liftM` unsafeFreeze v- unsafeThaw (V_Bool v) = MV_Bool `liftM` unsafeThaw v- unsafeIndex (V_Bool v) = toBool . unsafeIndex v- {-# INLINE unsafeFreeze #-}- {-# INLINE unsafeThaw #-}- {-# INLINE unsafeIndex #-}+instance (n <= 64, Arity n) => Unbox n Bool where+ type VecRepr n Bool = BitVec n+ type EltRepr Bool = Bool+ toEltRepr _ = id+ fromEltRepr _ = id+ {-# INLINE toEltRepr #-}+ {-# INLINE fromEltRepr #-} -fromBool :: Bool -> Word8-{-# INLINE fromBool #-}-fromBool True = 1-fromBool False = 0 -toBool :: Word8 -> Bool-{-# INLINE toBool #-}-toBool 0 = False-toBool _ = True-- ---------------------------------------------------------------- -- Primitive wrappers-#define primMV(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 = unsafeRead v i \-; unsafeWrite (con v) i x = unsafeWrite v i x \-; {-# INLINE new #-} \-; {-# INLINE move #-} \-; {-# INLINE copy #-} \-; {-# INLINE unsafeRead #-} \-; {-# INLINE unsafeWrite #-} \-}--#define primIV(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 = unsafeIndex v i \-; {-# INLINE unsafeFreeze #-} \-; {-# INLINE unsafeThaw #-} \-; {-# INLINE unsafeIndex #-} \-}--#define primWrap(ty,con,mcon) \-newtype instance MVec n s ty = mcon (P.MVec n s ty) ; \-newtype instance Vec n ty = con (P.Vec n ty) ; \-instance Arity n => Unbox n ty ; \-primMV(ty, mcon ) ; \-primIV(ty, con, mcon)----primWrap(Int, V_Int, MV_Int )-primWrap(Int8, V_Int8, MV_Int8 )-primWrap(Int16, V_Int16, MV_Int16)-primWrap(Int32, V_Int32, MV_Int32)-primWrap(Int64, V_Int64, MV_Int64)+---------------------------------------------------------------- -primWrap(Word, V_Word, MV_Word )-primWrap(Word8, V_Word8, MV_Word8 )-primWrap(Word16, V_Word16, MV_Word16)-primWrap(Word32, V_Word32, MV_Word32)-primWrap(Word64, V_Word64, MV_Word64)+-- | Wrapper for deriving 'Unbox' for data types which are instances+-- of 'P.Prim' type class:+--+-- > deriving via UnboxViaPrim Word instance (C.Arity n) => Unbox n Word+newtype UnboxViaPrim a = UnboxViaPrim a+ deriving newtype P.Prim -primWrap(Char, V_Char, MV_Char )-primWrap(Float, V_Float, MV_Float )-primWrap(Double, V_Double, MV_Double)+instance (C.Arity n, P.Prim a) => Unbox n (UnboxViaPrim a) where+ type VecRepr n (UnboxViaPrim a) = P.Vec n+ type EltRepr (UnboxViaPrim a) = a+ toEltRepr _ = coerce+ fromEltRepr _ = coerce+ +deriving via UnboxViaPrim Int instance (C.Arity n) => Unbox n Int +deriving via UnboxViaPrim Int8 instance (C.Arity n) => Unbox n Int8+deriving via UnboxViaPrim Int16 instance (C.Arity n) => Unbox n Int16+deriving via UnboxViaPrim Int32 instance (C.Arity n) => Unbox n Int32+deriving via UnboxViaPrim Int64 instance (C.Arity n) => Unbox n Int64+deriving via UnboxViaPrim Word instance (C.Arity n) => Unbox n Word +deriving via UnboxViaPrim Word8 instance (C.Arity n) => Unbox n Word8+deriving via UnboxViaPrim Word16 instance (C.Arity n) => Unbox n Word16+deriving via UnboxViaPrim Word32 instance (C.Arity n) => Unbox n Word32+deriving via UnboxViaPrim Word64 instance (C.Arity n) => Unbox n Word64 +deriving via UnboxViaPrim Char instance (C.Arity n) => Unbox n Char+deriving via UnboxViaPrim Float instance (C.Arity n) => Unbox n Float+deriving via UnboxViaPrim Double instance (C.Arity n) => Unbox n Double ------------------------------------------------------------------- Complex-newtype instance MVec n s (Complex a) = MV_Complex (MVec n s (a,a))-newtype instance Vec n (Complex a) = V_Complex (Vec n (a,a))--instance (Unbox n a) => Unbox n (Complex a)--instance (Arity n, MVector (MVec n) a) => MVector (MVec n) (Complex a) where- new = MV_Complex `liftM` new- {-# INLINE new #-}- copy (MV_Complex v) (MV_Complex w) = copy v w- {-# INLINE copy #-}- move (MV_Complex v) (MV_Complex w) = move v w- {-# INLINE move #-}- unsafeRead (MV_Complex v) i = do (a,b) <- unsafeRead v i- return (a :+ b)- {-# INLINE unsafeRead #-}- unsafeWrite (MV_Complex v) i (a :+ b) = unsafeWrite v i (a,b)- {-# INLINE unsafeWrite #-}+-- Newtypes+---------------------------------------------------------------- -instance (Arity n, IVector (Vec n) a) => IVector (Vec n) (Complex a) where- unsafeFreeze (MV_Complex v) = V_Complex `liftM` unsafeFreeze v- {-# INLINE unsafeFreeze #-}- unsafeThaw (V_Complex v) = MV_Complex `liftM` unsafeThaw v- {-# INLINE unsafeThaw #-}- unsafeIndex (V_Complex v) i =- case unsafeIndex v i of (a,b) -> a :+ b- {-# INLINE unsafeIndex #-}+deriving newtype instance (Unbox n a) => Unbox n (Const a b)+deriving newtype instance (Unbox n a) => Unbox n (Identity a)+deriving newtype instance (Unbox n a) => Unbox n (Down a)+deriving newtype instance (Unbox n a) => Unbox n (Dual a)+deriving newtype instance (Unbox n a) => Unbox n (Sum a)+deriving newtype instance (Unbox n a) => Unbox n (Product a) +deriving newtype instance (n <= 64, Arity n) => Unbox n All+deriving newtype instance (n <= 64, Arity n) => Unbox n Any ---------------------------------------------------------------- -- Tuples-data instance MVec n s (a,b) = MV_2 !(MVec n s a) !(MVec n s b)-data instance Vec n (a,b) = V_2 !(Vec n a) !(Vec n b)--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- new = do as <- new- bs <- new- return $ MV_2 as bs- {-# INLINE new #-}- copy (MV_2 va vb) (MV_2 wa wb) = copy va wa >> copy vb wb- {-# INLINE copy #-}- move (MV_2 va vb) (MV_2 wa wb) = move va wa >> move vb wb- {-# INLINE move #-}- unsafeRead (MV_2 v w) i = do a <- unsafeRead v i- b <- unsafeRead w i- return (a,b)- {-# INLINE unsafeRead #-}- unsafeWrite (MV_2 v w) i (a,b) = unsafeWrite v i a >> unsafeWrite w i b- {-# INLINE unsafeWrite #-}---instance ( Arity n- , IVector (Vec n) a, IVector (Vec n) b- ) => IVector (Vec n) (a,b) where- unsafeFreeze (MV_2 v w) = do as <- unsafeFreeze v- bs <- unsafeFreeze w- return $ V_2 as bs- {-# INLINE unsafeFreeze #-}- unsafeThaw (V_2 v w) = do as <- unsafeThaw v- bs <- unsafeThaw w- return $ MV_2 as bs- {-# INLINE unsafeThaw #-}- unsafeIndex (V_2 v w) i = (unsafeIndex v i, unsafeIndex w i)- {-# INLINE unsafeIndex #-}-----data instance MVec n s (a,b,c) = MV_3 !(MVec n s a) !(MVec n s b) !(MVec n s c)-data instance Vec n (a,b,c) = V_3 !(Vec n a) !(Vec n b) !(Vec n c)--instance (Unbox n a, Unbox n b, Unbox n c) => Unbox n (a,b,c)--instance (Arity n, MVector (MVec n) a, MVector (MVec n) b, MVector (MVec n) c- ) => MVector (MVec n) (a,b,c) where- new = do as <- new- bs <- new- cs <- new- return $ MV_3 as bs cs- {-# INLINE new #-}- copy (MV_3 va vb vc) (MV_3 wa wb wc)- = copy va wa >> copy vb wb >> copy vc wc- {-# INLINE copy #-}- move (MV_3 va vb vc) (MV_3 wa wb wc)- = move va wa >> move vb wb >> move vc wc- {-# INLINE move #-}- unsafeRead (MV_3 v w u) i = do a <- unsafeRead v i- b <- unsafeRead w i- c <- unsafeRead u i- return (a,b,c)- {-# INLINE unsafeRead #-}- unsafeWrite (MV_3 v w u) i (a,b,c)- = unsafeWrite v i a >> unsafeWrite w i b >> unsafeWrite u i c- {-# INLINE unsafeWrite #-}--instance ( Arity n- , Vector (Vec n) a, Vector (Vec n) b, Vector (Vec n) c- , IVector (Vec n) a, IVector (Vec n) b, IVector (Vec n) c- ) => IVector (Vec n) (a,b,c) where- unsafeFreeze (MV_3 v w u) = do as <- unsafeFreeze v- bs <- unsafeFreeze w- cs <- unsafeFreeze u- return $ V_3 as bs cs- {-# INLINE unsafeFreeze #-}- unsafeThaw (V_3 v w u) = do as <- unsafeThaw v- bs <- unsafeThaw w- cs <- unsafeThaw u- return $ MV_3 as bs cs- {-# INLINE unsafeThaw #-}- 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)+-- | Representation for vector of 2-tuple as two vectors.+data T2 n a b x = T2 !(Vec n a) !(Vec n 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 #-}+type instance Dim (T2 n a b) = Peano n+type instance Dim (T2 n a b x) = Peano n -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 #-}+instance (Arity n, Unbox n a, Unbox n b) => Vector (T2 n a b) (a,b) where+ inspect (T2 vA vB)+ = inspect (C.zipWith (,) cvA cvB)+ where+ cvA = C.ContVec $ inspect vA+ cvB = C.ContVec $ inspect vB+ construct = pairF T2 construct construct+ {-# INLINE construct #-}+ {-# INLINE inspect #-} +pairF+ :: ArityPeano n+ => (x -> y -> z)+ -> Fun n a x+ -> Fun n b y+ -> Fun n (a,b) z+{-# INLINE pairF #-}+pairF g funA funB = C.accum+ (\(T_pair fA fB) (a,b) -> T_pair (curryFirst fA a) (curryFirst fB b))+ (\(T_pair (Fun x) (Fun y)) -> g x y)+ (T_pair funA funB) -------------------------------------------------------------------- Newtype wrappers with kind * -> *+data T_pair a b x y n = T_pair (Fun n a x) (Fun n b y) -#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 #-} \-}+-- | Representation for vector of 2-tuple as two vectors.+data T3 n a b c x = T3 !(Vec n a) !(Vec n b) !(Vec n c) -#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)+type instance Dim (T3 n a b c) = Peano n+type instance Dim (T3 n a b c x) = Peano n +instance (Arity n, Unbox n a, Unbox n b, Unbox n c) => Vector (T3 n a b c) (a,b,c) where+ inspect (T3 vA vB vC)+ = inspect (C.zipWith3 (,,) cvA cvB cvC)+ where+ cvA = C.ContVec $ inspect vA+ cvB = C.ContVec $ inspect vB+ cvC = C.ContVec $ inspect vC+ construct = pair3F T3 construct construct construct+ {-# INLINE construct #-}+ {-# INLINE inspect #-} -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)+pair3F+ :: ArityPeano n+ => (x -> y -> z -> r)+ -> Fun n a x+ -> Fun n b y+ -> Fun n c z+ -> Fun n (a,b,c) r+{-# INLINE pair3F #-}+pair3F g funA funB funC = C.accum+ (\(T_pair3 fA fB fC) (a,b,c) -> T_pair3 (curryFirst fA a)+ (curryFirst fB b)+ (curryFirst fC c))+ (\(T_pair3 (Fun x) (Fun y) (Fun z)) -> g x y z)+ (T_pair3 funA funB funC) +data T_pair3 a b c x y z n = T_pair3 (Fun n a x) (Fun n b y) (Fun n c z) -------------------------------------------------------------------- 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)+instance (Unbox n a, Unbox n b) => Unbox n (a,b) where+ type VecRepr n (a,b) = T2 n a b+ type EltRepr (a,b) = (a,b)+ toEltRepr _ = id+ fromEltRepr _ = id -primNewMonoWrap(Any, Bool, V_Any, MV_Any)-primNewMonoWrap(All, Bool, V_All, MV_All)+instance (Unbox n a) => Unbox n (Complex a) where+ -- NOTE: It would be nice to have ability to use single buffer say+ -- for `Complex Double`. But buffers seems to be opaque+ type VecRepr n (Complex a) = T2 n a a+ type EltRepr (Complex a) = (a,a)+ toEltRepr _ (r :+ i) = (r,i)+ fromEltRepr _ (r,i) = r :+ i+ {-# INLINE toEltRepr #-}+ {-# INLINE fromEltRepr #-}
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
fixed-vector.cabal view
@@ -1,101 +1,179 @@+Cabal-Version: 3.0+Build-Type: Simple+ Name: fixed-vector-Version: 1.2.3.0+Version: 2.1.1.0 Synopsis: Generic vectors with statically known size. Description: Generic library for vectors with statically known size. Implementation is based on <http://unlines.wordpress.com/2010/11/15/generics-for-small-fixed-size-vectors/> Same functions could be used to work with both ADT based vector like- .+ > data Vec3 a = a a a- .+ Tuples are vectors too:- .+ >>> sum (1,2,3) 6- .+ Vectors which are represented internally by arrays are provided by library. Both boxed and unboxed arrays are supported.- .+ Library is structured as follows:- .- * Data.Vector.Fixed++ * __Data.Vector.Fixed__: Generic API. It's suitable for both ADT-based vector like Complex and array-based ones.- .- * Data.Vector.Fixed.Cont++ * __Data.Vector.Fixed.Cont__: Continuation based vectors. Internally all functions use them.- .- * Data.Vector.Fixed.Mutable++ * __Data.Vector.Fixed.Unboxed__:+ Unboxed vectors which select best representation using types.++ * __Data.Vector.Fixed.Strict__:+ Strict boxed vector which can hold elements of any type.++ * __Data.Vector.Fixed.Boxed__:+ Lazy boxed vector which can hold elements of any type.++ * __Data.Vector.Fixed.Storable__:+ Unboxed vectors of Storable types.++ * __Data.Vector.Fixed.Primitive__:+ Unboxed vectors backed by single @ByteArray@++ * __Data.Vector.Fixed.Mutable__: Type classes for array-based implementation and API for working with mutable state.- .- * Data.Vector.Fixed.Unboxed- Unboxed vectors.- .- * Data.Vector.Fixed.Boxed- Boxed vector which can hold elements of any type.- .- * Data.Vector.Fixed.Storable- Unboxed vectors of Storable types.- .- * Data.Vector.Fixed.Primitive- Unboxed vectors based on pritimive package. -Cabal-Version: >= 1.10-License: BSD3++License: BSD-3-Clause License-File: LICENSE Author: Aleksey Khudyakov <alexey.skladnoy@gmail.com> Maintainer: Aleksey Khudyakov <alexey.skladnoy@gmail.com> Bug-reports: https://github.com/Shimuuar/fixed-vector/issues Category: Data-Build-Type: Simple-extra-source-files:+extra-doc-files: ChangeLog.md tested-with:- GHC ==8.4.4- || ==8.6.5- || ==8.8.4- || ==8.10.7- || ==9.0.1- || ==9.2.8- || ==9.4.7- || ==9.6.3+ GHC ==9.4.7+ || ==9.6.7+ || ==9.8.4+ || ==9.10.2+ || ==9.12.2+ || ==9.14.1 source-repository head type: git location: http://github.com/Shimuuar/fixed-vector -Library+common language Ghc-options: -Wall -Wno-incomplete-uni-patterns Default-Language: Haskell2010- Build-Depends: base >=4.11 && <5+ Default-Extensions:+ -- GHC2021 sans PolyKinds+ BangPatterns+ ConstraintKinds+ DataKinds+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveLift+ DeriveTraversable+ DerivingStrategies+ DisambiguateRecordFields+ DoAndIfThenElse+ EmptyCase+ EmptyDataDecls+ EmptyDataDeriving+ ExistentialQuantification+ ExplicitNamespaces+ FlexibleContexts+ FlexibleInstances+ ForeignFunctionInterface+ GADTs+ GADTSyntax+ GeneralisedNewtypeDeriving+ ImplicitPrelude+ ImportQualifiedPost+ InstanceSigs+ KindSignatures+ LambdaCase+ MonoLocalBinds+ MonomorphismRestriction+ MultiParamTypeClasses+ NamedFieldPuns+ NamedWildCards+ NumericUnderscores+ PatternGuards+ PostfixOperators+ RankNTypes+ RelaxedPolyRec+ RoleAnnotations+ ScopedTypeVariables+ StandaloneDeriving+ StandaloneKindSignatures+ TupleSections+ TypeApplications+ TypeOperators+ TypeSynonymInstances+ --+ DerivingVia+ PatternSynonyms+ ViewPatterns+ TypeFamilies+ FunctionalDependencies+++Library+ import: language+ Build-Depends: base >=4.16 && <5 , primitive >=0.6.2 , deepseq+ if impl(ghc<9.6)+ Build-Depends: foldable1-classes-compat >=0.1 Exposed-modules: -- API Data.Vector.Fixed.Cont Data.Vector.Fixed Data.Vector.Fixed.Generic+ Data.Vector.Fixed.Mono -- Arrays Data.Vector.Fixed.Mutable Data.Vector.Fixed.Boxed+ Data.Vector.Fixed.Strict Data.Vector.Fixed.Primitive Data.Vector.Fixed.Unboxed Data.Vector.Fixed.Storable Other-modules: Data.Vector.Fixed.Internal+ Data.Vector.Fixed.Compat Test-Suite fixed-vector-doctests Default-Language: Haskell2010- if impl(ghc < 8.0.1 )+ if impl(ghc < 9.2) buildable: False Type: exitcode-stdio-1.0 Hs-source-dirs: test Main-is: Doctests.hs- Build-Depends: base >=4.8 && <5+ Build-Depends: base >=4.14 && <5 , primitive >=0.6.2 -- Additional test dependencies. , doctest >= 0.18 , filemanip == 0.3.6.*++Test-Suite fixed-vector-inspect+ import: language+ Type: exitcode-stdio-1.0+ Hs-source-dirs: test+ Main-is: inspect.hs+ Other-modules: Inspect.Obligations+ Build-Depends: base >=4.8 && <5+ , template-haskell+ , fixed-vector+ , tasty >= 1.2+ , tasty-inspection-testing >= 0.1
test/Doctests.hs view
@@ -10,4 +10,61 @@ main :: IO () main = do sources <- find_sources- doctest $ sources+ doctest $ exts ++ sources+++exts :: [String]+exts =+ [ "-XBangPatterns"+ , "-XConstraintKinds"+ , "-XDataKinds"+ , "-XDeriveDataTypeable"+ , "-XDeriveFoldable"+ , "-XDeriveFunctor"+ , "-XDeriveGeneric"+ , "-XDeriveLift"+ , "-XDeriveTraversable"+ , "-XDerivingStrategies"+ , "-XDisambiguateRecordFields"+ , "-XDoAndIfThenElse"+ , "-XEmptyCase"+ , "-XEmptyDataDecls"+ , "-XEmptyDataDeriving"+ , "-XExistentialQuantification"+ , "-XExplicitNamespaces"+ , "-XFlexibleContexts"+ , "-XFlexibleInstances"+ , "-XForeignFunctionInterface"+ , "-XGADTs"+ , "-XGADTSyntax"+ , "-XGeneralisedNewtypeDeriving"+ , "-XImplicitPrelude"+ , "-XImportQualifiedPost"+ , "-XInstanceSigs"+ , "-XKindSignatures"+ , "-XLambdaCase"+ , "-XMonoLocalBinds"+ , "-XMonomorphismRestriction"+ , "-XMultiParamTypeClasses"+ , "-XNamedFieldPuns"+ , "-XNamedWildCards"+ , "-XNumericUnderscores"+ , "-XPatternGuards"+ , "-XPostfixOperators"+ , "-XRankNTypes"+ , "-XRelaxedPolyRec"+ , "-XRoleAnnotations"+ , "-XScopedTypeVariables"+ , "-XStandaloneDeriving"+ , "-XStandaloneKindSignatures"+ , "-XTupleSections"+ , "-XTypeApplications"+ , "-XTypeOperators"+ , "-XTypeSynonymInstances"+ --+ , "-XDerivingVia"+ , "-XPatternSynonyms"+ , "-XViewPatterns"+ , "-XTypeFamilies"+ , "-XFunctionalDependencies"+ ]
+ test/Inspect/Obligations.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TemplateHaskell #-}+-- |+module Inspect.Obligations where++import GHC.Exts+import Test.Tasty.Inspection+import Language.Haskell.TH (Name)+++-- We don't allocate arrays in he function. It covers opaque data+-- types+noArrayAlloc :: Name -> Obligation+noArrayAlloc nm = doesNotUseAnyOf nm+ [ 'newByteArray#+ , 'newSmallArray# + ]++noAllocation :: Name -> Obligation+noAllocation nm = mkObligation nm NoAllocation
+ test/inspect.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin=Test.Tasty.Inspection.Plugin #-}+{-# OPTIONS_GHC -dsuppress-idinfo #-}+module Main where++import Test.Tasty+import Test.Tasty.Inspection++import Data.Vector.Fixed qualified as F+import Data.Vector.Fixed.Unboxed qualified as FU+import Data.Vector.Fixed.Boxed qualified as FB+import Data.Vector.Fixed.Primitive qualified as FP++import Inspect.Obligations++++simple_fusion_FU :: Int -> Int+simple_fusion_FU n = F.sum $ F.generate @FU.Vec3 (*n)++simple_fusion_FB :: Int -> Int+simple_fusion_FB n = F.sum $ F.generate @FB.Vec3 (*n)++simple_fusion_FP :: Int -> Int+simple_fusion_FP n = F.sum $ F.generate @FP.Vec3 (*n)++fuse_mapM_ :: IO ()+fuse_mapM_ = F.mapM_ print (F.mk3 1 2 3 :: FU.Vec3 Double)++fuse_zipWith :: Int -> Int+fuse_zipWith n = F.sum $ F.zipWith (*) v u+ where v,u :: FU.Vec3 Int+ v = F.generate (*2)+ u = F.replicate n++fuse_zipWith_self :: Int -> Int+fuse_zipWith_self n = F.sum $ F.zipWith (*) u u+ where u :: FU.Vec3 Int+ u = F.replicate n++-- More involved example with zipWith. It stresses optimizer and could be+-- used as a benchmark for optimization of compilation speed.+fuse_zipWithParam :: FP.Vec 3 Int -> FP.Vec 3 Int -> FP.Vec 3 Int -> Int+fuse_zipWithParam v1 v2 v3 = F.sum v12 + F.sum v13 + F.sum v23 where+ v12 = F.zipWith (*) v1 v2+ v13 = F.zipWith (*) v1 v3+ v23 = F.zipWith (*) v2 v3++simple_foldl1 :: FP.Vec 4 Int -> Int+simple_foldl1 = F.foldl1 (+) . F.map (\n -> n*n)+++----------------------------------------------------------------+-- Tests+----------------------------------------------------------------++main :: IO ()+main = defaultMain $ testGroup "inspect"+ [ $(inspectObligations [ hasNoTypeClasses+ , noArrayAlloc+ ] 'simple_fusion_FU)+ , $(inspectObligations [ hasNoTypeClasses+ , noArrayAlloc+ ] 'simple_fusion_FB)+ , $(inspectObligations [ hasNoTypeClasses+ , noArrayAlloc+ ] 'simple_fusion_FP)+ , $(inspectObligations [ hasNoTypeClasses+ , noArrayAlloc+ ] 'fuse_mapM_)+ , testGroup "zipWith"+ -- NOTE: zipWith uses lists internally but they should get+ -- optimized away. Thus check that lists don't occur in core+ [ $(inspectObligations [ hasNoTypeClasses+ , flip hasNoType ''[]+ , noArrayAlloc+ ] 'fuse_zipWith)+ , $(inspectObligations [ hasNoTypeClasses+ , flip hasNoType ''[]+ -- FIXME: Does not fuse when used nonlinearly+ -- , noArrayAlloc+ ] 'fuse_zipWith_self)+ , $(inspectObligations [ hasNoTypeClasses+ , flip hasNoType ''[]+ , noArrayAlloc+ ] 'fuse_zipWithParam)+ , $(inspectObligations [ hasNoTypeClasses+ , noArrayAlloc+ ] 'simple_foldl1)+ ]+ ]