[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