Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch : master
http://hackage.haskell.org/trac/ghc/changeset/2580e731b84b420f26ad58b5c14a97a72d26144c >--------------------------------------------------------------- commit 2580e731b84b420f26ad58b5c14a97a72d26144c Author: Bas van Dijk <[email protected]> Date: Wed Apr 13 09:16:25 2011 +0000 Fix mkNoreptype deprecation warning >--------------------------------------------------------------- Data/Vector/Generic.hs | 12 ++++++++++-- 1 files changed, 10 insertions(+), 2 deletions(-) diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs index 0767d55..1fd8937 100644 --- a/Data/Vector/Generic.hs +++ b/Data/Vector/Generic.hs @@ -182,10 +182,18 @@ import Prelude hiding ( length, null, mapM, mapM_ ) import Data.Typeable ( Typeable1, gcast1 ) -import Data.Data ( Data, DataType, mkNorepType ) #include "vector.h" +import Data.Data ( Data, DataType ) +#if MIN_VERSION_base(4,2,0) +import Data.Data ( mkNoRepType ) +#else +import Data.Data ( mkNorepType ) +mkNoRepType :: String -> DataType +mkNoRepType = mkNorepType +#endif + -- Length information -- ------------------ @@ -1794,7 +1802,7 @@ gfoldl f z v = z fromList `f` toList v mkType :: String -> DataType {-# INLINE mkType #-} -mkType = mkNorepType +mkType = mkNoRepType dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t) => (forall d. Data d => c (t d)) -> Maybe (c (v a)) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
