Repository : ssh://darcs.haskell.org//srv/darcs/packages/ghc-prim On branch : ghc-kinds
http://hackage.haskell.org/trac/ghc/changeset/66ff6cbef06ff123529c28eceb343c25055b49af >--------------------------------------------------------------- commit 66ff6cbef06ff123529c28eceb343c25055b49af Author: Julien Cretin <[email protected]> Date: Thu Sep 22 15:08:19 2011 +0200 making Generics kind-monomorphic >--------------------------------------------------------------- GHC/Generics.hs | 26 ++++++++++++++------------ 1 files changed, 14 insertions(+), 12 deletions(-) diff --git a/GHC/Generics.hs b/GHC/Generics.hs index 21d4e63..a081d9d 100644 --- a/GHC/Generics.hs +++ b/GHC/Generics.hs @@ -35,35 +35,37 @@ import GHC.CString () -------------------------------------------------------------------------------- -- | Void: used for datatypes without constructors -data V1 p +data V1 (p :: *) +-- The kind annotation prevents V1 from being kind polymorphic. +-- The same appies for the declarations below. -- | Unit: used for constructors without arguments -data U1 p = U1 +data U1 (p :: *) = U1 -- | Used for marking occurrences of the parameter newtype Par1 p = Par1 { unPar1 :: p } -- | Recursive calls of kind * -> * -newtype Rec1 f p = Rec1 { unRec1 :: f p } +newtype Rec1 f (p :: *) = Rec1 { unRec1 :: f p } -- | Constants, additional parameters and recursion of kind * -newtype K1 i c p = K1 { unK1 :: c } +newtype K1 (i :: *) c (p :: *) = K1 { unK1 :: c } -- | Meta-information (constructor names, etc.) -newtype M1 i c f p = M1 { unM1 :: f p } +newtype M1 (i :: *) (c :: *) f (p :: *) = M1 { unM1 :: f p } -- | Sums: encode choice between constructors infixr 5 :+: -data (:+:) f g p = L1 (f p) | R1 (g p) +data (:+:) f g (p :: *) = L1 (f p) | R1 (g p) -- | Products: encode multiple arguments to constructors infixr 6 :*: -data (:*:) f g p = f p :*: g p +data (:*:) f g (p :: *) = f p :*: g p -- | Composition of functors infixr 7 :.: -newtype (:.:) f g p = Comp1 { unComp1 :: f (g p) } +newtype (:.:) f g (p :: *) = Comp1 { unComp1 :: f (g p) } -- | Tag for K1: recursion (of kind *) data R @@ -93,7 +95,7 @@ type S1 = M1 S -- | Class for datatypes that represent datatypes -class Datatype d where +class Datatype (d :: *) where -- | The name of the datatype (unqualified) datatypeName :: t d (f :: * -> *) a -> [Char] -- | The fully-qualified name of the module where the type is declared @@ -101,7 +103,7 @@ class Datatype d where -- | Class for datatypes that represent records -class Selector s where +class Selector (s :: *) where -- | The name of the selector selName :: t s (f :: * -> *) a -> [Char] @@ -111,7 +113,7 @@ data NoSelector instance Selector NoSelector where selName _ = "" -- | Class for datatypes that represent data constructors -class Constructor c where +class Constructor (c :: *) where -- | The name of the constructor conName :: t c (f :: * -> *) a -> [Char] @@ -156,7 +158,7 @@ class Generic a where -- | Representable types of kind * -> * (not yet derivable) -class Generic1 f where +class Generic1 (f :: * -> *) where -- | Generic representation type type Rep1 f :: * -> * -- | Convert from the datatype to its representation _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
