Hello community, here is the log from the commit of package ghc-fixed-vector for openSUSE:Factory checked in at 2017-03-14 10:04:38 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-fixed-vector (Old) and /work/SRC/openSUSE:Factory/.ghc-fixed-vector.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-fixed-vector" Tue Mar 14 10:04:38 2017 rev:2 rq:461630 version:0.9.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-fixed-vector/ghc-fixed-vector.changes 2016-11-01 09:52:08.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-fixed-vector.new/ghc-fixed-vector.changes 2017-03-14 10:04:39.264456818 +0100 @@ -1,0 +2,5 @@ +Sun Feb 12 14:12:56 UTC 2017 - [email protected] + +- Update to version 0.9.0.0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- fixed-vector-0.8.1.0.tar.gz New: ---- fixed-vector-0.9.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-fixed-vector.spec ++++++ --- /var/tmp/diff_new_pack.E5COMg/_old 2017-03-14 10:04:39.748388293 +0100 +++ /var/tmp/diff_new_pack.E5COMg/_new 2017-03-14 10:04:39.748388293 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-fixed-vector # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,15 +19,14 @@ %global pkg_name fixed-vector %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.8.1.0 +Version: 0.9.0.0 Release: 0 Summary: Generic vectors with statically known size License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-deepseq-devel BuildRequires: ghc-primitive-devel BuildRequires: ghc-rpm-macros @@ -36,7 +35,6 @@ BuildRequires: ghc-doctest-devel BuildRequires: ghc-filemanip-devel %endif -# End cabal-rpm deps %description Generic library for vectors with statically known size. Implementation is based @@ -88,20 +86,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache @@ -115,6 +107,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) -%doc ChangeLog +%doc ChangeLog.md %changelog ++++++ fixed-vector-0.8.1.0.tar.gz -> fixed-vector-0.9.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fixed-vector-0.8.1.0/ChangeLog new/fixed-vector-0.9.0.0/ChangeLog --- old/fixed-vector-0.8.1.0/ChangeLog 2015-08-27 16:00:27.000000000 +0200 +++ new/fixed-vector-0.9.0.0/ChangeLog 1970-01-01 01:00:00.000000000 +0100 @@ -1,166 +0,0 @@ -Changes in 0.8.1.0 - - * `find` function added. - - -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. - - -Changes in 0.7.0.3 - - * GHC 7.10 support - - -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` - - -Changes in 0.6.4.0 - - * Isomorphism between Peano numbers and Nat added. (GHC >= 7.8) - - -Changes in 0.6.3.1 - - * Documentation fixes. - - -Changes in 0.6.3.0 - - * Left scans added. - - -Changes in 0.6.2.0 - - * `Vec1' type synonym for boxed/unboxed/etc. vectors added. - - * Vector instance for Data.Typeable.Proxy (GHC >= 7.8) - - -Changes in 0.6.1.1 - - * GHC 7.8 support - - -Changes in 0.6.1.0 - - * `distribute', `collect' and their monadic variants added. - - -Changes in 0.6.0.0 - - * Data instance for all array-based vectors added. - - * Storable instance added for `Storable.Vec'. - - * Monoid instances added for all vectors. - - -Changes in 0.5.1.0 - - * Zero-element vector `Empty' is added. - - -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. - - -Changes in 0.4.4.0 - - * Functor and Applicative instances are added to Id. - - -Changes in 0.4.3.0 - - * 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. - - -Changes in 0.4.1.0 - - * `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 - - -Changes in 0.3.0.0 - - * 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. - - -Changes in 0.1.2 - - * imap, imapM, ifoldl, ifoldM, zipWithM, izipWithM - functions are added. - - * VectorN type class added. - - -Changes in 0.1.1 - - * foldM and tailWith added. Type synonyms for numbers up to 6 are - added. Fun is reexported from Data.Vector.Fixed. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fixed-vector-0.8.1.0/ChangeLog.md new/fixed-vector-0.9.0.0/ChangeLog.md --- old/fixed-vector-0.8.1.0/ChangeLog.md 1970-01-01 01:00:00.000000000 +0100 +++ new/fixed-vector-0.9.0.0/ChangeLog.md 2016-09-14 19:34:23.000000000 +0200 @@ -0,0 +1,176 @@ +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`. + + +Changes in 0.8.1.0 + + * `find` function added. + + +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. + + +Changes in 0.7.0.3 + + * GHC 7.10 support + + +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` + + +Changes in 0.6.4.0 + + * Isomorphism between Peano numbers and Nat added. (GHC >= 7.8) + + +Changes in 0.6.3.1 + + * Documentation fixes. + + +Changes in 0.6.3.0 + + * Left scans added. + + +Changes in 0.6.2.0 + + * `Vec1` type synonym for boxed/unboxed/etc. vectors added. + + * Vector instance for Data.Typeable.Proxy (GHC >= 7.8) + + +Changes in 0.6.1.1 + + * GHC 7.8 support + + +Changes in 0.6.1.0 + + * `distribute` `collect` and their monadic variants added. + + +Changes in 0.6.0.0 + + * Data instance for all array-based vectors added. + + * Storable instance added for `Storable.Vec`. + + * Monoid instances added for all vectors. + + +Changes in 0.5.1.0 + + * Zero-element vector `Empty'`is added. + + +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. + + +Changes in 0.4.4.0 + + * Functor and Applicative instances are added to Id. + + +Changes in 0.4.3.0 + + * 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. + + +Changes in 0.4.1.0 + + * `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 + + +Changes in 0.3.0.0 + + * 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. + + +Changes in 0.1.2 + + * imap, imapM, ifoldl, ifoldM, zipWithM, izipWithM + functions are added. + + * VectorN type class added. + + +Changes in 0.1.1 + + * foldM and tailWith added. Type synonyms for numbers up to 6 are + added. Fun is reexported from Data.Vector.Fixed. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fixed-vector-0.8.1.0/Data/Vector/Fixed/Boxed.hs new/fixed-vector-0.9.0.0/Data/Vector/Fixed/Boxed.hs --- old/fixed-vector-0.8.1.0/Data/Vector/Fixed/Boxed.hs 2015-08-27 16:00:27.000000000 +0200 +++ new/fixed-vector-0.9.0.0/Data/Vector/Fixed/Boxed.hs 2016-09-14 19:34:23.000000000 +0200 @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} @@ -46,13 +45,8 @@ -- | Mutable unboxed vector with fixed length newtype MVec n s a = MVec (MutableArray s a) -#if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable Vec deriving instance Typeable MVec -#else -deriving instance Typeable2 Vec -deriving instance Typeable3 MVec -#endif type Vec1 = Vec (S Z) type Vec2 = Vec (S (S Z)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fixed-vector-0.8.1.0/Data/Vector/Fixed/Cont.hs new/fixed-vector-0.9.0.0/Data/Vector/Fixed/Cont.hs --- old/fixed-vector-0.8.1.0/Data/Vector/Fixed/Cont.hs 2015-08-27 16:00:27.000000000 +0200 +++ new/fixed-vector-0.9.0.0/Data/Vector/Fixed/Cont.hs 2016-09-14 19:34:23.000000000 +0200 @@ -1,5 +1,5 @@ +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -9,10 +9,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE GADTs #-} --- Needed for NatIso -#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE DataKinds, TypeOperators, UndecidableInstances #-} -#endif -- | -- API for Church-encoded vectors. Implementation of function from -- "Data.Vector.Fixed" module uses these function internally in order @@ -24,11 +21,9 @@ , Add -- ** Isomorphism between Peano number and Nats -- $natiso -#if __GLASGOW_HASKELL__ >= 708 , NatIso , ToPeano , ToNat -#endif -- ** Synonyms for small numerals , N1 , N2 @@ -42,14 +37,12 @@ , Arity(..) , apply , applyM - , WitSum(..) -- ** Combinators , constFun , curryFirst , uncurryFirst , curryLast , curryMany - , uncurryMany , apLast , shuffleFun , withFun @@ -143,12 +136,11 @@ import Control.Applicative (Applicative(..),(<$>),(<|>)) import Control.Monad (liftM) +import Data.Coerce import Data.Complex (Complex(..)) import Data.Data (Typeable,Data) -#if __GLASGOW_HASKELL__ >= 708 import Data.Typeable (Proxy(..)) import GHC.TypeLits -#endif import qualified Data.Foldable as F import qualified Data.Traversable as F @@ -188,7 +180,6 @@ -- impossible to define their properties inductively. So Peano number -- are used everywhere. -#if __GLASGOW_HASKELL__ >= 708 -- | Isomorphism between two representations of natural numbers class (ToNat a ~ b, ToPeano b ~ a) => NatIso (a :: *) (b :: Nat) where @@ -208,7 +199,7 @@ , ToPeano n ~ S k , n ~ (1 + (n - 1)) -- n is positive ) => NatIso (S k) n where -#endif + ---------------------------------------------------------------- @@ -226,21 +217,20 @@ instance Arity n => Functor (Fun n a) where - fmap (f :: b -> c) (Fun g0 :: Fun n a b) - = Fun $ accum - (\(T_fmap g) a -> T_fmap (g a)) - (\(T_fmap x) -> f x) - (T_fmap g0 :: T_fmap a b n) + fmap f fun + = accum (\(T_Flip g) a -> T_Flip (curryFirst g a)) + (\(T_Flip x) -> f (unFun x)) + (T_Flip fun) {-# INLINE fmap #-} instance Arity n => Applicative (Fun n a) where - pure (x :: x) = Fun $ accum (\(T_pure r) (_::a) -> T_pure r) - (\(T_pure r) -> r) - (T_pure x :: T_pure x n) + pure x = accum (\Proxy _ -> Proxy) + (\Proxy -> x) + Proxy (Fun f0 :: Fun n a (p -> q)) <*> (Fun g0 :: Fun n a p) - = Fun $ accum (\(T_ap f g) a -> T_ap (f a) (g a)) - (\(T_ap f g) -> f g) - (T_ap f0 g0 :: T_ap a (p -> q) p n) + = accum (\(T_ap f g) a -> T_ap (f a) (g a)) + (\(T_ap f g) -> f g) + (T_ap f0 g0 :: T_ap a (p -> q) p n) {-# INLINE pure #-} {-# INLINE (<*>) #-} @@ -251,8 +241,6 @@ {-# INLINE (>>=) #-} -newtype T_fmap a b n = T_fmap (Fn n a b) -data T_pure a n = T_pure a data T_ap a b c n = T_ap (Fn n a b) (Fn n a c) @@ -268,7 +256,7 @@ accum :: (forall k. t (S k) -> a -> t k) -- ^ Fold function -> (t Z -> b) -- ^ Extract result of fold -> t n -- ^ Initial value - -> Fn n a b -- ^ Reduction function + -> 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 @@ -288,31 +276,29 @@ -- | Arity of function. arity :: n -> Int + -- | Reverse order of parameters. reverseF :: Fun n a b -> Fun n a b + -- | Uncurry /n/ first parameters of n-ary function + uncurryMany :: Fun (Add n k) a b -> Fun n a (Fun k a b) + -- | Worker function for 'gunfold' gunfoldF :: (Data a) => (forall b x. Data b => c (b -> x) -> c x) -> T_gunfold c r a n -> c r - -- | Proof that `Fn (n+k) a b ~ Fn n a (Fn k a b)` - witSum :: WitSum n k a b newtype T_gunfold c r a n = T_gunfold (c (Fn n a r)) --- | Value that carry proof that `Fn (Add n k) a b ~ Fn n a (Fn k a b)` -data WitSum n k a b where - WitSum :: (Fn (Add n k) a b ~ Fn n a (Fn k a b)) => WitSum n k a b -- | Apply all parameters to the function. apply :: Arity n => (forall k. t (S k) -> (a, t k)) -- ^ Get value to apply to function -> t n -- ^ Initial value - -> Fn n a b -- ^ N-ary function - -> b + -> ContVec n a -- ^ N-ary function {-# INLINE apply #-} -apply step z f = fst $ applyFun step z f +apply step z = ContVec $ \(Fun f) -> fst $ applyFun step z f -- | Apply all parameters to the function using monadic actions. applyM :: (Monad m, Arity n) @@ -324,7 +310,7 @@ return v instance Arity Z where - accum _ g t = g t + accum _ g t = Fun $ g t applyFun _ t h = (h,t) applyFunM _ t = return (empty, t) arity _ = 0 @@ -334,13 +320,13 @@ {-# INLINE arity #-} reverseF = id gunfoldF _ (T_gunfold c) = c - {-# INLINE reverseF #-} - {-# INLINE gunfoldF #-} - witSum = WitSum - {-# INLINE witSum #-} + uncurryMany = coerce + {-# INLINE reverseF #-} + {-# INLINE gunfoldF #-} + {-# INLINE uncurryMany #-} instance Arity n => Arity (S n) where - accum f g t = \a -> accum f g (f t a) + accum f g t = Fun $ \a -> unFun $ accum f g (f t a) applyFun f t h = case f t of (a,u) -> applyFun f u (h a) applyFunM f t = do (a,t') <- f t (vec,tZ) <- applyFunM f t' @@ -352,15 +338,14 @@ {-# INLINE arity #-} reverseF f = Fun $ \a -> unFun (reverseF $ apLast f a) gunfoldF f c = gunfoldF f (apGunfold f c) - {-# INLINE reverseF #-} - {-# INLINE gunfoldF #-} - witSum = witSumWorker - {-# INLINE witSum #-} - -witSumWorker :: forall n k a b. Arity n => WitSum (S n) k a b -{-# INLINE witSumWorker #-} -witSumWorker = case witSum :: WitSum n k a b of - WitSum -> WitSum + + uncurryMany :: forall k a b. Fun (Add (S n) k) a b -> Fun (S n) a (Fun k a b) + uncurryMany f + = coerce + (fmap uncurryMany (curryFirst f) :: a -> Fun n a (Fun k a b)) + {-# INLINE reverseF #-} + {-# INLINE gunfoldF #-} + {-# INLINE uncurryMany #-} apGunfold :: Data a => (forall b x. Data b => c (b -> x) -> c x) @@ -370,6 +355,10 @@ {-# INLINE apGunfold #-} +newtype T_Flip a b n = T_Flip (Fun n a b) +newtype T_Counter n = T_Counter Int + + ---------------------------------------------------------------- -- Combinators @@ -382,20 +371,20 @@ -- | Curry first parameter of n-ary function curryFirst :: Fun (S n) a b -> a -> Fun n a b -curryFirst (Fun f) x = Fun (f x) +curryFirst = coerce {-# INLINE curryFirst #-} -- | Uncurry first parameter of n-ary function uncurryFirst :: (a -> Fun n a b) -> Fun (S n) a b -uncurryFirst f = Fun $ fmap unFun f +uncurryFirst = coerce {-# INLINE uncurryFirst #-} -- | Curry last parameter of n-ary function -curryLast :: forall n a b. Arity n => Fun (S n) a b -> Fun n a (a -> b) +curryLast :: Arity n => Fun (S n) a b -> Fun n a (a -> b) {-# INLINE curryLast #-} -curryLast (Fun f0) = Fun $ accum (\(T_fun f) a -> T_fun (f a)) - (\(T_fun f) -> f) - (T_fun f0 :: T_fun a b n) +curryLast (Fun f0) = accum (\(T_fun f) a -> T_fun (f a)) + (\(T_fun f) -> f) + (T_fun f0) newtype T_fun a b n = T_fun (Fn (S n) a b) @@ -403,22 +392,13 @@ curryMany :: forall n k a b. Arity n => Fun (Add n k) a b -> Fun n a (Fun k a b) {-# INLINE curryMany #-} -curryMany (Fun f0) = Fun $ accum +curryMany (Fun f0) = accum (\(T_curry f) a -> T_curry (f a)) - (\(T_curry f) -> Fun f :: Fun k a b) + (\(T_curry f) -> Fun f) ( T_curry f0 :: T_curry a b k n) newtype T_curry a b k n = T_curry (Fn (Add n k) a b) --- | Uncurry /n/ first parameters of n-ary function -uncurryMany :: forall n k a b. Arity n - => Fun n a (Fun k a b) -> Fun (Add n k) a b -{-# INLINE uncurryMany #-} -uncurryMany f = - case witSum :: WitSum n k a b of - WitSum -> - case fmap unFun f :: Fun n a (Fn k a b) of - Fun g -> Fun g -- | Apply last parameter to function. Unlike 'apFun' we need to @@ -432,15 +412,14 @@ withFun f fun = Fun $ \a -> unFun $ f $ curryFirst fun a {-# INLINE withFun #-} - -- | Move function parameter to the result of N-ary function. -shuffleFun :: forall n a b r. Arity n +shuffleFun :: Arity n => (b -> Fun n a r) -> Fun n a (b -> r) {-# INLINE shuffleFun #-} shuffleFun f0 - = Fun $ accum (\(T_shuffle f) a -> T_shuffle $ \x -> f x a) - (\(T_shuffle f) -> f) - (T_shuffle (fmap unFun f0) :: T_shuffle b a r n) + = accum (\(T_shuffle f) a -> T_shuffle $ \x -> f x a) + (\(T_shuffle f) -> f) + (T_shuffle (fmap unFun f0)) newtype T_shuffle x a r n = T_shuffle (x -> Fn n a r) @@ -518,10 +497,10 @@ type instance Dim (ContVec n) = n instance Arity n => Vector (ContVec n) a where - construct = Fun $ - accum (\(T_mkN f) a -> T_mkN (f . cons a)) - (\(T_mkN f) -> f empty) - (T_mkN id :: T_mkN n a n) + construct = accum + (\(T_mkN f) a -> T_mkN (f . cons a)) + (\(T_mkN f) -> f empty) + (T_mkN id) inspect (ContVec c) f = c f {-# INLINE construct #-} {-# INLINE inspect #-} @@ -553,9 +532,9 @@ => Fun n a b -> Fun n (f a) (f b) {-# INLINE sequenceAF #-} sequenceAF (Fun f0) - = Fun $ accum (\(T_sequenceA f) a -> T_sequenceA (f <*> a)) - (\(T_sequenceA f) -> f) - (T_sequenceA (pure f0) :: T_sequenceA f a b n) + = accum (\(T_sequenceA f) a -> T_sequenceA (f <*> a)) + (\(T_sequenceA f) -> f) + (T_sequenceA (pure f0) :: T_sequenceA f a b n) newtype T_sequenceA f a b n = T_sequenceA (f (Fn n a b)) @@ -578,12 +557,10 @@ -- | Convert list to continuation-based vector. Will throw error if -- list is shorter than resulting vector. -fromList :: forall n a. Arity n => [a] -> ContVec n a +fromList :: Arity n => [a] -> ContVec n a {-# INLINE fromList #-} -fromList xs = ContVec $ \(Fun fun) -> - apply step - (T_flist xs :: T_flist a n) - fun +fromList xs = + apply step (T_flist xs) where step (T_flist [] ) = error "Data.Vector.Fixed.Cont.fromList: too few elements" step (T_flist (a:as)) = (a, T_flist as) @@ -613,7 +590,7 @@ step (T_flist [] ) = Nothing step (T_flist (a:as)) = return (a, T_flist as) -data T_flist a n = T_flist [a] +newtype T_flist a n = T_flist [a] -- | Convert vector to the list @@ -623,66 +600,50 @@ -- | Execute monadic action for every element of vector. Synonym for 'pure'. -replicate :: forall n a. (Arity n) - => a -> ContVec n a +replicate :: (Arity n) => a -> ContVec n a {-# INLINE replicate #-} -replicate a = ContVec $ \(Fun fun) -> - apply (\T_replicate -> (a, T_replicate)) - (T_replicate :: T_replicate n) - fun +replicate a = apply (\Proxy -> (a, Proxy)) Proxy -- | Execute monadic action for every element of vector. -replicateM :: forall m n a. (Arity n, Monad m) - => m a -> m (ContVec n a) +replicateM :: (Arity n, Monad m) => m a -> m (ContVec n a) {-# INLINE replicateM #-} -replicateM act = - applyM (\T_replicate -> do { a <- act; return (a, T_replicate) } ) - (T_replicate :: T_replicate n) - - -data T_replicate n = T_replicate +replicateM act + = applyM (\Proxy -> do { a <- act; return (a, Proxy)}) Proxy -- | Generate vector from function which maps element's index to its value. -generate :: forall n a. (Arity n) => (Int -> a) -> ContVec n a +generate :: (Arity n) => (Int -> a) -> ContVec n a {-# INLINE generate #-} -generate f = ContVec $ \(Fun fun) -> - apply (\(T_generate n) -> (f n, T_generate (n + 1))) - (T_generate 0 :: T_generate n) - fun +generate f = + apply (\(T_Counter n) -> (f n, T_Counter (n + 1))) + (T_Counter 0) -- | Generate vector from monadic function which maps element's index -- to its value. -generateM :: forall m n a. (Monad m, Arity n) - => (Int -> m a) -> m (ContVec n a) +generateM :: (Monad m, Arity n) => (Int -> m a) -> m (ContVec n a) {-# INLINE generateM #-} generateM f = - applyM (\(T_generate n) -> do { a <- f n; return (a, T_generate (n + 1)) } ) - (T_generate 0 :: T_generate n) - + applyM (\(T_Counter n) -> do { a <- f n; return (a, T_Counter (n + 1)) } ) + (T_Counter 0) -newtype T_generate n = T_generate Int -- | Unfold vector. -unfoldr :: forall n b a. Arity n => (b -> (a,b)) -> b -> ContVec n a +unfoldr :: Arity n => (b -> (a,b)) -> b -> ContVec n a {-# INLINE unfoldr #-} -unfoldr f b0 = ContVec $ \(Fun fun) -> +unfoldr f b0 = apply (\(T_unfoldr b) -> let (a,b') = f b in (a, T_unfoldr b')) - (T_unfoldr b0 :: T_unfoldr b n) - fun + (T_unfoldr b0) newtype T_unfoldr b n = T_unfoldr b -- | Unit vector along Nth axis. -basis :: forall n a. (Num a, Arity n) => Int -> ContVec n a +basis :: (Num a, Arity n) => Int -> ContVec n a {-# INLINE basis #-} -basis n0 = ContVec $ \(Fun fun) -> - apply (\(T_basis n) -> ((if n == 0 then 1 else 0) :: a, T_basis (n - 1))) - (T_basis n0 :: T_basis n) - fun +basis n0 = + apply (\(T_Counter n) -> (if n == 0 then 1 else 0, T_Counter (n - 1))) + (T_Counter n0) -newtype T_basis n = T_basis Int mk1 :: a -> ContVec N1 a @@ -727,7 +688,6 @@ {-# INLINE mapM #-} mapM = imapM . const --- {- -- | Apply monadic function to every element of the vector and its index. imapM :: (Arity n, Monad m) => (Int -> a -> m b) -> ContVec n a -> m (ContVec n b) {-# INLINE imapM #-} @@ -747,26 +707,26 @@ imapM_ f = ifoldl (\m i a -> m >> f i a >> return ()) (return ()) -imapMF :: forall m n a b r. (Arity n, Monad m) +imapMF :: (Arity n, Monad m) => (Int -> a -> m b) -> Fun n b r -> Fun n a (m r) {-# INLINE imapMF #-} -imapMF f (Fun funB) = Fun $ +imapMF f (Fun funB) = accum (\(T_mapM i m) a -> T_mapM (i+1) $ do b <- f i a fun <- m return $ fun b ) (\(T_mapM _ m) -> m) - (T_mapM 0 (return funB) :: T_mapM b m r n) + (T_mapM 0 (return funB)) data T_mapM a m r n = T_mapM Int (m (Fn n a r)) -imapF :: forall n a b r. Arity n +imapF :: Arity n => (Int -> a -> b) -> Fun n b r -> Fun n a r {-# INLINE imapF #-} -imapF f (Fun funB) = Fun $ +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 :: T_map b r n) + ( T_map 0 funB) data T_map a r n = T_map Int (Fn n a r) @@ -783,8 +743,8 @@ cont . scanl1F f scanlF :: forall n a b r. (Arity n) => (b -> a -> b) -> b -> Fun (S n) b r -> Fun n a r -scanlF f b0 (Fun fun0) = Fun - $ accum step fini start +scanlF f b0 (Fun fun0) + = accum step fini start where step :: forall k. T_scanl r b (S k) -> a -> T_scanl r b k step (T_scanl b fn) a = let b' = f b a in T_scanl b' (fn b') @@ -792,7 +752,7 @@ start = T_scanl b0 (fun0 b0) :: T_scanl r b n scanl1F :: forall n a r. (Arity n) => (a -> a -> a) -> Fun n a r -> Fun n a r -scanl1F f (Fun fun0) = Fun $ accum step fini start +scanl1F f (Fun fun0) = accum step fini start where step :: forall k. T_scanl1 r a (S k) -> a -> T_scanl1 r a k step (T_scanl1 Nothing fn) a = T_scanl1 (Just a) (fn a) @@ -815,18 +775,15 @@ {-# INLINE sequence_ #-} -- | The dual of sequenceA -distribute :: forall f n a. (Functor f, Arity n) - => f (ContVec n a) -> ContVec n (f a) +distribute :: (Functor f, Arity n) => f (ContVec n a) -> ContVec n (f a) {-# INLINE distribute #-} distribute f0 - = ContVec $ \(Fun fun) -> apply step start fun + = apply step start where -- It's not possible to use ContVec as accumulator type since `head' -- require Arity constraint on `k'. So we use plain lists - step :: forall k. T_distribute a f (S k) -> (f a, T_distribute a f k) step (T_distribute f) = ( fmap (\(x:_) -> x) f , T_distribute $ fmap (\(_:x) -> x) f) - start :: T_distribute a f n start = T_distribute (fmap toList f0) collect :: (Functor f, Arity n) => (a -> ContVec n b) -> f a -> ContVec n (f b) @@ -834,16 +791,13 @@ {-# INLINE collect #-} -- | The dual of sequence -distributeM :: forall m n a. (Monad m, Arity n) - => m (ContVec n a) -> ContVec n (m a) +distributeM :: (Monad m, Arity n) => m (ContVec n a) -> ContVec n (m a) {-# INLINE distributeM #-} distributeM f0 - = ContVec $ \(Fun fun) -> apply step start fun + = apply step start where - step :: forall k. T_distribute a m (S k) -> (m a, T_distribute a m k) step (T_distribute f) = ( liftM (\(x:_) -> x) f , T_distribute $ liftM (\(_:x) -> x) f) - start :: T_distribute a m n start = T_distribute (liftM toList f0) collectM :: (Monad m, Arity n) => (a -> ContVec n b) -> m a -> ContVec n (m b) @@ -864,7 +818,7 @@ {-# INLINE cons #-} -- | Prepend single element vector to another vector. -consV :: forall n a. ContVec (S Z) a -> ContVec n a -> ContVec (S n) a +consV :: ContVec (S Z) a -> ContVec n a -> ContVec (S n) a {-# INLINE consV #-} consV (ContVec cont1) (ContVec cont) = ContVec $ \f -> cont $ curryFirst f $ cont1 $ Fun id @@ -938,23 +892,23 @@ {-# INLINE izipWithM_ #-} izipWithM_ f xs ys = sequence_ (izipWith f xs ys) -izipWithF :: forall n a b c r. (Arity n) +izipWithF :: (Arity n) => (Int -> a -> b -> c) -> Fun n c r -> Fun n a (Fun n b r) {-# INLINE izipWithF #-} izipWithF f (Fun g0) = - fmap (\v -> Fun $ accum + 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 :: (T_izip a c r n)) + (T_izip 0 v g0) ) makeList -makeList :: forall n a. Arity n => Fun n a [a] +makeList :: Arity n => Fun n a [a] {-# INLINE makeList #-} -makeList = Fun $ accum +makeList = accum (\(T_mkList xs) x -> T_mkList (xs . (x:))) (\(T_mkList xs) -> xs []) - (T_mkList id :: T_mkList a n) + (T_mkList id) newtype T_mkList a n = T_mkList ([a] -> [a]) @@ -980,26 +934,26 @@ {-# INLINE[1] vector #-} -- | Finalizer function for getting head of the vector. -head :: forall n a. Arity (S n) => ContVec (S n) a -> a +head :: Arity (S n) => ContVec (S n) a -> a -- NOTE: we need constraint `Arity (S n)' instead of `Arity n' because -- `Vector v' entails `Arity (Dim v)' and GHC cannot figure out -- that `Arity (S n)' ⇒ `Arity n' {-# INLINE head #-} head - = runContVec $ Fun + = runContVec $ accum (\(T_head m) a -> T_head $ case m of { Nothing -> Just a; x -> x }) (\(T_head (Just x)) -> x) - (T_head Nothing :: T_head a (S n)) + (T_head Nothing) data T_head a n = T_head (Maybe a) -- | /O(n)/ Get value at specified index. -index :: forall n a. Arity n => Int -> ContVec n a -> a +index :: Arity n => Int -> ContVec n a -> a {-# INLINE index #-} index n | n < 0 = error "Data.Vector.Fixed.Cont.index: index out of range" - | otherwise = runContVec $ Fun $ accum + | otherwise = runContVec $ accum (\(T_Index x) a -> T_Index $ case x of Left 0 -> Right a Left i -> Left (i - 1) @@ -1009,7 +963,7 @@ Left _ -> error "Data.Vector.Fixed.index: index out of range" Right a -> a ) - ( T_Index (Left n) :: T_Index a n) + (T_Index (Left n)) newtype T_Index a n = T_Index (Either Int a) @@ -1034,7 +988,7 @@ elementF :: forall a n f r. (Arity n, Functor f) => Int -> (a -> f a) -> Fun n a r -> Fun n a (f r) {-# INLINE elementF #-} -elementF n f (Fun fun0) = Fun $ accum step fini start +elementF n f (Fun fun0) = accum step fini start where step :: forall k. T_lens f a r (S k) -> a -> T_lens f a r k step (T_lens (Left (0,fun))) a = T_lens $ Right $ fmap fun $ f a @@ -1058,14 +1012,13 @@ foldl f = ifoldl (\b _ a -> f b a) -- | Left fold over continuation vector. -ifoldl :: forall n a b. Arity n - => (b -> Int -> a -> b) -> b -> ContVec n a -> b +ifoldl :: Arity n => (b -> Int -> a -> b) -> b -> ContVec n a -> b {-# INLINE ifoldl #-} ifoldl f b v - = inspect v $ Fun + = inspect v $ accum (\(T_ifoldl i r) a -> T_ifoldl (i+1) (f r i a)) (\(T_ifoldl _ r) -> r) - (T_ifoldl 0 b :: T_ifoldl b n) + (T_ifoldl 0 b) -- | Monadic left fold over continuation vector. foldM :: (Arity n, Monad m) @@ -1091,17 +1044,16 @@ -- But it require constraint `Arity n` whereas `Vector v a` gives -- `Arity (S n)`. Latter imply former but GHC cannot infer it. -newtype T_foldl1 a n = T_foldl1 (Maybe a) - -- | Left fold. -foldl1 :: forall n a. (Arity (S n)) - => (a -> a -> a) -> ContVec (S n) a -> a +foldl1 :: (Arity (S n)) => (a -> a -> a) -> ContVec (S n) a -> a {-# INLINE foldl1 #-} foldl1 f - = runContVec $ Fun + = runContVec $ accum (\(T_foldl1 r ) a -> T_foldl1 $ Just $ maybe a (flip f a) r) (\(T_foldl1 (Just x)) -> x) - (T_foldl1 Nothing :: T_foldl1 a (S n)) + (T_foldl1 Nothing) + +newtype T_foldl1 a n = T_foldl1 (Maybe a) -- | Right fold over continuation vector foldr :: Arity n => (a -> b -> b) -> b -> ContVec n a -> b @@ -1109,15 +1061,13 @@ foldr = ifoldr . const -- | Right fold over continuation vector -ifoldr :: forall n a b. Arity n - => (Int -> a -> b -> b) -> b -> ContVec n a -> b +ifoldr :: Arity n => (Int -> a -> b -> b) -> b -> ContVec n a -> b {-# INLINE ifoldr #-} ifoldr f z - = runContVec $ Fun + = runContVec $ accum (\(T_ifoldr i g) a -> T_ifoldr (i+1) (g . f i a)) (\(T_ifoldr _ g) -> g z) - (T_ifoldr 0 id :: T_ifoldr b n) - + (T_ifoldr 0 id) data T_ifoldr b n = T_ifoldr Int (b -> b) @@ -1153,7 +1103,7 @@ -- | Determines whether any of element of vector satisfy predicate. any :: Arity n => (a -> Bool) -> ContVec n a -> Bool -any f = foldr (\x b -> f x && b) True +any f = foldr (\x b -> f x || b) True {-# INLINE any #-} -- | The 'find' function takes a predicate and a vector and returns @@ -1186,13 +1136,13 @@ gun = T_gunfold (inj $ unFun con) :: T_gunfold c (v a) a (Dim v) -gfoldlF :: forall c r a n. (Arity n, Data a) +gfoldlF :: (Arity n, Data a) => (forall x y. Data x => c (x -> y) -> x -> c y) -> c (Fn n a r) -> Fun n a (c r) -gfoldlF f c0 = Fun $ accum +gfoldlF f c0 = accum (\(T_gfoldl c) x -> T_gfoldl (f c x)) (\(T_gfoldl c) -> c) - (T_gfoldl c0 :: T_gfoldl c r a n) + (T_gfoldl c0) newtype T_gfoldl c r a n = T_gfoldl (c (Fn n a r)) @@ -1300,10 +1250,9 @@ {-# INLINE construct #-} {-# INLINE inspect #-} -#if __GLASGOW_HASKELL__ >= 708 type instance Dim Proxy = Z instance Vector Proxy a where construct = Fun Proxy inspect _ = unFun -#endif + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fixed-vector-0.8.1.0/Data/Vector/Fixed/Mutable.hs new/fixed-vector-0.9.0.0/Data/Vector/Fixed/Mutable.hs --- old/fixed-vector-0.8.1.0/Data/Vector/Fixed/Mutable.hs 2015-08-27 16:00:27.000000000 +0200 +++ new/fixed-vector-0.9.0.0/Data/Vector/Fixed/Mutable.hs 2016-09-14 19:34:23.000000000 +0200 @@ -31,7 +31,7 @@ import Control.Monad.ST import Control.Monad.Primitive -import Data.Vector.Fixed.Cont (Dim,Arity,Fun(..),S,arity,apply,accum) +import Data.Vector.Fixed.Cont (Dim,Arity,Fun(..),S,Vector(..),arity,apply,accum) import Prelude hiding (read) @@ -139,10 +139,10 @@ -- | Generic inspect implementation for array-based vectors. inspectVec :: forall v a b. (Arity (Dim v), IVector v a) => v a -> Fun (Dim v) a b -> b {-# INLINE inspectVec #-} -inspectVec v (Fun f) - = apply (\(T_idx i) -> (unsafeIndex v i, T_idx (i+1))) - (T_idx 0 :: T_idx (Dim v)) - f +inspectVec v + = inspect + $ apply (\(T_idx i) -> (unsafeIndex v i, T_idx (i+1))) + (T_idx 0) newtype T_idx n = T_idx Int @@ -150,7 +150,7 @@ -- | Generic construct implementation for array-based vectors. constructVec :: forall v a. (Arity (Dim v), IVector v a) => Fun (Dim v) a (v a) {-# INLINE constructVec #-} -constructVec = Fun $ +constructVec = accum step (\(T_new _ st) -> runST $ unsafeFreeze =<< st :: v a) (T_new 0 new :: T_new v a (Dim v)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fixed-vector-0.8.1.0/Data/Vector/Fixed/Primitive.hs new/fixed-vector-0.9.0.0/Data/Vector/Fixed/Primitive.hs --- old/fixed-vector-0.8.1.0/Data/Vector/Fixed/Primitive.hs 2015-08-27 16:00:27.000000000 +0200 +++ new/fixed-vector-0.9.0.0/Data/Vector/Fixed/Primitive.hs 2016-09-14 19:34:23.000000000 +0200 @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} @@ -50,13 +49,8 @@ -- | Mutable unboxed vector with fixed length newtype MVec n s a = MVec (MutableByteArray s) -#if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable Vec deriving instance Typeable MVec -#else -deriving instance Typeable2 Vec -deriving instance Typeable3 MVec -#endif type Vec1 = Vec (S Z) type Vec2 = Vec (S (S Z)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fixed-vector-0.8.1.0/Data/Vector/Fixed/Storable.hs new/fixed-vector-0.9.0.0/Data/Vector/Fixed/Storable.hs --- old/fixed-vector-0.8.1.0/Data/Vector/Fixed/Storable.hs 2015-08-27 16:00:27.000000000 +0200 +++ new/fixed-vector-0.9.0.0/Data/Vector/Fixed/Storable.hs 2016-09-14 19:34:23.000000000 +0200 @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} @@ -54,13 +53,8 @@ -- | Storable-based mutable vector with fixed length newtype MVec n s a = MVec (ForeignPtr a) -#if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable Vec deriving instance Typeable MVec -#else -deriving instance Typeable2 Vec -deriving instance Typeable3 MVec -#endif type Vec1 = Vec (S Z) type Vec2 = Vec (S (S Z)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fixed-vector-0.8.1.0/Data/Vector/Fixed/Unboxed.hs new/fixed-vector-0.9.0.0/Data/Vector/Fixed/Unboxed.hs --- old/fixed-vector-0.8.1.0/Data/Vector/Fixed/Unboxed.hs 2015-08-27 16:00:27.000000000 +0200 +++ new/fixed-vector-0.9.0.0/Data/Vector/Fixed/Unboxed.hs 2016-09-14 19:34:23.000000000 +0200 @@ -1,12 +1,12 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveDataTypeable #-} -- | -- Unboxed vectors with fixed length. module Data.Vector.Fixed.Unboxed( @@ -50,13 +50,8 @@ data family Vec n a data family MVec n s a -#if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable Vec deriving instance Typeable MVec -#else -deriving instance Typeable2 Vec -deriving instance Typeable3 MVec -#endif type Vec1 = Vec (S Z) type Vec2 = Vec (S (S Z)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fixed-vector-0.8.1.0/Data/Vector/Fixed.hs new/fixed-vector-0.9.0.0/Data/Vector/Fixed.hs --- old/fixed-vector-0.8.1.0/Data/Vector/Fixed.hs 2015-08-27 16:00:27.000000000 +0200 +++ new/fixed-vector-0.9.0.0/Data/Vector/Fixed.hs 2016-09-14 19:34:23.000000000 +0200 @@ -270,11 +270,11 @@ type instance Dim (VecList n) = n instance Arity n => Vector (VecList n) a where - construct = Fun $ accum + construct = accum (\(T_List f) a -> T_List (f . Cons a)) (\(T_List f) -> f Nil) (T_List id :: T_List a n n) - inspect v (Fun f) = apply step (Flip v) f + inspect v = inspect $ apply step (Flip v) where step :: Flip VecList a (S k) -> (a, Flip VecList a k) step (Flip (Cons a xs)) = (a, Flip xs) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fixed-vector-0.8.1.0/fixed-vector.cabal new/fixed-vector-0.9.0.0/fixed-vector.cabal --- old/fixed-vector-0.8.1.0/fixed-vector.cabal 2015-08-27 16:00:27.000000000 +0200 +++ new/fixed-vector-0.9.0.0/fixed-vector.cabal 2016-09-14 19:34:23.000000000 +0200 @@ -1,5 +1,5 @@ Name: fixed-vector -Version: 0.8.1.0 +Version: 0.9.0.0 Synopsis: Generic vectors with statically known size. Description: Generic library for vectors with statically known @@ -54,7 +54,7 @@ Category: Data Build-Type: Simple extra-source-files: - ChangeLog + ChangeLog.md source-repository head type: hg @@ -66,7 +66,7 @@ Library Ghc-options: -Wall Build-Depends: - base >=3 && <5, + base >=4.7 && <5, deepseq, primitive Exposed-modules:
