Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch : new-typeable
http://hackage.haskell.org/trac/ghc/changeset/30d714f914c53df3a4a632f8950c71000498cdae >--------------------------------------------------------------- commit 30d714f914c53df3a4a632f8950c71000498cdae Author: Jose Pedro Magalhaes <[email protected]> Date: Wed Oct 3 13:55:45 2012 +0100 Use the kind-polymorphic Typeable class >--------------------------------------------------------------- Data/Vector/Generic.hs | 4 ++-- Data/Vector/Unboxed/Base.hs | 10 +++++----- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs index b8f2e81..96b76d1 100644 --- a/Data/Vector/Generic.hs +++ b/Data/Vector/Generic.hs @@ -194,7 +194,7 @@ import Prelude hiding ( length, null, showsPrec ) import qualified Text.Read as Read -import Data.Typeable ( Typeable1, gcast1 ) +import Data.Typeable ( Typeable, gcast1 ) #include "vector.h" @@ -2020,7 +2020,7 @@ mkType :: String -> DataType {-# INLINE mkType #-} mkType = mkNoRepType -dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t) +dataCast :: (Vector v a, Data a, Typeable v, Typeable t) => (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..7a75ea3 100644 --- a/Data/Vector/Unboxed/Base.hs +++ b/Data/Vector/Unboxed/Base.hs @@ -29,7 +29,7 @@ import Data.Word ( Word, Word8, Word16, Word32, Word64 ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Complex -import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, +import Data.Typeable ( Typeable(..), mkTyConApp, #if MIN_VERSION_base(4,4,0) mkTyCon3 #else @@ -60,11 +60,11 @@ vectorTyCon = mkTyCon3 "vector" vectorTyCon m s = mkTyCon $ m ++ "." ++ s #endif -instance Typeable1 Vector where - typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") [] +instance Typeable Vector where + typeRep _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") [] -instance Typeable2 MVector where - typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") [] +instance Typeable MVector where + typeRep _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") [] instance (Data a, Unbox a) => Data (Vector a) where gfoldl = G.gfoldl _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
