diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/basicTypes/MkId.hs | 8 | ||||
| -rw-r--r-- | compiler/basicTypes/PatSyn.hs | 4 | ||||
| -rw-r--r-- | compiler/coreSyn/CoreSyn.hs | 6 | ||||
| -rw-r--r-- | compiler/coreSyn/MkCore.hs | 6 | ||||
| -rw-r--r-- | compiler/ghci/ByteCodeGen.hs | 4 | ||||
| -rw-r--r-- | compiler/hsSyn/HsUtils.hs | 2 | ||||
| -rw-r--r-- | compiler/iface/IfaceType.hs | 29 | ||||
| -rw-r--r-- | compiler/prelude/PrelNames.hs | 9 | ||||
| -rw-r--r-- | compiler/prelude/TysPrim.hs | 82 | ||||
| -rw-r--r-- | compiler/prelude/TysWiredIn.hs | 38 | ||||
| -rw-r--r-- | compiler/prelude/TysWiredIn.hs-boot | 1 | ||||
| -rw-r--r-- | compiler/simplStg/RepType.hs | 10 | ||||
| -rw-r--r-- | compiler/typecheck/TcExpr.hs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcMType.hs | 8 | ||||
| -rw-r--r-- | compiler/typecheck/TcPatSyn.hs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcSimplify.hs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcTyClsDecls.hs | 4 | ||||
| -rw-r--r-- | compiler/typecheck/TcType.hs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcUnify.hs | 8 | ||||
| -rw-r--r-- | compiler/typecheck/TcValidity.hs | 2 | ||||
| -rw-r--r-- | compiler/types/Kind.hs | 14 | ||||
| -rw-r--r-- | compiler/types/TyCoRep.hs | 22 | ||||
| -rw-r--r-- | compiler/types/TyCon.hs | 7 | ||||
| -rw-r--r-- | compiler/types/Type.hs | 10 |
24 files changed, 149 insertions, 133 deletions
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 002132acd2..7824b5a141 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -1114,10 +1114,10 @@ unsafeCoerceId `setUnfoldingInfo` mkCompulsoryUnfolding rhs -- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) - -- (a :: TYPEvis r1) (b :: TYPEvis r2). + -- (a :: TYPE r1) (b :: TYPE r2). -- a -> b bndrs = mkTemplateKiTyVars [runtimeRepTy, runtimeRepTy] - (\ks -> map tYPEvis ks) + (\ks -> map tYPE ks) [_, _, a, b] = mkTyVarTys bndrs @@ -1301,7 +1301,7 @@ unboxed values (unsafeCoerce 3#). In contrast unsafeCoerce# is even more dangerous because you *can* use it on unboxed things, (unsafeCoerce# 3#) :: Int. Its type is - forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a: TYPEvis r1) (b: TYPEvis r2). a -> b + forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a: TYPE r1) (b: TYPE r2). a -> b Note [seqId magic] ~~~~~~~~~~~~~~~~~~ @@ -1464,7 +1464,7 @@ no further floating will occur. This allows us to safely inline things like While the definition of @GHC.Magic.runRW#@, we override its type in @MkId@ to be open-kinded, - runRW# :: forall (r1 :: RuntimeRep). (o :: TYPEvis r) + runRW# :: forall (r1 :: RuntimeRep). (o :: TYPE r) => (State# RealWorld -> (# State# RealWorld, o #)) -> (# State# RealWorld, o #) diff --git a/compiler/basicTypes/PatSyn.hs b/compiler/basicTypes/PatSyn.hs index 0e85bf25d6..823c838c05 100644 --- a/compiler/basicTypes/PatSyn.hs +++ b/compiler/basicTypes/PatSyn.hs @@ -83,7 +83,7 @@ data PatSyn -- Matcher function. -- If Bool is True then prov_theta and arg_tys are empty -- and type is - -- forall (p :: RuntimeRep) (r :: TYPEvis p) univ_tvs. + -- forall (p :: RuntimeRep) (r :: TYPE p) univ_tvs. -- req_theta -- => res_ty -- -> (forall ex_tvs. Void# -> r) @@ -91,7 +91,7 @@ data PatSyn -- -> r -- -- Otherwise type is - -- forall (p :: RuntimeRep) (r :: TYPEvis r) univ_tvs. + -- forall (p :: RuntimeRep) (r :: TYPE r) univ_tvs. -- req_theta -- => res_ty -- -> (forall ex_tvs. prov_theta => arg_tys -> r) diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 2a5752ccb7..00b778a253 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -439,12 +439,12 @@ The levity-polymorphism invariants are these: * The type of a term-binder must not be levity-polymorphic * The type of the argument of an App must not be levity-polymorphic. -A type (t::TYPE v r) is "levity polymorphic" if 'r' has any free variables. +A type (t::TYPEV v r) is "levity polymorphic" if 'r' has any free variables. (It's OK from the code generator's point-of-view if v has free variables.) For example - \(r::RuntimeRep). \(a::TYPEvis r). \(x::a). e -is illegal because x's type has kind (TYPEvis r), which has 'r' free. + \(r::RuntimeRep). \(a::TYPE r). \(x::a). e +is illegal because x's type has kind (TYPE r), which has 'r' free. See Note [Levity polymorphism checking] in DsMonad to see where these invariants are established for user-written code. diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 0795f1840d..faf32d9375 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -725,7 +725,7 @@ tYPE_ERROR_ID = mkRuntimeErrorId typeErrorName mkRuntimeErrorId :: Name -> Id -- Error function --- with type: forall (r:RuntimeRep) (a:TYPEvis r). Addr# -> a +-- with type: forall (r:RuntimeRep) (a:TYPE r). Addr# -> a -- with arity: 1 -- which diverges after being given one argument -- The Addr# is expected to be the address of @@ -757,8 +757,8 @@ mkRuntimeErrorId name {- Note [Error and friends have an "open-tyvar" forall] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 'error' and 'undefined' have types - error :: forall (v :: RuntimeRep) (a :: TYPEvis v). String -> a - undefined :: forall (v :: RuntimeRep) (a :: TYPEvis v). a + error :: forall (v :: RuntimeRep) (a :: TYPE v). String -> a + undefined :: forall (v :: RuntimeRep) (a :: TYPE v). a Notice the levity polymorphism. This ensures that "error" can be instantiated at unboxed as well as boxed types. This is OK because it never returns, so the return type is irrelevant. diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index faaad709ea..f4b224d2a5 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -553,10 +553,10 @@ schemeE d s p exp@(AnnTick (Breakpoint _id _fvs) _rhs) -- type and hence won't be bound in the environment, but the -- breakpoint will otherwise work fine. -- - -- NB (Trac #12007) this /also/ applies for if (ty :: TYPEvis r), where + -- NB (Trac #12007) this /also/ applies for if (ty :: TYPE r), where -- r :: RuntimeRep is a variable. This can happen in the -- continuations for a pattern-synonym matcher - -- match = /\(r::RuntimeRep) /\(a::TYPEvis r). + -- match = /\(r::RuntimeRep) /\(a::TYPE r). -- \(k :: Int -> a) \(v::T). -- case v of MkV n -> k n -- Here (k n) :: a :: Type r, so we don't know if it's lifted diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index 25529a8c26..58948cc862 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -819,7 +819,7 @@ care about the strictness of the type after the =>. For checked types This matters. If we don't separate out the AbsBindsSig case, then GHC runs into a problem when compiling - undefined :: forall (r :: RuntimeRep) (a :: TYPEvis r). HasCallStack => a + undefined :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a Looking only after the =>, we cannot tell if this is strict or not. (GHC panics if you try.) Looking at the whole type, on the other hand, tells you that this diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 5371a93a89..6672d85f93 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -295,7 +295,7 @@ isIfaceLiftedTypeKind (IfaceTyConApp tc ITC_Nil) isIfaceLiftedTypeKind (IfaceTyConApp tc (ITC_Vis (IfaceTyConApp vis ITC_Nil) (ITC_Vis (IfaceTyConApp ptr_rep_lifted ITC_Nil) ITC_Nil))) - = tc `ifaceTyConHasKey` tYPETyConKey + = tc `ifaceTyConHasKey` tYPEVTyConKey && vis `ifaceTyConHasKey` visibleDataConKey && ptr_rep_lifted `ifaceTyConHasKey` liftedRepDataConKey isIfaceLiftedTypeKind _ = False @@ -732,7 +732,7 @@ understandable push-back from those with pedagogy in mind, who argued that RuntimeRep variables would throw a wrench into nearly any teach approach since they appear in even the lowly ($) function's type, - ($) :: forall (w :: RuntimeRep) a (b :: TYPEvis w). (a -> b) -> a -> b + ($) :: forall (w :: RuntimeRep) a (b :: TYPE w). (a -> b) -> a -> b which is significantly less readable than its non levity-polymorphic type of @@ -752,7 +752,7 @@ PtrLiftedRep. This is done in a pass right before pretty-printing -- to 'Visible'. e.g. -- -- @ --- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPEvis r). +-- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r). -- (a -> b) -> a -> b -- @ -- @@ -983,16 +983,10 @@ pprTyTcApp' ctxt_prec tc tys dflags style , ITC_Invis _ (ITC_Vis ty1 (ITC_Vis ty2 ITC_Nil)) <- tys = pprIfaceTyList ctxt_prec ty1 ty2 - | tc `ifaceTyConHasKey` tYPETyConKey - , ITC_Vis (IfaceTyConApp vis ITC_Nil) (ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil) <- tys - , vis `ifaceTyConHasKey` visibleDataConKey - , rep `ifaceTyConHasKey` liftedRepDataConKey + | is_known_kind tc tys visibleDataConKey liftedRepDataConKey = kindStar - | tc `ifaceTyConHasKey` tYPETyConKey - , ITC_Vis (IfaceTyConApp vis ITC_Nil) (ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil) <- tys - , vis `ifaceTyConHasKey` invisibleDataConKey - , rep `ifaceTyConHasKey` liftedRepDataConKey + | is_known_kind tc tys invisibleDataConKey liftedRepDataConKey = text "Constraint" | not opt_PprStyle_Debug @@ -1008,6 +1002,19 @@ pprTyTcApp' ctxt_prec tc tys dflags style info = ifaceTyConInfo tc tys_wo_kinds = tcArgsIfaceTypes $ stripInvisArgs dflags tys + is_known_kind tc tys vis_key rep_key + | tc `ifaceTyConHasKey` tYPEVTyConKey + , ITC_Vis (IfaceTyConApp vis ITC_Nil) + (ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil) <- tys + = vis `ifaceTyConHasKey` vis_key && rep `ifaceTyConHasKey` rep_key + + | tc `ifaceTyConHasKey` tYPESynTyConKey + , ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil <- tys + = vis_key == visibleDataConKey && rep `ifaceTyConHasKey` rep_key + + | otherwise + = False + -- | Pretty-print a type-level equality. -- -- See Note [Equality predicates in IfaceType]. diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index cea595d4b6..fcad839a02 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -1647,13 +1647,14 @@ eitherTyConKey :: Unique eitherTyConKey = mkPreludeTyConUnique 84 -- Kind constructors -liftedTypeKindTyConKey, tYPETyConKey, - constraintKindTyConKey, visibilityTyConKey, +liftedTypeKindTyConKey, tYPEVTyConKey, + constraintKindTyConKey, visibilityTyConKey, tYPESynTyConKey, starKindTyConKey, unicodeStarKindTyConKey, runtimeRepTyConKey, vecCountTyConKey, vecElemTyConKey :: Unique liftedTypeKindTyConKey = mkPreludeTyConUnique 87 -tYPETyConKey = mkPreludeTyConUnique 88 +tYPEVTyConKey = mkPreludeTyConUnique 88 visibilityTyConKey = mkPreludeTyConUnique 89 +tYPESynTyConKey = mkPreludeTyConUnique 90 constraintKindTyConKey = mkPreludeTyConUnique 92 starKindTyConKey = mkPreludeTyConUnique 93 unicodeStarKindTyConKey = mkPreludeTyConUnique 94 @@ -2317,6 +2318,6 @@ The following names should be considered by GHCi to be in scope always. pretendNameIsInScope :: Name -> Bool pretendNameIsInScope n = any (n `hasKey`) - [ starKindTyConKey, liftedTypeKindTyConKey, tYPETyConKey + [ starKindTyConKey, liftedTypeKindTyConKey, tYPEVTyConKey , runtimeRepTyConKey, liftedRepDataConKey, visibleDataConKey , visibilityTyConKey ] diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index 6992925910..d8da4795c4 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -24,10 +24,10 @@ module TysPrim( openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar, -- Kind constructors... - tYPETyConName, + tYPEVTyConName, tYPEVTyCon, -- Kinds - tYPE, tYPEvis, primRepToRuntimeRep, + tYPEV, tYPE, primRepToRuntimeRep, funTyCon, funTyConName, primTyCons, @@ -81,7 +81,7 @@ module TysPrim( #include "HsVersions.h" import {-# SOURCE #-} TysWiredIn - ( runtimeRepTy, visibilityTy, visibleDataConTy, unboxedTupleKind, liftedTypeKind + ( runtimeRepTy, visibilityTy, unboxedTupleKind, liftedTypeKind , vecRepDataConTyCon, tupleRepDataConTyCon , liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy , wordRepDataConTy, int64RepDataConTy, word64RepDataConTy, addrRepDataConTy @@ -92,7 +92,7 @@ import {-# SOURCE #-} TysWiredIn , int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy , word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy , doubleElemRepDataConTy - , mkPromotedListTy ) + , mkPromotedListTy, tYPESynTyCon ) import Var ( TyVar, mkTyVar ) import Name @@ -152,7 +152,7 @@ primTyCons , eqReprPrimTyCon , eqPhantPrimTyCon - , tYPETyCon + , tYPEVTyCon #include "primop-vector-tycons.hs-incl" ] @@ -271,8 +271,8 @@ mkTemplateKiTyVars -- Result is anon arg kinds [ak1, .., akm] -> [TyVar] -- [kv1:k1, ..., kvn:kn, av1:ak1, ..., avm:akm] -- Example: if you want the tyvars for --- forall (r:RuntimeRep) (a:TYPEvis r) (b:*). blah --- call mkTemplateKiTyVars [RuntimeRep] (\[r]. [TYPEvis r, *) +-- forall (r:RuntimeRep) (a:TYPE r) (b:*). blah +-- call mkTemplateKiTyVars [RuntimeRep] (\[r]. [TYPE r, *) mkTemplateKiTyVars kind_var_kinds mk_arg_kinds = kv_bndrs ++ tv_bndrs where @@ -311,7 +311,7 @@ runtimeRep2Ty = mkTyVarTy runtimeRep2TyVar openAlphaTyVar, openBetaTyVar :: TyVar [openAlphaTyVar,openBetaTyVar] - = mkTemplateTyVars [tYPEvis runtimeRep1Ty, tYPEvis runtimeRep2Ty] + = mkTemplateTyVars [tYPE runtimeRep1Ty, tYPE runtimeRep2Ty] openAlphaTy, openBetaTy :: Type openAlphaTy = mkTyVarTy openAlphaTyVar @@ -353,7 +353,7 @@ funTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm Note [TYPE and RuntimeRep] ~~~~~~~~~~~~~~~~~~~~~~~~~~ -All types that classify values have a kind of the form (TYPE v rr), where +All types that classify values have a kind of the form (TYPEV v rr), where data Visibility = Visible | Invisible -- Defined in ghc-prim:GHC.Types @@ -367,19 +367,19 @@ All types that classify values have a kind of the form (TYPE v rr), where rr :: RuntimeRep v :: Visibility - TYPE :: Visibility -> RuntimeRep -> TYPE 'LiftedRep -- Built in + TYPEV :: Visibility -> RuntimeRep -> TYPEV 'Visible 'LiftedRep -- Built in So for example: - Int :: TYPE 'Visible 'LiftedRep - Array# Int :: TYPE 'Visible 'UnliftedRep - Int# :: TYPE 'Visible 'IntRep - Float# :: TYPE 'Visible 'FloatRep - Maybe :: TYPE 'Visible 'LiftedRep -> TYPE 'Visible 'LiftedRep - (# , #) :: TYPE 'Visible r1 -> TYPE 'Visible r2 -> TYPE 'Visible (TupleRep [r1, r2]) - Eq :: TYPE 'Visible 'LiftedRep -> TYPE 'Invisible 'LiftedRep + Int :: TYPEV 'Visible 'LiftedRep + Array# Int :: TYPEV 'Visible 'UnliftedRep + Int# :: TYPEV 'Visible 'IntRep + Float# :: TYPEV 'Visible 'FloatRep + Maybe :: TYPEV 'Visible 'LiftedRep -> TYPEV 'Visible 'LiftedRep + (# , #) :: TYPEV 'Visible r1 -> TYPEV 'Visible r2 -> TYPEV 'Visible (TupleRep [r1, r2]) + Eq :: TYPEV 'Visible 'LiftedRep -> TYPEV 'Invisible 'LiftedRep We abbreviate '*' specially: - type * = TYPE 'Visible 'LiftedRep + type * = TYPEV 'Visible 'LiftedRep The 'v' parameter tells us whether arguments of a type of the kind are written visibly and 'rr' parameter tells us how the value is represented at runime. @@ -388,10 +388,10 @@ is LiftedRep. (The other possibilities are well-formed kinds, but they are empty.) Because 'Visible is the vastly common case, we define - type TYPEvis = TYPE 'Visible + type TYPE = TYPEV 'Visible Generally speaking, you can't be polymorphic in 'rr'. E.g - f :: forall (rr:RuntimeRep) (a:TYPEvis rr). a -> [a] + f :: forall (rr:RuntimeRep) (a:TYPE rr). a -> [a] f = /\(rr:RuntimeRep) (a:rr) \(a:rr). ... This is no good: we could not generate code code for 'f', because the calling convention for 'f' varies depending on whether the argument is @@ -399,22 +399,22 @@ a a Int, Int#, or Float#. (You could imagine generating specialised code, one for each instantiation of 'rr', but we don't do that.) Certain functions CAN be runtime-rep-polymorphic, because the code -generator never has to manipulate a value of type 'a :: TYPEvis rr'. +generator never has to manipulate a value of type 'a :: TYPE rr'. -* error :: forall (rr:RuntimeRep) (a:TYPEvis rr). String -> a +* error :: forall (rr:RuntimeRep) (a:TYPE rr). String -> a Code generator never has to manipulate the return value. * unsafeCoerce#, defined in MkId.unsafeCoerceId: Always inlined to be a no-op unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) - (a :: TYPEvis r1) (b :: TYPEvis r2). + (a :: TYPE r1) (b :: TYPE r2). a -> b * Unboxed tuples, and unboxed sums, defined in TysWiredIn Always inlined, and hence specialised to the call site (#,#) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) - (a :: TYPEvis r1) (b :: TYPEvis r2). - a -> b -> TYPEvis ('TupleRep '[r1, r2]) + (a :: TYPE r1) (b :: TYPE r2). + a -> b -> TYPE ('TupleRep '[r1, r2]) Note [PrimRep and kindPrimRep] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -431,7 +431,7 @@ We need to get from one to the other; that is what kindPrimRep does. Suppose we have a value (v :: t) where (t :: k) Given this kind - k = TyConApp "TYPE" [vis, rep] + k = TyConApp "TYPEV" [vis, rep] GHC needs to be able to figure out how 'v' is represented at runtime. It expects 'rep' to be form TyConApp rr_dc args @@ -441,21 +441,21 @@ PrimRep in the promoted data constructor itself: see TyCon.promDcRepInfo. -} -tYPETyCon :: TyCon -tYPETyConName :: Name +tYPEVTyCon :: TyCon +tYPEVTyConName :: Name -tYPETyCon = mkKindTyCon tYPETyConName - (mkTemplateAnonTyConBinders [visibilityTy, runtimeRepTy]) - liftedTypeKind - [Nominal] - (mkPrelTyConRepName tYPETyConName) +tYPEVTyCon = mkKindTyCon tYPEVTyConName + (mkTemplateAnonTyConBinders [visibilityTy, runtimeRepTy]) + liftedTypeKind + [Nominal] + (mkPrelTyConRepName tYPEVTyConName) -------------------------- -- ... and now their names -- If you edit these, you may need to update the GHC formalism -- See Note [GHC Formalism] in coreSyn/CoreLint.hs -tYPETyConName = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon +tYPEVTyConName = mkPrimTyConName (fsLit "TYPEV") tYPEVTyConKey tYPEVTyCon mkPrimTyConName :: FastString -> Unique -> TyCon -> Name mkPrimTyConName = mkPrimTcName BuiltInSyntax @@ -467,14 +467,14 @@ mkPrimTcName built_in_syntax occ key tycon = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (ATyCon tycon) built_in_syntax ----------------------------- --- | Given a Visibility RuntimeRep, applies TYPE to it. +-- | Given a Visibility and RuntimeRep, applies TYPEV to it. -- see Note [TYPE and RuntimeRep] -tYPE :: Type -> Type -> Type -tYPE v rr = TyConApp tYPETyCon [v, rr] +tYPEV :: Type -> Type -> Type +tYPEV v rr = TyConApp tYPEVTyCon [v, rr] --- | Like 'tYPE', but assumes 'Visible' -tYPEvis :: Type -> Type -tYPEvis = tYPE visibleDataConTy +-- | Like 'tYPEV', but assumes 'Visible' +tYPE :: Type -> Type +tYPE rep = TyConApp tYPESynTyCon [rep] {- ************************************************************************ @@ -490,7 +490,7 @@ pcPrimTyCon name roles rep = mkPrimTyCon name binders result_kind roles where binders = mkTemplateAnonTyConBinders (map (const liftedTypeKind) roles) - result_kind = tYPEvis (primRepToRuntimeRep rep) + result_kind = tYPE (primRepToRuntimeRep rep) -- | Convert a 'PrimRep' to a 'Type' of kind RuntimeRep -- Defined here to avoid (more) module loops diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 9d7d0c7648..e268f809f5 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -94,6 +94,7 @@ module TysWiredIn ( starKindTyCon, starKindTyConName, unicodeStarKindTyCon, unicodeStarKindTyConName, liftedTypeKindTyCon, constraintKindTyCon, + tYPESynTyCon, -- * Parallel arrays mkPArrTy, @@ -395,11 +396,12 @@ typeSymbolKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Symbol") constraintKindTyConName :: Name constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constraint") constraintKindTyConKey constraintKindTyCon -liftedTypeKindTyConName, starKindTyConName, unicodeStarKindTyConName +liftedTypeKindTyConName, starKindTyConName, unicodeStarKindTyConName, tYPESynTyConName :: Name liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type") liftedTypeKindTyConKey liftedTypeKindTyCon starKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "*") starKindTyConKey starKindTyCon unicodeStarKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "★") unicodeStarKindTyConKey unicodeStarKindTyCon +tYPESynTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "TYPE") tYPESynTyConKey tYPESynTyCon visibilityTyConName, runtimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName :: Name visibilityTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Visibility") visibilityTyConKey visibilityTyCon @@ -580,10 +582,10 @@ typeSymbolKind = mkTyConTy typeSymbolKindCon constraintKindTyCon :: TyCon constraintKindTyCon = buildSynTyCon constraintKindTyConName [] liftedTypeKind [] - (tYPE invisibleDataConTy liftedRepTy) + (tYPEV invisibleDataConTy liftedRepTy) liftedTypeKind, constraintKind :: Kind -liftedTypeKind = tYPE visibleDataConTy liftedRepTy +liftedTypeKind = mkTyConApp liftedTypeKindTyCon [] constraintKind = mkTyConApp constraintKindTyCon [] -- mkFunKind and mkForAllKind are defined here @@ -822,11 +824,11 @@ unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mA -- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed -- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type --- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPEvis (TupleRep/SumRep +-- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPE (TupleRep/SumRep -- [IntRep, LiftedRep])@ unboxedTupleSumKind :: TyCon -> [Type] -> Kind unboxedTupleSumKind tc rr_tys - = tYPEvis (mkTyConApp tc [mkPromotedListTy runtimeRepTy rr_tys]) + = tYPE (mkTyConApp tc [mkPromotedListTy runtimeRepTy rr_tys]) -- | Specialization of 'unboxedTupleSumKind' for tuples unboxedTupleKind :: [Type] -> Kind @@ -863,12 +865,12 @@ mk_tuple Unboxed arity = (tycon, tuple_con) -- See Note [Unboxed tuple extra vars] in TyCon -- Kind: forall (v1:Visibility) (v2:Visibility) - -- (k1:RuntimeRep) (k2:RuntimeRep). TYPE v1 k1 -> TYPE v2 k2 - -- -> TYPE (TupleRep [k1, k2]) + -- (k1:RuntimeRep) (k2:RuntimeRep). TYPEV v1 k1 -> TYPEV v2 k2 + -- -> TYPEV (TupleRep [k1, k2]) tc_binders = mkTemplateTyConBinders (nOfThem arity visibilityTy ++ nOfThem arity runtimeRepTy) (\ks -> let (vs, rs) = splitAt arity ks in - zipWith tYPE vs rs) + zipWith tYPEV vs rs) tc_res_kind = unboxedTupleKind rr_tys @@ -986,7 +988,7 @@ mk_sum arity = (tycon, sum_cons) UnboxedAlgTyCon tc_binders = mkTemplateTyConBinders (nOfThem arity runtimeRepTy) - (\ks -> map tYPEvis ks) + (\ks -> map tYPE ks) tyvars = binderVars tc_binders @@ -1087,24 +1089,28 @@ visibilityTy = mkTyConTy visibilityTyCon runtimeRepTy :: Type runtimeRepTy = mkTyConTy runtimeRepTyCon -liftedTypeKindTyCon, starKindTyCon, unicodeStarKindTyCon :: TyCon +liftedTypeKindTyCon, starKindTyCon, unicodeStarKindTyCon, tYPESynTyCon :: TyCon -- Type syononyms; see Note [TYPE and RuntimeRep] in TysPrim --- type Type = TYPE 'Visible 'LiftedRep --- type * = TYPE 'Visible 'LiftedRep --- type * = TYPE 'Visible 'LiftedRep -- Unicode variant +-- type Type = TYPEV 'Visible 'LiftedRep +-- type * = TYPEV 'Visible 'LiftedRep +-- type * = TYPEV 'Visible 'LiftedRep -- Unicode variant liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName [] liftedTypeKind [] - (tYPE visibleDataConTy liftedRepTy) + (tYPE liftedRepTy) starKindTyCon = buildSynTyCon starKindTyConName [] liftedTypeKind [] - (tYPE visibleDataConTy liftedRepTy) + (tYPE liftedRepTy) unicodeStarKindTyCon = buildSynTyCon unicodeStarKindTyConName [] liftedTypeKind [] - (tYPE visibleDataConTy liftedRepTy) + (tYPE liftedRepTy) + +tYPESynTyCon = buildSynTyCon tYPESynTyConName + [] (runtimeRepTy `mkFunTy` liftedTypeKind) [] + (mkTyConApp tYPEVTyCon [visibleDataConTy]) visibilityTyCon :: TyCon visibilityTyCon = pcTyCon True visibilityTyConName Nothing [] diff --git a/compiler/prelude/TysWiredIn.hs-boot b/compiler/prelude/TysWiredIn.hs-boot index ad2b142346..e440b726ad 100644 --- a/compiler/prelude/TysWiredIn.hs-boot +++ b/compiler/prelude/TysWiredIn.hs-boot @@ -12,6 +12,7 @@ listTyCon :: TyCon typeNatKind, typeSymbolKind :: Type mkBoxedTupleTy :: [Type] -> Type +tYPESynTyCon :: TyCon liftedTypeKind :: Kind constraintKind :: Kind diff --git a/compiler/simplStg/RepType.hs b/compiler/simplStg/RepType.hs index d1759e657e..45e199148c 100644 --- a/compiler/simplStg/RepType.hs +++ b/compiler/simplStg/RepType.hs @@ -46,7 +46,7 @@ import qualified Data.IntSet as IS type NvUnaryType = Type type UnaryType = Type - -- Both are always a value type; i.e. its kind is TYPE v rr + -- Both are always a value type; i.e. its kind is TYPEV v rr -- for some rr; moreover the rr is never a variable. -- -- NvUnaryType : never an unboxed tuple or sum, or void @@ -153,7 +153,7 @@ ubxSumRepType :: [[PrimRep]] -> [SlotTy] ubxSumRepType constrs0 -- These first two cases never classify an actual unboxed sum, which always -- has at least two disjuncts. But it could happen if a user writes, e.g., - -- forall (a :: TYPEvis (SumRep [IntRep])). ... + -- forall (a :: TYPE (SumRep [IntRep])). ... -- which could never be instantiated. We still don't want to panic. | length constrs0 < 2 = [WordSlot] @@ -331,14 +331,14 @@ tyConPrimRep1 tc = case tyConPrimRep tc of [rep] -> rep _ -> pprPanic "tyConPrimRep1" (ppr tc $$ ppr (tyConPrimRep tc)) --- | Take a kind (of shape @TYPE v rr@) and produce the 'PrimRep's +-- | Take a kind (of shape @TYPEV v rr@) and produce the 'PrimRep's -- of values of types of this kind. kindPrimRep :: HasDebugCallStack => SDoc -> Kind -> [PrimRep] kindPrimRep doc ki | Just ki' <- coreView ki = kindPrimRep doc ki' kindPrimRep doc (TyConApp typ [_vis, runtime_rep]) - = ASSERT( typ `hasKey` tYPETyConKey ) + = ASSERT( typ `hasKey` tYPEVTyConKey ) runtimeRepPrimRep doc runtime_rep kindPrimRep doc ki = pprPanic "kindPrimRep" (ppr ki $$ doc) @@ -358,4 +358,4 @@ runtimeRepPrimRep doc rr_ty -- | Convert a PrimRep back to a Type. Used only in the unariser to give types -- to fresh Ids. Really, only the type's representation matters. primRepToType :: PrimRep -> Type -primRepToType = anyTypeOfKind . tYPEvis . primRepToRuntimeRep +primRepToType = anyTypeOfKind . tYPE . primRepToRuntimeRep diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 9ddfce046e..77d6a46a02 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -361,7 +361,7 @@ tcExpr expr@(OpApp arg1 op fix arg2) res_ty ; arg2' <- tcArg op arg2 arg2_sigma 2 -- Make sure that the argument type has kind '*' - -- ($) :: forall (r:RuntimeRep) (a:*) (b:TYPEvis r). (a->b) -> a -> b + -- ($) :: forall (r:RuntimeRep) (a:*) (b:TYPE r). (a->b) -> a -> b -- Eg we do not want to allow (D# $ 4.0#) Trac #5570 -- (which gives a seg fault) -- diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 86fdd02e8a..72c76f3d8e 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -417,7 +417,7 @@ inferResultToType :: InferResult -> TcM Type inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl , ir_ref = ref }) = do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy - ; tau <- newMetaTyVarTyAtLevel tc_lvl (tYPEvis rr) + ; tau <- newMetaTyVarTyAtLevel tc_lvl (tYPE rr) -- See Note [TcLevel of ExpType] ; writeMutVar ref (Just tau) ; traceTc "Forcing ExpType to be monomorphic:" @@ -787,10 +787,10 @@ newFlexiTyVarTys n kind = mapM newFlexiTyVarTy (nOfThem n kind) newOpenTypeKind :: TcM TcKind newOpenTypeKind = do { rr <- newFlexiTyVarTy runtimeRepTy - ; return (tYPEvis rr) } + ; return (tYPE rr) } -- | Create a tyvar that can be a lifted or unlifted type. --- Returns alpha :: TYPEvis kappa, where both alpha and kappa are fresh +-- Returns alpha :: TYPE kappa, where both alpha and kappa are fresh newOpenFlexiTyVarTy :: TcM TcType newOpenFlexiTyVarTy = do { kind <- newOpenTypeKind @@ -982,7 +982,7 @@ zonkQuantifiedTyVar :: Bool -- True <=> this is a kind var and -XNoPolyKind -> TcM (Maybe TcTyVar) -- The quantified type variables often include meta type variables -- we want to freeze them into ordinary type variables, and --- default their kind (e.g. from TYPEvis v to TYPEvis Lifted) +-- default their kind (e.g. from TYPE v to TYPE Lifted) -- The meta tyvar is updated to point to the new skolem TyVar. Now any -- bound occurrences of the original type variable will get zonked to -- the immutable version. diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index 8e5fe83af6..587e2b8806 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -385,7 +385,7 @@ tcPatSynMatcher (L loc name) lpat ; tv_name <- newNameAt (mkTyVarOcc "r") loc ; let rr_tv = mkTcTyVar rr_name runtimeRepTy vanillaSkolemTv rr = mkTyVarTy rr_tv - res_tv = mkTcTyVar tv_name (tYPEvis rr) vanillaSkolemTv + res_tv = mkTcTyVar tv_name (tYPE rr) vanillaSkolemTv res_ty = mkTyVarTy res_tv is_unlifted = null args && null prov_dicts (cont_args, cont_arg_tys) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 6144ad9435..9fd160d72e 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1729,7 +1729,7 @@ 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 kind (TYPEvis r), +Then we'll get a constraint (Show (p ->q)) where p has kind (TYPE r), and that won't match the typeKind (*) in the instance decl. See tests tc217 and tc175. diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index a3aea3b7ae..de866b7d84 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -273,7 +273,7 @@ Monad c in bop's type signature means that D must have kind Type->Type. Note: we don't treat type synonyms specially (we used to, in the past); in particular, even if we have a type synonym cycle, we still kind check it normally, and test for cycles later (checkSynCycles). The reason -we can get away with this is because we have more systematic TYPEvis r +we can get away with this is because we have more systematic TYPE r inference, which means that we can do unification between kinds that aren't lifted (this historically was not true.) @@ -2442,7 +2442,7 @@ checkValidClass cls -- a method cannot be levity polymorphic, as we have to store the -- method in a dictionary -- example of what this prevents: - -- class BoundedX (a :: TYPEvis r) where minBound :: a + -- class BoundedX (a :: TYPE r) where minBound :: a -- See Note [Levity polymorphism checking] in DsMonad ; checkForLevPoly empty tau1 diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 12450bcf37..9302c7c58f 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -358,7 +358,7 @@ data InferResult -- i.e. return a SigmaType , ir_ref :: IORef (Maybe TcType) } -- The type that fills in this hole should be a Type, - -- that is, its kind should be (TYPEvis rr) for some rr + -- that is, its kind should be (TYPE rr) for some rr type ExpSigmaType = ExpType type ExpRhoType = ExpType diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 4dbec9903b..076f720214 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -52,7 +52,7 @@ import Name ( isSystemName ) import Inst import TyCon import TysWiredIn -import TysPrim( tYPEvis ) +import TysPrim( tYPE ) import Var import VarSet import VarEnv @@ -917,7 +917,7 @@ promoteTcType :: TcLevel -> TcType -> TcM (TcCoercion, TcType) -- promoteTcType level ty = (co, ty') -- * Returns ty' whose max level is just 'level' -- and whose kind is ~# to the kind of 'ty' --- and whose kind has form TYPE v rr +-- and whose kind has form TYPEV v rr -- * and co :: ty ~ ty' -- * and emits constraints to justify the coercion promoteTcType dest_lvl ty @@ -930,7 +930,7 @@ promoteTcType dest_lvl ty promote_it -- Emit a constraint (alpha :: TYPE rr) ~ ty -- where alpha and rr are fresh and from level dest_lvl = do { rr <- newMetaTyVarTyAtLevel dest_lvl runtimeRepTy - ; prom_ty <- newMetaTyVarTyAtLevel dest_lvl (tYPEvis rr) + ; prom_ty <- newMetaTyVarTyAtLevel dest_lvl (tYPE rr) ; let eq_orig = TypeEqOrigin { uo_actual = ty , uo_expected = prom_ty , uo_thing = Nothing } @@ -939,7 +939,7 @@ promoteTcType dest_lvl ty ; return (co, prom_ty) } dont_promote_it :: TcM (TcCoercion, TcType) - dont_promote_it -- Check that ty :: TYPEvis rr, for some (fresh) rr + dont_promote_it -- Check that ty :: TYPE rr, for some (fresh) rr = do { res_kind <- newOpenTypeKind ; let ty_kind = typeKind ty kind_orig = TypeEqOrigin { uo_actual = ty_kind diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 15573c195a..a5bc61a31b 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -388,7 +388,7 @@ checkTySynRhs ctxt ty -- | The kind expected in a certain context. data ContextKind = TheKind Kind -- ^ a specific kind | AnythingKind -- ^ any kind will do - | OpenKind -- ^ something of the form @TYPEvis _@ + | OpenKind -- ^ something of the form @TYPE _@ -- Depending on the context, we might accept any kind (for instance, in a TH -- splice), or only certain kinds (like in type signatures). diff --git a/compiler/types/Kind.hs b/compiler/types/Kind.hs index 68ea16175f..b3b9b22afd 100644 --- a/compiler/types/Kind.hs +++ b/compiler/types/Kind.hs @@ -44,7 +44,7 @@ returnsConstraintKind = go go (FunTy _ ty) = go ty go other = isConstraintKind other --- | Tests whether the given kind (which should look like @TYPE v x@) +-- | Tests whether the given kind (which should look like @TYPEV v x@) -- is something other than a constructor tree (that is, constructors at every node). isKindLevPoly :: Kind -> Bool isKindLevPoly k = ASSERT2( _is_type k, ppr k ) @@ -65,7 +65,7 @@ isKindLevPoly k = ASSERT2( _is_type k, ppr k ) = _is_type ty' | TyConApp typ [_, _] <- ty - = typ `hasKey` tYPETyConKey + = typ `hasKey` tYPEVTyConKey | otherwise = False @@ -90,16 +90,16 @@ okArrowResultKind = classifiesTypeWithValues -- indistinguishable -- | Does this classify a type allowed to have values? Responds True to things --- like *, #, TYPEvis Lifted, TYPE v r, Constraint. +-- like *, #, TYPE Lifted, TYPEV v r, Constraint. classifiesTypeWithValues :: Kind -> Bool classifiesTypeWithValues t | Just t' <- coreView t = classifiesTypeWithValues t' -classifiesTypeWithValues (TyConApp tc [_,_]) = tc `hasKey` tYPETyConKey +classifiesTypeWithValues (TyConApp tc [_,_]) = tc `hasKey` tYPEVTyConKey classifiesTypeWithValues _ = False {- Note [Levity polymorphism] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Is this type legal? - (a :: TYPEvis rep) -> Int + (a :: TYPE rep) -> Int where 'rep :: RuntimeRep' You might think not, because no lambda can have a @@ -107,7 +107,7 @@ runtime-rep-polymorphic binder. So no lambda has the above type. BUT here's a way it can be useful (taken from Trac #12708): - data T rep (a :: TYPEvis rep) + data T rep (a :: TYPE rep) = MkT (a -> Int) x1 :: T LiftedRep Int @@ -119,6 +119,6 @@ Trac #12708): Note that the lambdas are just fine! Hence, okArrowArgKind and okArrowResultKind both just -check that the type is of the form (TYPEvis r) for some +check that the type is of the form (TYPE r) for some representation type r. -} diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index e0ea62e4c7..3e3e1366f2 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -685,23 +685,23 @@ mkTyConTy tycon = TyConApp tycon [] Some basic functions, put here to break loops eg with the pretty printer -} -is_TYPE :: ( Type -- the Visibility argument to TYPE; not a synonym - -> Type -- the RuntimeRep argument to TYPE; not a synonym - -> Bool ) -- what to return - -> Kind -> Bool -is_TYPE f ki | Just ki' <- coreView ki = is_TYPE f ki' -is_TYPE f (TyConApp tc [vis, rep]) - | tc `hasKey` tYPETyConKey +is_TYPEV :: ( Type -- the Visibility argument to TYPEV; not a synonym + -> Type -- the RuntimeRep argument to TYPEV; not a synonym + -> Bool ) -- what to return + -> Kind -> Bool +is_TYPEV f ki | Just ki' <- coreView ki = is_TYPEV f ki' +is_TYPEV f (TyConApp tc [vis, rep]) + | tc `hasKey` tYPEVTyConKey = go vis rep where go vis rep | Just vis' <- coreView vis = go vis' rep | Just rep' <- coreView rep = go vis rep' | otherwise = f vis rep -is_TYPE _ _ = False +is_TYPEV _ _ = False -- | Returns True if the argument is equivalent to Type and False otherwise. isLiftedTypeKind :: Kind -> Bool -isLiftedTypeKind = is_TYPE is_lifted +isLiftedTypeKind = is_TYPEV is_lifted where is_lifted (TyConApp vis []) (TyConApp lifted_rep []) = vis `hasKey` visibleDataConKey && lifted_rep `hasKey` liftedRepDataConKey @@ -711,14 +711,14 @@ isLiftedTypeKind = is_TYPE is_lifted -- Note that this returns False for levity-polymorphic kinds, which may -- be specialized to a kind that classifies unlifted types. isUnliftedTypeKind :: Kind -> Bool -isUnliftedTypeKind = is_TYPE is_unlifted +isUnliftedTypeKind = is_TYPEV is_unlifted where is_unlifted _ (TyConApp rr _args) = not (isLiftedRuntimeRepTyCon rr) is_unlifted _ _ = False -- | Returns True if this kind is Constraint isConstraintKind :: Kind -> Bool -isConstraintKind = is_TYPE is_constraint +isConstraintKind = is_TYPEV is_constraint where is_constraint (TyConApp invis []) (TyConApp constraint_rep []) = invis `hasKey` invisibleDataConKey && constraint_rep `hasKey` liftedRepDataConKey diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index a6f9b529dc..4a5a6a2e3f 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -346,7 +346,8 @@ the kind of the unboxed tuple constructor is levity polymorphic. For example, (#,#) :: forall (v1 :: Visibility) (v2 :: Visbiility) - (q :: RuntimeRep) (r :: RuntimeRep). TYPE v1 q -> TYPE v2 r -> # + (q :: RuntimeRep) (r :: RuntimeRep). TYPEV v1 q -> TYPEV v2 r + -> TYPE (TupleRep [q,r]) These extra tyvars cause some delicate processing around tuples, where we used to be able to assume that the tycon arity and the @@ -2007,7 +2008,7 @@ isKindTyCon tc = getUnique tc `elementOfUniqSet` kindTyConKeys kindTyConKeys :: UniqSet Unique kindTyConKeys = unionManyUniqSets ( mkUniqSet [ liftedTypeKindTyConKey, starKindTyConKey, unicodeStarKindTyConKey - , constraintKindTyConKey, tYPETyConKey ] + , constraintKindTyConKey, tYPEVTyConKey ] : map (mkUniqSet . tycon_with_datacons) [ runtimeRepTyCon, visibilityTyCon , vecCountTyCon, vecElemTyCon ] ) where @@ -2065,7 +2066,7 @@ isTcTyCon _ = False -- | Could this TyCon ever be levity-polymorphic when fully applied? -- True is safe. False means we're sure. Does only a quick check -- based on the TyCon's category. --- Precondition: The fully-applied TyCon has kind (TYPE v blah) +-- Precondition: The fully-applied TyCon has kind (TYPEV v blah) isTcLevPoly :: TyCon -> Bool isTcLevPoly FunTyCon{} = False isTcLevPoly (AlgTyCon { algTcParent = UnboxedAlgTyCon }) = True diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index a0061ce58f..10427e77b2 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1837,7 +1837,7 @@ isFamFreeTy (CoercionTy _) = False -- Not sure about this -- | Returns Just True if this type is surely lifted, Just False -- if it is surely unlifted, Nothing if we can't be sure (i.e., it is -- levity polymorphic), and panics if the kind does not have the shape --- TYPE v r. +-- TYPEV v r. isLiftedType_maybe :: HasDebugCallStack => Type -> Maybe Bool isLiftedType_maybe ty = go (getRuntimeRep "isLiftedType_maybe" ty) where @@ -1888,7 +1888,7 @@ getVisRuntimeRepFromKind err = go go k | Just k' <- coreView k = go k' go k | (_tc, [vis, arg]) <- splitTyConApp k - = ASSERT2( _tc `hasKey` tYPETyConKey, text err $$ ppr k ) + = ASSERT2( _tc `hasKey` tYPEVTyConKey, text err $$ ppr k ) (vis, arg) go k = pprPanic "getRuntimeRep" (text err $$ ppr k <+> dcolon <+> ppr (typeKind k)) @@ -2175,7 +2175,7 @@ typeLiteralKind l = -- | Returns True if a type is levity polymorphic. Should be the same -- as (isKindLevPoly . typeKind) but much faster. --- Precondition: The type has kind (TYPE v blah) +-- Precondition: The type has kind (TYPEV v blah) isTypeLevPoly :: Type -> Bool isTypeLevPoly = go where @@ -2192,8 +2192,8 @@ isTypeLevPoly = go check_kind = isKindLevPoly . typeKind -- | Looking past all pi-types, is the end result potentially levity polymorphic? --- Example: True for (forall r (a :: TYPEvis r). String -> a) --- Example: False for (forall r1 r2 (a :: TYPEvis r1) (b :: TYPEvis r2). a -> b -> Type) +-- Example: True for (forall r (a :: TYPE r). String -> a) +-- Example: False for (forall r1 r2 (a :: TYPE r1) (b :: TYPE r2). a -> b -> Type) resultIsLevPoly :: Type -> Bool resultIsLevPoly = isTypeLevPoly . snd . splitPiTys |