diff options
Diffstat (limited to 'compiler/types/Kind.lhs')
| -rw-r--r-- | compiler/types/Kind.lhs | 75 |
1 files changed, 38 insertions, 37 deletions
diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.lhs index 793aa4a761..04982825ac 100644 --- a/compiler/types/Kind.lhs +++ b/compiler/types/Kind.lhs @@ -3,19 +3,13 @@ % \begin{code} -{-# OPTIONS -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - +{-# LANGUAGE CPP #-} module Kind ( -- * Main data type SuperKind, Kind, typeKind, - -- Kinds - anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind, constraintKind, + -- Kinds + anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind, constraintKind, mkArrowKind, mkArrowKinds, -- Kind constructors... @@ -23,9 +17,9 @@ module Kind ( unliftedTypeKindTyCon, constraintKindTyCon, -- Super Kinds - superKind, superKindTyCon, - - pprKind, pprParendKind, + superKind, superKindTyCon, + + pprKind, pprParendKind, -- ** Deconstructing Kinds kindAppResult, synTyConResKind, @@ -41,7 +35,7 @@ module Kind ( okArrowArgKind, okArrowResultKind, isSubOpenTypeKind, isSubOpenTypeKindKey, - isSubKind, isSubKindCon, + isSubKind, isSubKindCon, tcIsSubKind, tcIsSubKindCon, defaultKind, defaultKind_maybe, @@ -62,48 +56,54 @@ import PrelNames import Outputable import Maybes( orElse ) import Util +import FastString \end{code} %************************************************************************ -%* * - Functions over Kinds -%* * +%* * + Functions over Kinds +%* * %************************************************************************ Note [Kind Constraint and kind *] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The kind Constraint is the kind of classes and other type constraints. -The special thing about types of kind Constraint is that +The special thing about types of kind Constraint is that * They are displayed with double arrow: f :: Ord a => a -> a * They are implicitly instantiated at call sites; so the type inference engine inserts an extra argument of type (Ord a) at every call site to f. -However, once type inference is over, there is *no* distinction between +However, once type inference is over, there is *no* distinction between Constraint and *. Indeed we can have coercions between the two. Consider class C a where op :: a -> a -For this single-method class we may generate a newtype, which in turn +For this single-method class we may generate a newtype, which in turn generates an axiom witnessing Ord a ~ (a -> a) so on the left we have Constraint, and on the right we have *. See Trac #7451. Bottom line: although '*' and 'Constraint' are distinct TyCons, with -distinct uniques, they are treated as equal at all times except +distinct uniques, they are treated as equal at all times except during type inference. Hence cmpTc treats them as equal. \begin{code} -- | Essentially 'funResultTy' on kinds handling pi-types too -kindFunResult :: Kind -> KindOrType -> Kind -kindFunResult (FunTy _ res) _ = res -kindFunResult (ForAllTy kv res) arg = substKiWith [kv] [arg] res -kindFunResult k _ = pprPanic "kindFunResult" (ppr k) - -kindAppResult :: Kind -> [Type] -> Kind -kindAppResult k [] = k -kindAppResult k (a:as) = kindAppResult (kindFunResult k a) as +kindFunResult :: SDoc -> Kind -> KindOrType -> Kind +kindFunResult _ (FunTy _ res) _ = res +kindFunResult _ (ForAllTy kv res) arg = substKiWith [kv] [arg] res +#ifdef DEBUG +kindFunResult doc k _ = pprPanic "kindFunResult" (ppr k $$ doc) +#else +-- Without DEBUG, doc becomes an unsed arg, and will be optimised away +kindFunResult _ _ _ = panic "kindFunResult" +#endif + +kindAppResult :: SDoc -> Kind -> [Type] -> Kind +kindAppResult _ k [] = k +kindAppResult doc k (a:as) = kindAppResult doc (kindFunResult doc k a) as -- | Essentially 'splitFunTys' on kinds splitKindFunTys :: Kind -> ([Kind],Kind) @@ -122,12 +122,13 @@ splitKindFunTysN n (FunTy a r) = case splitKindFunTysN (n-1) r of (as, k) -> (a:as, k) splitKindFunTysN n k = pprPanic "splitKindFunTysN" (ppr n <+> ppr k) --- | Find the result 'Kind' of a type synonym, +-- | Find the result 'Kind' of a type synonym, -- after applying it to its 'arity' number of type variables --- Actually this function works fine on data types too, +-- Actually this function works fine on data types too, -- but they'd always return '*', so we never need to ask synTyConResKind :: TyCon -> Kind -synTyConResKind tycon = kindAppResult (tyConKind tycon) (map mkTyVarTy (tyConTyVars tycon)) +synTyConResKind tycon = kindAppResult (ptext (sLit "synTyConResKind") <+> ppr tycon) + (tyConKind tycon) (map mkTyVarTy (tyConTyVars tycon)) -- | See "Type#kind_subtyping" for details of the distinction between these 'Kind's isOpenTypeKind, isUnliftedTypeKind, @@ -204,7 +205,7 @@ isSubOpenTypeKindKey uniq || uniq == constraintKindTyConKey -- Needed for error (Num a) "blah" -- and so that (Ord a -> Eq a) is well-kinded -- and so that (# Eq a, Ord b #) is well-kinded - -- See Note [Kind Constraint and kind *] + -- See Note [Kind Constraint and kind *] -- | Is this a kind (i.e. a type-of-types)? isKind :: Kind -> Bool @@ -235,7 +236,7 @@ isSubKindCon :: TyCon -> TyCon -> Bool -- See Note [GHC Formalism] in coreSyn/CoreLint.lhs isSubKindCon kc1 kc2 | kc1 == kc2 = True - | isOpenTypeKindCon kc2 = isSubOpenTypeKindCon kc1 + | isOpenTypeKindCon kc2 = isSubOpenTypeKindCon kc1 | isConstraintKindCon kc1 = isLiftedTypeKindCon kc2 | isLiftedTypeKindCon kc1 = isConstraintKindCon kc2 -- See Note [Kind Constraint and kind *] @@ -279,11 +280,11 @@ defaultKind_maybe :: Kind -> Maybe Kind -- simple (* or *->* etc). So generic type variables (other than -- built-in constants like 'error') always have simple kinds. This is important; -- consider --- f x = True +-- f x = True -- We want f to get type --- f :: forall (a::*). a -> Bool --- Not --- f :: forall (a::ArgKind). a -> Bool +-- f :: forall (a::*). a -> Bool +-- Not +-- 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. |