Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/18c7aea07ad085dc341e4d89d7224f223cc9d4e5 >--------------------------------------------------------------- commit 18c7aea07ad085dc341e4d89d7224f223cc9d4e5 Author: Jose Pedro Magalhaes <[email protected]> Date: Mon Nov 21 10:47:44 2011 +0000 Rename ? to OpenKind and ?? to ArgKind The previous names were not informative at all, and now we have named kinds like Constraint and datatype promotion to kind, so we might as well name these too. I tried to update some comments to the new names, but certainly many references to the old names remain. >--------------------------------------------------------------- compiler/prelude/TysPrim.lhs | 4 ++-- compiler/typecheck/TcInteract.lhs | 2 +- compiler/typecheck/TcSimplify.lhs | 6 +++--- compiler/types/Kind.lhs | 4 ++-- compiler/types/Type.lhs | 30 +++--------------------------- compiler/types/TypeRep.lhs | 4 ++-- 6 files changed, 13 insertions(+), 37 deletions(-) diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index 1223d46..98ee6c4 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@ -303,10 +303,10 @@ constraintKindTyCon = mkKindTyCon constraintKindTyConName tySuperKind tySuperKindTyConName = mkPrimTyConName (fsLit "BOX") tySuperKindTyConKey tySuperKindTyCon anyKindTyConName = mkPrimTyConName (fsLit "AnyK") anyKindTyConKey anyKindTyCon liftedTypeKindTyConName = mkPrimTyConName (fsLit "*") liftedTypeKindTyConKey liftedTypeKindTyCon -openTypeKindTyConName = mkPrimTyConName (fsLit "?") openTypeKindTyConKey openTypeKindTyCon +openTypeKindTyConName = mkPrimTyConName (fsLit "OpenKind") openTypeKindTyConKey openTypeKindTyCon unliftedTypeKindTyConName = mkPrimTyConName (fsLit "#") unliftedTypeKindTyConKey unliftedTypeKindTyCon ubxTupleKindTyConName = mkPrimTyConName (fsLit "(#)") ubxTupleKindTyConKey ubxTupleKindTyCon -argTypeKindTyConName = mkPrimTyConName (fsLit "??") argTypeKindTyConKey argTypeKindTyCon +argTypeKindTyConName = mkPrimTyConName (fsLit "ArgKind") argTypeKindTyConKey argTypeKindTyCon constraintKindTyConName = mkPrimTyConName (fsLit "Constraint") constraintKindTyConKey constraintKindTyCon mkPrimTyConName :: FastString -> Unique -> TyCon -> Name diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index 62ad43d..cf6e8c8 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -486,7 +486,7 @@ Note [Kind errors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the wanted problem: alpha ~ (# Int, Int #) -where alpha :: ?? and (# Int, Int #) :: (#). We can't spontaneously solve this constraint, +where alpha :: ArgKind and (# Int, Int #) :: (#). We can't spontaneously solve this constraint, but we should rather reject the program that give rise to it. If 'trySpontaneousEqTwoWay' simply returns @CantSolve@ then that wanted constraint is going to propagate all the way and get quantified over in inference mode. That's bad because we do know at this point that the diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index 9a41acc..68082d4 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -1210,11 +1210,11 @@ in the cache! ------------------ defaultTyVar :: TcsUntouchables -> TcTyVar -> TcS Cts -- defaultTyVar is used on any un-instantiated meta type variables to --- default the kind of ? and ?? etc to *. This is important to ensure --- that instance declarations match. For example consider +-- default the kind of OpenKind and ArgKind etc to *. This is important to +-- ensure that instance declarations match. For example consider -- instance Show (a->b) -- foo x = show (\_ -> True) --- Then we'll get a constraint (Show (p ->q)) where p has argTypeKind (printed ??), +-- Then we'll get a constraint (Show (p ->q)) where p has kind ArgKind, -- and that won't match the typeKind (*) in the instance decl. -- See test tc217. -- diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.lhs index 31a567d..b19e2b3 100644 --- a/compiler/types/Kind.lhs +++ b/compiler/types/Kind.lhs @@ -272,7 +272,7 @@ tcIsSubKindCon kc1 kc2 | otherwise = isSubKindCon kc1 kc2 defaultKind :: Kind -> Kind --- ^ Used when generalising: default kind ? and ?? to *. +-- ^ Used when generalising: default OpenKind and ArgKind to *. -- See "Type#kind_subtyping" for more information on what that means -- When we generalise, we make generic type variables whose kind is @@ -283,7 +283,7 @@ defaultKind :: Kind -> Kind -- We want f to get type -- f :: forall (a::*). a -> Bool -- Not --- f :: forall (a::??). a -> Bool +-- f :: forall (a::ArgKind). a -> Bool -- because that would allow a call like (f 3#) as well as (f True), -- and the calling conventions differ. -- This defaulting is done in TcMType.zonkTcTyVarBndr. diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index a29e941..e09d94e 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -1510,34 +1510,10 @@ cloneTyVarBndr (TvSubst in_scope tv_env) tv uniq Kinds ~~~~~ -\begin{code} --- $kind_subtyping --- #kind_subtyping# --- There's a little subtyping at the kind level: >--------------------------------------------------------------- --- @ --- ? --- \/ \ --- \/ \ --- ?? (\#) --- \/ \ --- \* \# --- . --- Where: \* [LiftedTypeKind] means boxed type --- \# [UnliftedTypeKind] means unboxed type --- (\#) [UbxTupleKind] means unboxed tuple --- ?? [ArgTypeKind] is the lub of {\*, \#} --- ? [OpenTypeKind] means any type at all --- @ >--------------------------------------------------------------- --- In particular: >--------------------------------------------------------------- --- > error :: forall a:?. String -> a --- > (->) :: ?? -> ? -> \* --- > (\\(x::t) -> ...) >--------------------------------------------------------------- --- Where in the last example @t :: ??@ (i.e. is not an unboxed tuple) +For the description of subkinding in GHC, see + http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/TypeType#Kinds +\begin{code} type MetaKindVar = TyVar -- invariant: MetaKindVar will always be a -- TcTyVar with details MetaTv TauTv ... -- meta kind var constructors and functions are in TcType diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs index ea95c60..fdadf7f 100644 --- a/compiler/types/TypeRep.lhs +++ b/compiler/types/TypeRep.lhs @@ -620,9 +620,9 @@ pprTcApp _ pp tc [ty] | tc `hasKey` parrTyConKey = ptext (sLit "[:") <> pp TopPrec ty <> ptext (sLit ":]") | tc `hasKey` liftedTypeKindTyConKey = ptext (sLit "*") | tc `hasKey` unliftedTypeKindTyConKey = ptext (sLit "#") - | tc `hasKey` openTypeKindTyConKey = ptext (sLit "(?)") + | tc `hasKey` openTypeKindTyConKey = ptext (sLit "OpenKind") | tc `hasKey` ubxTupleKindTyConKey = ptext (sLit "(#)") - | tc `hasKey` argTypeKindTyConKey = ptext (sLit "??") + | tc `hasKey` argTypeKindTyConKey = ptext (sLit "ArgKind") | Just n <- tyConIP_maybe tc = ppr n <> ptext (sLit "::") <> pp TopPrec ty pprTcApp p pp tc tys _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
