Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch : new-typeable
http://hackage.haskell.org/trac/ghc/changeset/6532f7a537cf060084fd9e8d9dc264b708075eb8 >--------------------------------------------------------------- commit 6532f7a537cf060084fd9e8d9dc264b708075eb8 Author: Jose Pedro Magalhaes <[email protected]> Date: Mon Nov 26 13:54:03 2012 +0000 Replace handwritten instances of Typeable with deriving >--------------------------------------------------------------- Data/Vector/Unboxed/Base.hs | 22 ++++------------------ 1 files changed, 4 insertions(+), 18 deletions(-) diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs index 7a75ea3..81bbbc4 100644 --- a/Data/Vector/Unboxed/Base.hs +++ b/Data/Vector/Unboxed/Base.hs @@ -1,4 +1,5 @@ {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-} +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} {-# OPTIONS_HADDOCK hide #-} -- | @@ -29,13 +30,7 @@ import Data.Word ( Word, Word8, Word16, Word32, Word64 ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Complex -import Data.Typeable ( Typeable(..), mkTyConApp, -#if MIN_VERSION_base(4,4,0) - mkTyCon3 -#else - mkTyCon -#endif - ) +import Data.Typeable ( Typeable(..) ) import Data.Data ( Data(..) ) #include "vector.h" @@ -54,17 +49,8 @@ class (G.Vector Vector a, M.MVector MVector a) => Unbox a -- Data and Typeable -- ----------------- -#if MIN_VERSION_base(4,4,0) -vectorTyCon = mkTyCon3 "vector" -#else -vectorTyCon m s = mkTyCon $ m ++ "." ++ s -#endif - -instance Typeable Vector where - typeRep _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") [] - -instance Typeable MVector where - typeRep _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") [] +deriving instance Typeable Vector +deriving instance Typeable 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
