Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch : new-typeable
http://hackage.haskell.org/trac/ghc/changeset/27d80ea74b2e596fb981129ba0d64ed01d74a355 >--------------------------------------------------------------- commit 27d80ea74b2e596fb981129ba0d64ed01d74a355 Author: Jose Pedro Magalhaes <[email protected]> Date: Tue Dec 4 09:04:16 2012 +0000 Use CPP to only derive Typeable for GHC > 7.6 >--------------------------------------------------------------- Data/Vector/Generic.hs | 9 +++++++++ Data/Vector/Unboxed/Base.hs | 30 ++++++++++++++++++++++++++++-- 2 files changed, 37 insertions(+), 2 deletions(-) diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs index 96b76d1..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 81bbbc4..359b001 100644 --- a/Data/Vector/Unboxed/Base.hs +++ b/Data/Vector/Unboxed/Base.hs @@ -1,5 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-} +#if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} +#endif {-# OPTIONS_HADDOCK hide #-} -- | @@ -30,7 +32,18 @@ import Data.Word ( Word, Word8, Word16, Word32, Word64 ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Complex -import Data.Typeable ( Typeable(..) ) +#if __GLASGOW_HASKELL__ >= 707 +import Data.Typeable ( Typeable ) +#else +import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, +#if MIN_VERSION_base(4,4,0) + mkTyCon3 +#else + mkTyCon +#endif + ) +#endif + import Data.Data ( Data(..) ) #include "vector.h" @@ -48,9 +61,22 @@ 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 +vectorTyCon m s = mkTyCon $ m ++ "." ++ s +#endif + +instance Typeable1 Vector where + typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") [] + +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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
