Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : ghc-kinds
http://hackage.haskell.org/trac/ghc/changeset/04bdf55330c061fbbe3d99a14469066714fb7f4b >--------------------------------------------------------------- commit 04bdf55330c061fbbe3d99a14469066714fb7f4b Author: Julien Cretin <[email protected]> Date: Thu Sep 22 15:01:22 2011 +0200 kind annotations to make Ptrs kind monomorphic >--------------------------------------------------------------- Data/Fixed.hs | 3 ++- GHC/ForeignPtr.hs | 4 ++-- GHC/Ptr.lhs | 6 +++--- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/Data/Fixed.hs b/Data/Fixed.hs index b1d7113..910c03a 100644 --- a/Data/Fixed.hs +++ b/Data/Fixed.hs @@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE KindSignatures #-} {-# OPTIONS -Wall -fno-warn-unused-binds #-} #ifndef __NHC__ @@ -66,7 +67,7 @@ mod' n d = n - (fromInteger f) * d where f = div' n d -- | The type parameter should be an instance of 'HasResolution'. -newtype Fixed a = MkFixed Integer +newtype Fixed (a :: *) = MkFixed Integer #ifndef __NHC__ deriving (Eq,Ord,Typeable) #else diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs index dbf6c2c..f5fa1bb 100644 --- a/GHC/ForeignPtr.hs +++ b/GHC/ForeignPtr.hs @@ -5,7 +5,7 @@ , UnboxedTuples #-} {-# OPTIONS_HADDOCK hide #-} -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, KindSignatures #-} ----------------------------------------------------------------------------- -- | @@ -72,7 +72,7 @@ import GHC.Err -- type argument of 'ForeignPtr' should normally be an instance of -- class 'Storable'. -- -data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents +data ForeignPtr (a :: *) = ForeignPtr Addr# ForeignPtrContents -- we cache the Addr# in the ForeignPtr object, but attach -- the finalizer to the IORef (or the MutableByteArray# in -- the case of a MallocPtr). The aim of the representation diff --git a/GHC/Ptr.lhs b/GHC/Ptr.lhs index e7e0b1f..d743390 100644 --- a/GHC/Ptr.lhs +++ b/GHC/Ptr.lhs @@ -1,5 +1,5 @@ \begin{code} -{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} +{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, KindSignatures #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -37,7 +37,7 @@ import Numeric ( showHex ) ------------------------------------------------------------------------ -- Data pointers. -data Ptr a = Ptr Addr# deriving (Eq, Ord) +data Ptr (a :: *) = Ptr Addr# deriving (Eq, Ord) -- ^ A value of type @'Ptr' a@ represents a pointer to an object, or an -- array of objects, which may be marshalled to or from Haskell values -- of type @a@. @@ -81,7 +81,7 @@ minusPtr (Ptr a1) (Ptr a2) = I# (minusAddr# a1 a2) ------------------------------------------------------------------------ -- Function pointers for the default calling convention. -data FunPtr a = FunPtr Addr# deriving (Eq, Ord) +data FunPtr (a :: *) = FunPtr Addr# deriving (Eq, Ord) -- ^ A value of type @'FunPtr' a@ is a pointer to a function callable -- from foreign code. The type @a@ will normally be a /foreign type/, -- a function type with zero or more arguments where _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
