Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch : ghc-kinds
http://hackage.haskell.org/trac/ghc/changeset/fc0a594fa868dd4dbf20d3b55e60463586402503 >--------------------------------------------------------------- commit fc0a594fa868dd4dbf20d3b55e60463586402503 Author: Julien Cretin <[email protected]> Date: Fri Sep 23 12:51:39 2011 +0200 Kind signatures on phatom types. This is to avoid kind generalization which prevents from deriving Typeable, since only TyCons of kind * -> * ... -> * can derive Typeable. >--------------------------------------------------------------- Data/Vector/Primitive.hs | 9 +++++---- Data/Vector/Primitive/Mutable.hs | 9 +++++---- Data/Vector/Storable/Mutable.hs | 7 ++++--- 3 files changed, 14 insertions(+), 11 deletions(-) diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs index 1fe3677..2e89763 100644 --- a/Data/Vector/Primitive.hs +++ b/Data/Vector/Primitive.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables, Rank2Types #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables, Rank2Types, KindSignatures #-} -- | -- Module : Data.Vector.Primitive @@ -167,9 +167,10 @@ import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) -- | Unboxed vectors of primitive types -data Vector a = Vector {-# UNPACK #-} !Int - {-# UNPACK #-} !Int - {-# UNPACK #-} !ByteArray +data Vector (a :: *) -- Kind signature on phantom types needed to derive Typeable + = Vector {-# UNPACK #-} !Int + {-# UNPACK #-} !Int + {-# UNPACK #-} !ByteArray deriving ( Typeable ) instance (Show a, Prim a) => Show (Vector a) where diff --git a/Data/Vector/Primitive/Mutable.hs b/Data/Vector/Primitive/Mutable.hs index 447e315..2b709e2 100644 --- a/Data/Vector/Primitive/Mutable.hs +++ b/Data/Vector/Primitive/Mutable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-} +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, KindSignatures #-} -- | -- Module : Data.Vector.Primitive.Mutable @@ -63,9 +63,10 @@ import Data.Typeable ( Typeable ) #include "vector.h" -- | Mutable vectors of primitive types. -data MVector s a = MVector {-# UNPACK #-} !Int - {-# UNPACK #-} !Int - {-# UNPACK #-} !(MutableByteArray s) +data MVector s (a :: *) -- Kind signature on phantom types needed to derive Typeable + = MVector {-# UNPACK #-} !Int + {-# UNPACK #-} !Int + {-# UNPACK #-} !(MutableByteArray s) deriving ( Typeable ) type IOVector = MVector RealWorld diff --git a/Data/Vector/Storable/Mutable.hs b/Data/Vector/Storable/Mutable.hs index 5227022..76ad5d7 100644 --- a/Data/Vector/Storable/Mutable.hs +++ b/Data/Vector/Storable/Mutable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-} +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, KindSignatures #-} -- | -- Module : Data.Vector.Storable.Mutable @@ -79,8 +79,9 @@ import Data.Typeable ( Typeable ) #include "vector.h" -- | Mutable 'Storable'-based vectors -data MVector s a = MVector {-# UNPACK #-} !Int - {-# UNPACK #-} !(ForeignPtr a) +data MVector (s :: *) a -- Kind signature on phantom types needed to derive Typeable + = MVector {-# UNPACK #-} !Int + {-# UNPACK #-} !(ForeignPtr a) deriving ( Typeable ) type IOVector = MVector RealWorld _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
