[commit: vector] master: Implement poly-kinded Typeable (8b27167)
Simon Peyton-Jones
simonpj at microsoft.com
Tue Feb 12 12:07:06 CET 2013
Hang on... vector has an upstream repo; see
http://hackage.haskell.org/trac/ghc/wiki/Repositories
and in particular the "Upstream repo?" bullet.
So we may need to do more than push to the mirror?
Simon
| -----Original Message-----
| From: ghc-commits-bounces at haskell.org [mailto:ghc-commits-
| bounces at haskell.org] On Behalf Of José Pedro Magalhães
| Sent: 12 February 2013 10:41
| To: ghc-commits at haskell.org
| Subject: [commit: vector] master: Implement poly-kinded Typeable
| (8b27167)
|
| Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector
|
| On branch : master
|
| http://hackage.haskell.org/trac/ghc/changeset/8b271670f79a3b50d7e15ca924
| 878212f042f259
|
| >---------------------------------------------------------------
|
| commit 8b271670f79a3b50d7e15ca924878212f042f259
| Author: Jose Pedro Magalhaes <jpm at cs.ox.ac.uk>
| Date: Thu Feb 7 14:00:33 2013 +0000
|
| Implement poly-kinded Typeable
|
| This patch makes the Data.Typeable.Typeable class work with
| arguments of any
| kind. In particular, this removes the Typeable1..7 class hierarchy,
| greatly
| simplyfing the whole Typeable story. Also added is the
| AutoDeriveTypeable
| language extension, which will automatically derive Typeable for all
| types and
| classes declared in that module. Since there is now no good reason
| to give
| handwritten instances of the Typeable class, those are ignored (for
| backwards
| compatibility), and a warning is emitted.
|
| The old, kind-* Typeable class is now called OldTypeable, and lives
| in the
| Data.OldTypeable module. It is deprecated, and should be removed in
| some future
| version of GHC.
|
| >---------------------------------------------------------------
|
| Data/Vector/Generic.hs | 9 +++++++++
| Data/Vector/Unboxed/Base.hs | 14 +++++++++++++-
| 2 files changed, 22 insertions(+), 1 deletions(-)
|
| diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs index
| b8f2e81..f17ff23 100644
| --- a/Data/Vector/Generic.hs
| +++ b/Data/Vector/Generic.hs
| @@ -194,7 +194,12 @@ import Prelude hiding ( length, null,
| showsPrec )
|
| import qualified Text.Read as Read
| +
| +#if __GLASGOW_HASKELL__ >= 707
| +import Data.Typeable ( Typeable, gcast1 ) #else
| import Data.Typeable ( Typeable1, gcast1 )
| +#endif
|
| #include "vector.h"
|
| @@ -2020,7 +2025,11 @@ mkType :: String -> DataType {-# INLINE mkType
| #-} mkType = mkNoRepType
|
| +#if __GLASGOW_HASKELL__ >= 707
| +dataCast :: (Vector v a, Data a, Typeable v, Typeable t) #else
| dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t)
| +#endif
| => (forall d. Data d => c (t d)) -> Maybe (c (v a)) {-#
| INLINE dataCast #-} dataCast f = gcast1 f diff --git
| a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs index
| 2d9822e..359b001 100644
| --- a/Data/Vector/Unboxed/Base.hs
| +++ b/Data/Vector/Unboxed/Base.hs
| @@ -1,4 +1,7 @@
| {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
| +#if __GLASGOW_HASKELL__ >= 707
| +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} #endif
| {-# OPTIONS_HADDOCK hide #-}
|
| -- |
| @@ -29,6 +32,9 @@ import Data.Word ( Word, Word8, Word16, Word32, Word64
| ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Complex
|
| +#if __GLASGOW_HASKELL__ >= 707
| +import Data.Typeable ( Typeable )
| +#else
| import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, #if
| MIN_VERSION_base(4,4,0)
| mkTyCon3
| @@ -36,6 +42,8 @@ import Data.Typeable ( Typeable1(..), Typeable2(..),
| mkTyConApp,
| mkTyCon
| #endif
| )
| +#endif
| +
| import Data.Data ( Data(..) )
|
| #include "vector.h"
| @@ -53,7 +61,10 @@ class (G.Vector Vector a, M.MVector MVector a) =>
| Unbox a
| -- -----------------
| -- Data and Typeable
| -- -----------------
| -
| +#if __GLASGOW_HASKELL__ >= 707
| +deriving instance Typeable Vector
| +deriving instance Typeable MVector
| +#else
| #if MIN_VERSION_base(4,4,0)
| vectorTyCon = mkTyCon3 "vector"
| #else
| @@ -65,6 +76,7 @@ instance Typeable1 Vector where
|
| instance Typeable2 MVector where
| typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable"
| "MVector") []
| +#endif
|
| instance (Data a, Unbox a) => Data (Vector a) where
| gfoldl = G.gfoldl
|
|
|
| _______________________________________________
| ghc-commits mailing list
| ghc-commits at haskell.org
| http://www.haskell.org/mailman/listinfo/ghc-commits
More information about the ghc-devs
mailing list