Newcomer looking for help with changes to kind system
Ben Gamari
ben at smart-cactus.org
Wed Apr 7 15:29:17 UTC 2021
Shant Hairapetian <shanth2600 at gmail.com> writes:
> Hi Ben,
> Thanks for the reply
>
>> Incidentally, the collapse of LiftedRep and UnliftedRep will happen in
>> GHC 9.2 (turning into `BoxedRep :: Levity -> RuntimeRep`).
>
> Yes I believe this change was accidentally merged a few months ago then
> reverted? I will keep that in mind.
>
It was briefly accidentally merged, then reverted, then re-applied. The
final commit is 3e082f8ff5ea2f42c5e6430094683b26b5818fb8.
>> Can you provide a program that your patch rejects, as well as
>> the full error that is produced?
>
> My error is in stage 1 in the building of the ghc-bignum library. I have
> attached the full error as well as the patch itself.
>
See below.
> Thanks,
> Shant
>
>
>
> On Mon, Apr 5, 2021 at 7:41 PM Ben Gamari <ben at smart-cactus.org> wrote:
>
>> Shant Hairapetian <shanth2600 at gmail.com> writes:
>>
>> > Hello,
>> >
>> > I’m a master’s student working on implementing the changes outlined in
>> > “Kinds are Calling Conventions“ (
>> > https://www.microsoft.com/en-us/research/uploads/prod/2020/03/kacc.pdf).
>> I
>> > have been working directly with Paul Downen but have hit some roadblocks.
>> >
>> > To sum up the changes to the kind system, I am attempting to modify the
>> > “TYPE” type constructor to accept, rather than just a RuntimeRep, a
>> record
>> > type (called RuntimeInfo) comprised of a RuntimeRep and a CallingConv
>> > (calling convention). The calling convention has an “Eval” constructor
>> > which accepts a levity (effectively moving the levity information from
>> the
>> > representation to the calling convention. LiftedRep and UnliftedRep would
>> > also be collapsed into a single PtrRep constructor) and a “Call”
>> > constructor (denoting the arity of primitive, extensional functions,
>> > see: Making
>> > a Faster Curry with Extensional Types
>> > <
>> https://www.microsoft.com/en-us/research/uploads/prod/2019/07/arity-haskell-symposium-2019.pdf
>> >)
>> > which accepts a list of RuntimeRep’s. I have created and wired-in the new
>> > RuntimeInfo and CallingConv types in GHC.Builtin.Types, as well as the
>> > corresponding primitive types in GHC.Builtin.Types.Prim and have modified
>> > the “TYPE” constructor to accept a RuntimeInfo rather than a RuntimeRep.
>> >
>> Hi Shant,
>>
>> It would be helpful to have a bit more information on the nature of your
>> failure. Can you provide a program that your patch rejects, as well as
>> the full error that is produced?
>>
>> Incidentally, the collapse of LiftedRep and UnliftedRep will happen in
>> GHC 9.2 (turning into `BoxedRep :: Levity -> RuntimeRep`).
>>
>> Cheers,
>>
>> - Ben
>>
>>
>
> --
> Shant Hairapetian
>
> libraries/ghc-bignum/src/GHC/Num/WordArray.hs:78:22: error:
> • Couldn't match type: 'TupleRep ('[] @RuntimeRep)
> with: 'RInfo ('TupleRep ('[] @RuntimeRep)) 'GHC.Types.ConvEval
> Expected: (# State# s, MutableWordArray# s #)
> Actual: (# State# s, MutableByteArray# s #)
> • In the expression: newByteArray# (wordsToBytes# sz) s
> In an equation for ‘newWordArray#’:
> newWordArray# sz s = newByteArray# (wordsToBytes# sz) s
> |
> 78 | newWordArray# sz s = newByteArray# (wordsToBytes# sz) s
> | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
>
> libraries/ghc-bignum/src/GHC/Num/WordArray.hs:112:71: error:
> • Couldn't match a lifted type with an unlifted type
> When matching types
> b0 :: TYPE ('RInfo 'LiftedRep 'GHC.Types.ConvEval)
> WordArray# :: TYPE ('RInfo 'UnliftedRep 'GHC.Types.ConvEval)
> Expected: (# () | WordArray# #)
> Actual: (# () | b0 #)
> • In the expression: a
> In a case alternative: (# _, a #) -> a
> In the expression: case runRW# io of { (# _, a #) -> a }
> • Relevant bindings include
> a :: (# () | b0 #)
> (bound at libraries/ghc-bignum/src/GHC/Num/WordArray.hs:112:63)
> |
> 112 | withNewWordArrayTrimedMaybe# sz act = case runRW# io of (# _, a #) -> a
> | ^
>
> libraries/ghc-bignum/src/GHC/Num/WordArray.hs:117:40: error:
> • Couldn't match kind ‘RuntimeInfo’ with ‘RuntimeRep’
> When matching the kind of ‘'RInfo 'LiftedRep 'GHC.Types.ConvEval’
> • In the expression: ()
> In the expression: (# () | #)
> In the expression: (# s, (# () | #) #)
> |
> 117 | (# s, 0# #) -> (# s, (# () | #) #)
> | ^^
>
> libraries/ghc-bignum/src/GHC/Num/WordArray.hs:120:48: error:
> • Couldn't match kind ‘RuntimeInfo’ with ‘RuntimeRep’
> When matching kinds
> 'RInfo 'LiftedRep 'GHC.Types.ConvEval :: RuntimeInfo
> 'RInfo 'UnliftedRep 'GHC.Types.ConvEval :: RuntimeInfo
> • In the expression: ba
> In the expression: (# | ba #)
> In the expression: (# s, (# | ba #) #)
> |
> 120 | (# s, ba #) -> (# s, (# | ba #) #)
> | ^^
>
> libraries/ghc-bignum/src/GHC/Num/WordArray.hs:431:31: error:
> • Couldn't match type: 'TupleRep ('[] @RuntimeRep)
> with: 'RInfo ('TupleRep ('[] @RuntimeRep)) 'GHC.Types.ConvEval
> Expected: (# State# s, Word# #)
> Actual: (# State# s, Word# #)
> • In the expression: readWordArray# mwa i s2
> In a case alternative:
> (# s2, sz #)
> | isTrue# (i >=# sz) -> (# s2, 0## #)
> | isTrue# (i <# 0#) -> (# s2, 0## #)
> | True -> readWordArray# mwa i s2
> In the expression:
> case mwaSize# mwa s of {
> (# s2, sz #)
> | isTrue# (i >=# sz) -> (# s2, 0## #)
> | isTrue# (i <# 0#) -> (# s2, 0## #)
> | True -> readWordArray# mwa i s2 }
> |
> 431 | | True -> readWordArray# mwa i s2
> | ^^^^^^^^^^^^^^^^^^^^^^^
>
> libraries/ghc-bignum/src/GHC/Num/WordArray.hs:434:12: error:
> • Couldn't match type: 'TupleRep ('[] @RuntimeRep)
> with: 'RInfo ('TupleRep ('[] @RuntimeRep)) 'GHC.Types.ConvEval
> Expected: MutableWordArray# s
> -> Int# -> State# s -> (# State# s, Word# #)
> Actual: MutableByteArray# s
> -> Int# -> State# s -> (# State# s, Word# #)
> • In the expression: readWordArray#
> In an equation for ‘mwaRead#’: mwaRead# = readWordArray#
> |
> 434 | mwaRead# = readWordArray#
> diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
> index cf0f72c50f..78c84147cb 100644
> --- a/compiler/GHC/Builtin/Names.hs
> +++ b/compiler/GHC/Builtin/Names.hs
> @@ -1949,6 +1949,15 @@ unrestrictedFunTyConKey = mkPreludeTyConUnique 193
> multMulTyConKey :: Unique
> multMulTyConKey = mkPreludeTyConUnique 194
>
> +-- CallingConv
> +runtimeInfoTyConKey, runtimeInfoDataConKey, callingConvTyConKey,
> + convEvalDataConKey, convCallDataConKey :: Unique
> +runtimeInfoTyConKey = mkPreludeTyConUnique 195
> +runtimeInfoDataConKey = mkPreludeDataConUnique 196
> +callingConvTyConKey = mkPreludeTyConUnique 197
> +convEvalDataConKey = mkPreludeDataConUnique 198
> +convCallDataConKey = mkPreludeDataConUnique 199
> +
> ---------------- Template Haskell -------------------
> -- GHC.Builtin.Names.TH: USES TyConUniques 200-299
> -----------------------------------------------------
> diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
> index d06bc4a12b..1bb6a263c6 100644
> --- a/compiler/GHC/Builtin/Types.hs
> +++ b/compiler/GHC/Builtin/Types.hs
> @@ -109,6 +109,7 @@ module GHC.Builtin.Types (
>
> -- * RuntimeRep and friends
> runtimeRepTyCon, vecCountTyCon, vecElemTyCon,
> + runtimeInfoTyCon, rInfo,
>
> runtimeRepTy, liftedRepTy, liftedRepDataCon, liftedRepDataConTyCon,
>
> @@ -131,6 +132,9 @@ module GHC.Builtin.Types (
>
> doubleElemRepDataConTy,
>
> + runtimeInfoTy, runtimeInfoDataConTyCon, callingConvTy, liftedRepEvalTy,
> + convEvalDataConTy,
> +
> -- * Multiplicity and friends
> multiplicityTyConName, oneDataConName, manyDataConName, multiplicityTy,
> multiplicityTyCon, oneDataCon, manyDataCon, oneDataConTy, manyDataConTy,
> @@ -189,6 +193,7 @@ import GHC.Utils.Outputable
> import GHC.Utils.Misc
> import GHC.Utils.Panic
>
> +import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp))
> import qualified Data.ByteString.Char8 as BS
>
> import Data.List ( elemIndex )
> @@ -266,6 +271,8 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they
> , multiplicityTyCon
> , naturalTyCon
> , integerTyCon
> + , runtimeInfoTyCon
> + , callingConvTyCon
> ]
>
> mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
> @@ -689,7 +696,7 @@ constraintKindTyCon :: TyCon
> constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] []
>
> liftedTypeKind, typeToTypeKind, constraintKind :: Kind
> -liftedTypeKind = tYPE liftedRepTy
> +liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon []
> typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind
> constraintKind = mkTyConApp constraintKindTyCon []
>
> @@ -1027,7 +1034,7 @@ cTupleArr = listArray (0,mAX_CTUPLE_SIZE) [mk_ctuple i | i <- [0..mAX_CTUPLE_SIZ
> -- [IntRep, LiftedRep])@
> unboxedTupleSumKind :: TyCon -> [Type] -> Kind
> unboxedTupleSumKind tc rr_tys
> - = tYPE (mkTyConApp tc [mkPromotedListTy runtimeRepTy rr_tys])
> + = tYPE $ mkTyConApp runtimeInfoDataConTyCon [(mkTyConApp tc [mkPromotedListTy runtimeRepTy rr_tys]), convEvalDataConTy]
>
> -- | Specialization of 'unboxedTupleSumKind' for tuples
> unboxedTupleKind :: [Type] -> Kind
> @@ -1064,7 +1071,7 @@ mk_tuple Unboxed arity = (tycon, tuple_con)
>
> -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
> -- Kind: forall (k1:RuntimeRep) (k2:RuntimeRep). TYPE k1 -> TYPE k2 -> #
> - tc_binders = mkTemplateTyConBinders (replicate arity runtimeRepTy)
> + tc_binders = mkTemplateTyConBinders (replicate arity runtimeInfoTy)
> (\ks -> map tYPE ks)
>
> tc_res_kind = unboxedTupleKind rr_tys
> @@ -1388,11 +1395,11 @@ unrestrictedFunTyCon :: TyCon
> unrestrictedFunTyCon = buildSynTyCon unrestrictedFunTyConName [] arrowKind [] unrestrictedFunTy
> where arrowKind = mkTyConKind binders liftedTypeKind
> -- See also funTyCon
> - binders = [ Bndr runtimeRep1TyVar (NamedTCB Inferred)
> - , Bndr runtimeRep2TyVar (NamedTCB Inferred)
> + binders = [ Bndr runtimeInfo1TyVar (NamedTCB Inferred)
> + , Bndr runtimeInfo2TyVar (NamedTCB Inferred)
> ]
> - ++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty
> - , tYPE runtimeRep2Ty
> + ++ mkTemplateAnonTyConBinders [ tYPE runtimeInfo1Ty
> + , tYPE runtimeInfo2Ty
> ]
>
> unrestrictedFunTyConName :: Name
> @@ -1400,7 +1407,7 @@ unrestrictedFunTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "->
>
> {- *********************************************************************
> * *
> - Kinds and RuntimeRep
> + Kinds, RuntimeRep and CallingConv
> * *
> ********************************************************************* -}
>
> @@ -1413,8 +1420,8 @@ runtimeRepTy = mkTyConTy runtimeRepTyCon
> -- type Type = tYPE 'LiftedRep
> liftedTypeKindTyCon :: TyCon
> liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName
> - [] liftedTypeKind []
> - (tYPE liftedRepTy)
> + [] liftedTypeKind [] rhs
> + where rhs = TyCoRep.TyConApp tYPETyCon [mkTyConApp runtimeInfoDataConTyCon [liftedRepTy, convEvalDataConTy]]
>
> runtimeRepTyCon :: TyCon
> runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing []
> @@ -1425,13 +1432,13 @@ vecRepDataCon :: DataCon
> vecRepDataCon = pcSpecialDataCon vecRepDataConName [ mkTyConTy vecCountTyCon
> , mkTyConTy vecElemTyCon ]
> runtimeRepTyCon
> - (RuntimeRep prim_rep_fun)
> + (RuntimeInfo prim_rep_fun)
> where
> -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
> prim_rep_fun [count, elem]
> | VecCount n <- tyConRuntimeRepInfo (tyConAppTyCon count)
> , VecElem e <- tyConRuntimeRepInfo (tyConAppTyCon elem)
> - = [VecRep n e]
> + = [RInfo [(VecRep n e)] ConvEval]
> prim_rep_fun args
> = pprPanic "vecRepDataCon" (ppr args)
>
> @@ -1440,11 +1447,11 @@ vecRepDataConTyCon = promoteDataCon vecRepDataCon
>
> tupleRepDataCon :: DataCon
> tupleRepDataCon = pcSpecialDataCon tupleRepDataConName [ mkListTy runtimeRepTy ]
> - runtimeRepTyCon (RuntimeRep prim_rep_fun)
> + runtimeRepTyCon (RuntimeInfo prim_rep_fun)
> where
> -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
> prim_rep_fun [rr_ty_list]
> - = concatMap (runtimeRepPrimRep doc) rr_tys
> + = [RInfo (concatMap (runtimeRepPrimRep doc) rr_tys) ConvEval]
> where
> rr_tys = extractPromotedList rr_ty_list
> doc = text "tupleRepDataCon" <+> ppr rr_tys
> @@ -1456,11 +1463,11 @@ tupleRepDataConTyCon = promoteDataCon tupleRepDataCon
>
> sumRepDataCon :: DataCon
> sumRepDataCon = pcSpecialDataCon sumRepDataConName [ mkListTy runtimeRepTy ]
> - runtimeRepTyCon (RuntimeRep prim_rep_fun)
> + runtimeRepTyCon (RuntimeInfo prim_rep_fun)
> where
> -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
> prim_rep_fun [rr_ty_list]
> - = map slotPrimRep (ubxSumRepType prim_repss)
> + = [RInfo (map slotPrimRep (ubxSumRepType prim_repss)) ConvEval]
> where
> rr_tys = extractPromotedList rr_ty_list
> doc = text "sumRepDataCon" <+> ppr rr_tys
> @@ -1488,7 +1495,7 @@ runtimeRepSimpleDataCons@(liftedRepDataCon : _)
> runtimeRepSimpleDataConNames
> where
> mk_runtime_rep_dc primrep name
> - = pcSpecialDataCon name [] runtimeRepTyCon (RuntimeRep (\_ -> [primrep]))
> + = pcSpecialDataCon name [] runtimeRepTyCon (RuntimeInfo (\_ -> [RInfo [primrep] ConvEval]))
>
> -- See Note [Wiring in RuntimeRep]
> liftedRepDataConTy, unliftedRepDataConTy,
> @@ -1558,6 +1565,79 @@ liftedRepDataConTyCon = promoteDataCon liftedRepDataCon
> liftedRepTy :: Type
> liftedRepTy = liftedRepDataConTy
>
> +-- The type ('BoxedRep 'UnliftedRep)
> +unliftedRepTy :: Type
> +unliftedRepTy = unliftedRepDataConTy
> +
> +unliftedRepEvalTy :: Type
> +unliftedRepEvalTy = mkTyConApp runtimeInfoDataConTyCon [unliftedRepTy, convEvalDataConTy]
> +
> +liftedRepEvalTy :: Type
> +liftedRepEvalTy = mkTyConApp runtimeInfoDataConTyCon [liftedRepTy, convEvalDataConTy]
> +
> +callingConvTyConName, convEvalDataConName, convCallDataConName :: Name
> +callingConvTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "CallingConv") callingConvTyConKey callingConvTyCon
> +convEvalDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "ConvEval") convEvalDataConKey convEvalDataCon
> +-- convCallDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "ConvCall") convCallDataConKey convCallDataCon
> +convCallDataConName = undefined
> +
> +convEvalDataCon = pcSpecialDataCon convEvalDataConName [] callingConvTyCon (CallingConvInfo $ \_ -> [ConvEval])
> +
> +convEvalDataConTyCon :: TyCon
> +convEvalDataConTyCon = promoteDataCon convEvalDataCon
> +
> +convEvalDataConTy :: Type
> +convEvalDataConTy = mkTyConTy convEvalDataConTyCon
> +
> +
> +callingConvTyCon :: TyCon
> +callingConvTyCon = pcTyCon callingConvTyConName Nothing []
> + [convEvalDataCon]
> +
> +callingConvTy :: Type
> +callingConvTy = mkTyConTy callingConvTyCon
> +
> +{- *********************************************************************
> +* *
> + RuntimeInfo Types
> +* *
> +********************************************************************* -}
> +
> +runtimeInfoTyConName, runtimeInfoDataConName :: Name
> +runtimeInfoTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "RuntimeInfo") runtimeInfoTyConKey runtimeInfoTyCon
> +runtimeInfoDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "RInfo") runtimeInfoDataConKey runtimeInfoDataCon
> +
> +runtimeInfoTyCon :: TyCon
> +runtimeInfoTyCon = pcTyCon runtimeInfoTyConName Nothing []
> + [runtimeInfoDataCon]
> +
> +runtimeInfoDataCon :: DataCon
> +runtimeInfoDataCon = pcSpecialDataCon runtimeInfoDataConName [ runtimeRepTy
> + , mkTyConTy callingConvTyCon ]
> + runtimeInfoTyCon
> + (RuntimeInfo prim_info_fun)
> + where
> + -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
> + prim_info_fun tys@[rep, conv]
> + = pprPanic "here runtimeInfoDataCon" (ppr tys)
> + -- [RInfo (runtimeRepPrimRep doc rep) ConvEval]
> + where doc = text "runtimeInfoDataCon" <+> ppr tys
> + prim_info_fun args
> + = pprPanic "runtimeInfoDataCon" (ppr args)
> +
> +runtimeInfoDataConTyCon :: TyCon
> +runtimeInfoDataConTyCon = promoteDataCon runtimeInfoDataCon
> +
> +runtimeInfoDataConTy :: Type
> +runtimeInfoDataConTy = mkTyConTy runtimeInfoDataConTyCon
> +
> +runtimeInfoTy :: Type
> +runtimeInfoTy = mkTyConTy runtimeInfoTyCon
> +
> +rInfo :: Type -> Type -> Type
> +rInfo rep conv = TyCoRep.TyConApp runtimeInfoTyCon [rep, conv]
> +
> +
> {- *********************************************************************
> * *
> The boxed primitive types: Char, Int, etc
> diff --git a/compiler/GHC/Builtin/Types.hs-boot b/compiler/GHC/Builtin/Types.hs-boot
> index 000df212c3..fc82f9d7b9 100644
> --- a/compiler/GHC/Builtin/Types.hs-boot
> +++ b/compiler/GHC/Builtin/Types.hs-boot
> @@ -23,6 +23,13 @@ constraintKind :: Kind
> runtimeRepTyCon, vecCountTyCon, vecElemTyCon :: TyCon
> runtimeRepTy :: Type
>
> +
> +runtimeInfoTy, callingConvTy, convEvalDataConTy :: Type
> +
> +runtimeInfoTyCon, runtimeInfoDataConTyCon :: TyCon
> +
> +rInfo :: Type -> Type -> Type
> +
> liftedRepDataConTyCon, vecRepDataConTyCon, tupleRepDataConTyCon :: TyCon
>
> liftedRepDataConTy, unliftedRepDataConTy,
> diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs
> index fc74596e45..5fb750649c 100644
> --- a/compiler/GHC/Builtin/Types/Prim.hs
> +++ b/compiler/GHC/Builtin/Types/Prim.hs
> @@ -24,6 +24,7 @@ module GHC.Builtin.Types.Prim(
> alphaTyVarsUnliftedRep, alphaTyVarUnliftedRep,
> alphaTysUnliftedRep, alphaTyUnliftedRep,
> runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep1Ty, runtimeRep2Ty,
> + runtimeInfo1TyVar, runtimeInfo2TyVar, runtimeInfo1Ty, runtimeInfo2Ty,
> openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar,
>
> multiplicityTyVar,
> @@ -97,6 +98,7 @@ import GHC.Prelude
>
> import {-# SOURCE #-} GHC.Builtin.Types
> ( runtimeRepTy, unboxedTupleKind, liftedTypeKind
> + , runtimeInfoTy, runtimeInfoDataConTyCon, convEvalDataConTy
> , vecRepDataConTyCon, tupleRepDataConTyCon
> , liftedRepDataConTy, unliftedRepDataConTy
> , intRepDataConTy
> @@ -382,11 +384,19 @@ runtimeRep1Ty, runtimeRep2Ty :: Type
> runtimeRep1Ty = mkTyVarTy runtimeRep1TyVar
> runtimeRep2Ty = mkTyVarTy runtimeRep2TyVar
>
> +runtimeInfo1TyVar, runtimeInfo2TyVar :: TyVar
> +(runtimeInfo1TyVar : runtimeInfo2TyVar : _)
> + = drop 16 (mkTemplateTyVars (repeat runtimeInfoTy)) -- selects 'q','r'
> +
> +runtimeInfo1Ty, runtimeInfo2Ty :: Type
> +runtimeInfo1Ty = mkTyVarTy runtimeInfo1TyVar
> +runtimeInfo2Ty = mkTyVarTy runtimeInfo2TyVar
> +
> openAlphaTyVar, openBetaTyVar :: TyVar
> -- alpha :: TYPE r1
> -- beta :: TYPE r2
> [openAlphaTyVar,openBetaTyVar]
> - = mkTemplateTyVars [tYPE runtimeRep1Ty, tYPE runtimeRep2Ty]
> + = mkTemplateTyVars [tYPE runtimeInfo1Ty, tYPE runtimeInfo2Ty]
>
> openAlphaTy, openBetaTy :: Type
> openAlphaTy = mkTyVarTy openAlphaTyVar
> @@ -432,10 +442,10 @@ funTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm
> where
> -- See also unrestrictedFunTyCon
> tc_bndrs = [ mkNamedTyConBinder Required multiplicityTyVar
> - , mkNamedTyConBinder Inferred runtimeRep1TyVar
> - , mkNamedTyConBinder Inferred runtimeRep2TyVar ]
> - ++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty
> - , tYPE runtimeRep2Ty
> + , mkNamedTyConBinder Inferred runtimeInfo1TyVar
> + , mkNamedTyConBinder Inferred runtimeInfo2TyVar ]
> + ++ mkTemplateAnonTyConBinders [ tYPE runtimeInfo1Ty
> + , tYPE runtimeInfo2Ty
> ]
> tc_rep_nm = mkPrelTyConRepName funTyConName
>
> @@ -529,7 +539,7 @@ tYPETyCon :: TyCon
> tYPETyConName :: Name
>
> tYPETyCon = mkKindTyCon tYPETyConName
> - (mkTemplateAnonTyConBinders [runtimeRepTy])
> + (mkTemplateAnonTyConBinders [runtimeInfoTy])
> liftedTypeKind
> [Nominal]
> (mkPrelTyConRepName tYPETyConName)
> @@ -574,7 +584,7 @@ pcPrimTyCon name roles rep
> = mkPrimTyCon name binders result_kind roles
> where
> binders = mkTemplateAnonTyConBinders (map (const liftedTypeKind) roles)
> - result_kind = tYPE (primRepToRuntimeRep rep)
> + result_kind = tYPE $ TyConApp runtimeInfoDataConTyCon [(primRepToRuntimeRep rep), convEvalDataConTy]
>
> -- | Convert a 'PrimRep' to a 'Type' of kind RuntimeRep
> -- Defined here to avoid (more) module loops
> diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
> index 6d6dd38b29..da285a6455 100644
> --- a/compiler/GHC/Core/Make.hs
> +++ b/compiler/GHC/Core/Make.hs
> @@ -913,7 +913,7 @@ mkRuntimeErrorId name
> runtimeErrorTy :: Type
> -- forall (rr :: RuntimeRep) (a :: rr). Addr# -> a
> -- See Note [Error and friends have an "open-tyvar" forall]
> -runtimeErrorTy = mkSpecForAllTys [runtimeRep1TyVar, openAlphaTyVar]
> +runtimeErrorTy = mkSpecForAllTys [runtimeInfo1TyVar, openAlphaTyVar]
> (mkVisFunTyMany addrPrimTy openAlphaTy)
>
> {- Note [Error and friends have an "open-tyvar" forall]
> diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
> index 198b66959b..5c59548ebf 100644
> --- a/compiler/GHC/Core/TyCon.hs
> +++ b/compiler/GHC/Core/TyCon.hs
> @@ -120,6 +120,7 @@ module GHC.Core.TyCon(
>
> -- * Primitive representations of Types
> PrimRep(..), PrimElemRep(..),
> + PrimConv (..), PrimInfo (..),
> isVoidRep, isGcPtrRep,
> primRepSizeB,
> primElemRepSizeB,
> @@ -172,6 +173,10 @@ import GHC.Unit.Module
>
> import qualified Data.Data as Data
>
> +import {-# SOURCE #-} GHC.Core.Type (splitTyConApp_maybe)
> +-- import {-# SOURCE #-} GHC.Builtin.Types.Prim (mutableByteArrayPrimTyConKey)
> +import GHC.Builtin.Names
> +
> {-
> -----------------------------------------------
> Notes about type families
> @@ -1073,6 +1078,8 @@ data RuntimeRepInfo
> -- be the list of arguments to the promoted datacon.
> | VecCount Int -- ^ A constructor of @VecCount@
> | VecElem PrimElemRep -- ^ A constructor of @VecElem@
> + | RuntimeInfo ([Type] -> [PrimInfo])
> + | CallingConvInfo ([Type] -> [PrimConv])
>
> -- | Extract those 'DataCon's that we are able to learn about. Note
> -- that visibility in this sense does not correspond to visibility in
> @@ -1550,6 +1557,26 @@ primRepIsFloat DoubleRep = Just True
> primRepIsFloat (VecRep _ _) = Nothing
> primRepIsFloat _ = Just False
>
> +{-
> +************************************************************************
> +* *
> + PrimConv
> +* *
> +************************************************************************
> +
> +Note [PrimConv]
> +
> +A type for representing the calling convention of a type. Either the arity
> +for extensional functions or the levity for data terms.
> +-}
> +
> +data PrimConv =
> + ConvEval
> + -- | ConvCall [PrimRep]
> + deriving (Show)
> +
> +data PrimInfo = RInfo {reps :: [PrimRep], conv :: PrimConv}
> +
>
> {-
> ************************************************************************
> @@ -2326,11 +2353,17 @@ expandSynTyCon_maybe
>
> -- ^ Expand a type synonym application, if any
> expandSynTyCon_maybe tc tys
> + -- | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc
> + -- , Just (tc' , _) <- splitTyConApp_maybe rhs
> + -- , tc' `hasKey` (mutableByteArrayPrimTyConKey)
> + -- = pprPanic "here" (ppr tc)
> +
> | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc
> = case tys `listLengthCmp` arity of
> GT -> Just (tvs `zip` tys, rhs, drop arity tys)
> EQ -> Just (tvs `zip` tys, rhs, [])
> LT -> Nothing
> +
> | otherwise
> = Nothing
>
> diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
> index 3164e2626b..5f3ab18925 100644
> --- a/compiler/GHC/Core/Type.hs
> +++ b/compiler/GHC/Core/Type.hs
> @@ -68,6 +68,7 @@ module GHC.Core.Type (
> isPredTy,
>
> getRuntimeRep_maybe, kindRep_maybe, kindRep,
> + getRuntimeInfo, getRuntimeInfo_maybe, kindInfo,
>
> mkCastTy, mkCoercionTy, splitCastTy_maybe,
>
> @@ -125,6 +126,7 @@ module GHC.Core.Type (
> isAlgType, isDataFamilyAppType,
> isPrimitiveType, isStrictType,
> isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy,
> + isRuntimeInfoTy, isRuntimeInfoVar,
> dropRuntimeRepArgs,
> getRuntimeRep,
>
> @@ -554,6 +556,11 @@ kindRep k = case kindRep_maybe k of
> Just r -> r
> Nothing -> pprPanic "kindRep" (ppr k)
>
> +kindInfo :: HasDebugCallStack => Kind -> Type
> +kindInfo k = case kindInfo_maybe k of
> + Just r -> r
> + Nothing -> pprPanic "kindInfo" (ppr k)
> +
> -- | Given a kind (TYPE rr), extract its RuntimeRep classifier rr.
> -- For example, @kindRep_maybe * = Just LiftedRep@
> -- Returns 'Nothing' if the kind is not of form (TYPE rr)
> @@ -561,18 +568,33 @@ kindRep k = case kindRep_maybe k of
> kindRep_maybe :: HasDebugCallStack => Kind -> Maybe Type
> kindRep_maybe kind
> | TyConApp tc [arg] <- coreFullView kind
> - , tc `hasKey` tYPETyConKey = Just arg
> - | otherwise = Nothing
> + , tc `hasKey` tYPETyConKey
> + , TyConApp rinfo [rep, conv] <- coreFullView arg
> + , rinfo `hasKey` runtimeInfoDataConKey = Just rep
> + | TyConApp tc [arg] <- coreFullView kind
> + , tc `hasKey` tYPETyConKey = Just arg
> + | otherwise = Nothing
> +
> +kindInfo_maybe :: HasDebugCallStack => Kind -> Maybe Type
> +kindInfo_maybe kind
> + | TyConApp tc [arg] <- coreFullView kind
> + , tc `hasKey` tYPETyConKey
> + , TyConApp rinfo [rep, conv] <- coreFullView arg
> + , rinfo `hasKey` runtimeInfoDataConKey = Just arg
> + | TyConApp tc [arg] <- coreFullView kind
> + , tc `hasKey` tYPETyConKey = Just arg
> + | otherwise = Nothing
>
> -- | This version considers Constraint to be the same as *. Returns True
> -- if the argument is equivalent to Type/Constraint and False otherwise.
> -- See Note [Kind Constraint and kind Type]
> isLiftedTypeKind :: Kind -> Bool
> isLiftedTypeKind kind
> - = case kindRep_maybe kind of
> - Just rep -> isLiftedRuntimeRep rep
> + = case kindInfo_maybe kind of
> + Just rinfo -> isLiftedRuntimeInfo rinfo
> Nothing -> False
>
> +
> pickyIsLiftedTypeKind :: Kind -> Bool
> -- Checks whether the kind is literally
> -- TYPE LiftedRep
> @@ -599,13 +621,23 @@ isLiftedRuntimeRep rep
> , rr_tc `hasKey` liftedRepDataConKey = ASSERT( null args ) True
> | otherwise = False
>
> +isLiftedRuntimeInfo :: Type -> Bool
> +-- isLiftedRuntimeRep is true of LiftedRep :: RuntimeRep
> +-- False of type variables (a :: RuntimeRep)
> +-- and of other reps e.g. (IntRep :: RuntimeRep)
> +isLiftedRuntimeInfo rep
> + | TyConApp rr_tc [rep,conv] <- coreFullView rep
> + , rr_tc `hasKey` runtimeInfoDataConKey = isLiftedRuntimeRep rep
> + | otherwise
> + = False
> +
> -- | Returns True if the kind classifies unlifted types and False otherwise.
> -- Note that this returns False for levity-polymorphic kinds, which may
> -- be specialized to a kind that classifies unlifted types.
> isUnliftedTypeKind :: Kind -> Bool
> isUnliftedTypeKind kind
> - = case kindRep_maybe kind of
> - Just rep -> isUnliftedRuntimeRep rep
> + = case kindInfo_maybe kind of
> + Just rep -> isUnliftedRuntimeInfo rep
> Nothing -> False
>
> isUnliftedRuntimeRep :: Type -> Bool
> @@ -622,6 +654,17 @@ isUnliftedRuntimeRep rep
> | otherwise {- Variables, applications -}
> = False
>
> +isUnliftedRuntimeInfo rep
> + | TyConApp rinfo [rep, conv] <- coreFullView rep -- NB: args might be non-empty
> + , rinfo `hasKey` runtimeInfoDataConKey
> + = isUnliftedRuntimeRep rep
> + -- Avoid searching all the unlifted RuntimeRep type cons
> + -- In the RuntimeRep data type, only LiftedRep is lifted
> + -- But be careful of type families (F tys) :: RuntimeRep
> + | otherwise {- Variables, applications -}
> + = False
> +
> +
> -- | Is this the type 'RuntimeRep'?
> isRuntimeRepTy :: Type -> Bool
> isRuntimeRepTy ty
> @@ -644,6 +687,17 @@ isMultiplicityTy ty
> isMultiplicityVar :: TyVar -> Bool
> isMultiplicityVar = isMultiplicityTy . tyVarKind
>
> +-- | Is this the type 'RuntimeInfo'?
> +isRuntimeInfoTy :: Type -> Bool
> +isRuntimeInfoTy ty
> + | TyConApp tc args <- coreFullView ty
> + , tc `hasKey` runtimeInfoTyConKey = True
> + | otherwise = False
> +
> +-- | Is a tyvar of type 'RuntimeInfo'?
> +isRuntimeInfoVar :: TyVar -> Bool
> +isRuntimeInfoVar = isRuntimeInfoTy . tyVarKind
> +
> {- *********************************************************************
> * *
> mapType
> @@ -927,8 +981,8 @@ repSplitAppTy_maybe :: HasDebugCallStack => Type -> Maybe (Type,Type)
> repSplitAppTy_maybe (FunTy _ w ty1 ty2)
> = Just (TyConApp funTyCon [w, rep1, rep2, ty1], ty2)
> where
> - rep1 = getRuntimeRep ty1
> - rep2 = getRuntimeRep ty2
> + rep1 = getRuntimeInfo ty1
> + rep2 = getRuntimeInfo ty2
>
> repSplitAppTy_maybe (AppTy ty1 ty2)
> = Just (ty1, ty2)
> @@ -2049,6 +2103,10 @@ getRuntimeRep_maybe :: HasDebugCallStack
> => Type -> Maybe Type
> getRuntimeRep_maybe = kindRep_maybe . typeKind
>
> +getRuntimeInfo_maybe :: HasDebugCallStack
> + => Type -> Maybe Type
> +getRuntimeInfo_maybe = kindInfo_maybe . typeKind
> +
> -- | Extract the RuntimeRep classifier of a type. For instance,
> -- @getRuntimeRep_maybe Int = LiftedRep at . Panics if this is not possible.
> getRuntimeRep :: HasDebugCallStack => Type -> Type
> @@ -2057,6 +2115,12 @@ getRuntimeRep ty
> Just r -> r
> Nothing -> pprPanic "getRuntimeRep" (ppr ty <+> dcolon <+> ppr (typeKind ty))
>
> +getRuntimeInfo :: HasDebugCallStack => Type -> Type
> +getRuntimeInfo ty
> + = case getRuntimeInfo_maybe ty of
> + Just r -> r
> + Nothing -> pprPanic "getRuntimeInfo" (ppr ty <+> dcolon <+> ppr (typeKind ty))
> +
> isUnboxedTupleType :: Type -> Bool
> isUnboxedTupleType ty
> = tyConAppTyCon (getRuntimeRep ty) `hasKey` tupleRepDataConKey
> @@ -2584,7 +2648,9 @@ tcIsLiftedTypeKind :: Kind -> Bool
> tcIsLiftedTypeKind ty
> | Just (tc, [arg]) <- tcSplitTyConApp_maybe ty -- Note: tcSplit here
> , tc `hasKey` tYPETyConKey
> - = isLiftedRuntimeRep arg
> + , Just (rinfo, [rep, conv]) <- tcSplitTyConApp_maybe arg
> + , rinfo `hasKey` runtimeInfoDataConKey
> + = isLiftedRuntimeRep rep
> | otherwise
> = False
>
> diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
> index 9cf33aa02a..3522ad6fab 100644
> --- a/compiler/GHC/HsToCore.hs
> +++ b/compiler/GHC/HsToCore.hs
> @@ -714,7 +714,7 @@ mkUnsafeCoercePrimPair _old_id old_expr
>
> ; let [unsafe_refl_data_con] = tyConDataCons unsafe_equality_tc
>
> - rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar
> + rhs = mkLams [ runtimeInfo1TyVar, runtimeInfo2TyVar
> , openAlphaTyVar, openBetaTyVar
> , x ] $
> mkSingleAltCase scrut1
> @@ -742,10 +742,10 @@ mkUnsafeCoercePrimPair _old_id old_expr
> -- NB: UnsafeRefl :: (b ~# a) -> UnsafeEquality a b, so we have to
> -- carefully swap the arguments above
>
> - (scrut1, scrut1_ty, rr_cv_ty) = unsafe_equality runtimeRepTy
> - runtimeRep1Ty
> - runtimeRep2Ty
> - (scrut2, scrut2_ty, ab_cv_ty) = unsafe_equality (tYPE runtimeRep2Ty)
> + (scrut1, scrut1_ty, rr_cv_ty) = unsafe_equality runtimeInfoTy
> + runtimeInfo1Ty
> + runtimeInfo2Ty
> + (scrut2, scrut2_ty, ab_cv_ty) = unsafe_equality (tYPE runtimeInfo2Ty)
> (openAlphaTy `mkCastTy` alpha_co)
> openBetaTy
>
> @@ -761,7 +761,7 @@ mkUnsafeCoercePrimPair _old_id old_expr
> info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
> `setUnfoldingInfo` mkCompulsoryUnfolding' rhs
>
> - ty = mkSpecForAllTys [ runtimeRep1TyVar, runtimeRep2TyVar
> + ty = mkSpecForAllTys [ runtimeInfo1TyVar, runtimeInfo2TyVar
> , openAlphaTyVar, openBetaTyVar ] $
> mkVisFunTyMany openAlphaTy openBetaTy
>
> diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
> index 01085b3270..688d227a6e 100644
> --- a/compiler/GHC/HsToCore/Utils.hs
> +++ b/compiler/GHC/HsToCore/Utils.hs
> @@ -407,7 +407,7 @@ mkErrorAppDs err_id ty msg = do
> full_msg = showSDoc dflags (hcat [ppr src_loc, vbar, msg])
> core_msg = Lit (mkLitString full_msg)
> -- mkLitString returns a result of type String#
> - return (mkApps (Var err_id) [Type (getRuntimeRep ty), Type ty, core_msg])
> + return (mkApps (Var err_id) [Type (getRuntimeInfo ty), Type ty, core_msg])
>
> {-
> 'mkCoreAppDs' and 'mkCoreAppsDs' handle the special-case desugaring of 'seq'.
> diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
> index de0fa6f023..b6d1281684 100644
> --- a/compiler/GHC/IfaceToCore.hs
> +++ b/compiler/GHC/IfaceToCore.hs
> @@ -1438,7 +1438,7 @@ tcIfaceExpr (IfaceTuple sort args)
> ; let con_tys = map exprType args'
> some_con_args = map Type con_tys ++ args'
> con_args = case sort of
> - UnboxedTuple -> map (Type . getRuntimeRep) con_tys ++ some_con_args
> + UnboxedTuple -> map (Type . getRuntimeInfo) con_tys ++ some_con_args
> _ -> some_con_args
> -- Put the missing type arguments back in
> con_id = dataConWorkId (tyConSingleDataCon tc)
> diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
> index bf4b1c91d1..22283296e1 100644
> --- a/compiler/GHC/Tc/Gen/HsType.hs
> +++ b/compiler/GHC/Tc/Gen/HsType.hs
> @@ -1331,7 +1331,7 @@ finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind = do
> check_expected_kind (mkTyConApp tycon tau_tys) liftedTypeKind
> UnboxedTuple -> do
> let tycon = tupleTyCon Unboxed arity
> - tau_reps = map kindRep tau_kinds
> + tau_reps = map kindInfo tau_kinds
> -- See also Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
> arg_tys = tau_reps ++ tau_tys
> res_kind = unboxedTupleKind tau_reps
> @@ -1340,7 +1340,8 @@ finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind = do
> where
> arity = length tau_tys
> check_expected_kind ty act_kind =
> - checkExpectedKind rn_ty ty act_kind exp_kind
> + pprPanic "here" (ppr exp_kind)
> + -- checkExpectedKind rn_ty ty act_kind exp_kind
>
> {-
> Note [Ignore unary constraint tuples]
> diff --git a/compiler/GHC/Tc/Instance/Typeable.hs b/compiler/GHC/Tc/Instance/Typeable.hs
> index e4eb7a1b2d..51f0816860 100644
> --- a/compiler/GHC/Tc/Instance/Typeable.hs
> +++ b/compiler/GHC/Tc/Instance/Typeable.hs
> @@ -28,7 +28,7 @@ import GHC.Builtin.Names
> import GHC.Builtin.Types.Prim ( primTyCons )
> import GHC.Builtin.Types
> ( tupleTyCon, sumTyCon, runtimeRepTyCon
> - , vecCountTyCon, vecElemTyCon
> + , runtimeInfoTyCon, vecCountTyCon, vecElemTyCon
> , nilDataCon, consDataCon )
> import GHC.Types.Name
> import GHC.Types.Id
> @@ -564,7 +564,7 @@ mkKindRepRhs stuff@(Stuff {..}) in_scope = new_kind_rep
> | not (tcIsConstraintKind k)
> -- Typeable respects the Constraint/Type distinction
> -- so do not follow the special case here
> - , Just arg <- kindRep_maybe k
> + , Just arg <- kindInfo_maybe k
> , Just (tc, []) <- splitTyConApp_maybe arg
> , Just dc <- isPromotedDataCon_maybe tc
> = return $ nlHsDataCon kindRepTYPEDataCon `nlHsApp` nlHsDataCon dc
> diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs
> index 8b21b72768..ae8609541f 100644
> --- a/compiler/GHC/Tc/Solver.hs
> +++ b/compiler/GHC/Tc/Solver.hs
> @@ -53,7 +53,7 @@ import GHC.Core.Predicate
> import GHC.Tc.Types.Origin
> import GHC.Tc.Utils.TcType
> import GHC.Core.Type
> -import GHC.Builtin.Types ( liftedRepTy, manyDataConTy )
> +import GHC.Builtin.Types ( liftedRepEvalTy, manyDataConTy )
> import GHC.Core.Unify ( tcMatchTyKi )
> import GHC.Utils.Misc
> import GHC.Utils.Panic
> @@ -2283,13 +2283,13 @@ promoteTyVarTcS tv
> -- | Like 'defaultTyVar', but in the TcS monad.
> defaultTyVarTcS :: TcTyVar -> TcS Bool
> defaultTyVarTcS the_tv
> - | isRuntimeRepVar the_tv
> + | isRuntimeInfoVar the_tv
> , not (isTyVarTyVar the_tv)
> -- TyVarTvs should only be unified with a tyvar
> -- never with a type; c.f. GHC.Tc.Utils.TcMType.defaultTyVar
> -- and Note [Inferring kinds for type declarations] in GHC.Tc.TyCl
> - = do { traceTcS "defaultTyVarTcS RuntimeRep" (ppr the_tv)
> - ; unifyTyVar the_tv liftedRepTy
> + = do { traceTcS "defaultTyVarTcS RuntimeInfo" (ppr the_tv)
> + ; unifyTyVar the_tv liftedRepEvalTy
> ; return True }
> | isMultiplicityVar the_tv
> , not (isTyVarTyVar the_tv) -- TyVarTvs should only be unified with a tyvar
> diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
> index 3f5b10f343..de9f28fbd9 100644
> --- a/compiler/GHC/Tc/TyCl/PatSyn.hs
> +++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
> @@ -756,7 +756,7 @@ tcPatSynMatcher (L loc name) lpat
> (args, arg_tys) pat_ty
> = do { rr_name <- newNameAt (mkTyVarOcc "rep") loc
> ; tv_name <- newNameAt (mkTyVarOcc "r") loc
> - ; let rr_tv = mkTyVar rr_name runtimeRepTy
> + ; let rr_tv = mkTyVar rr_name runtimeInfoTy
> rr = mkTyVarTy rr_tv
> res_tv = mkTyVar tv_name (tYPE rr)
> res_ty = mkTyVarTy res_tv
> diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs
> index ccb9152e01..67295ac3f5 100644
> --- a/compiler/GHC/Tc/Utils/TcMType.hs
> +++ b/compiler/GHC/Tc/Utils/TcMType.hs
> @@ -492,7 +492,7 @@ inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl
> Just ty -> do { ensureMonoType ty
> -- See Note [inferResultToType]
> ; return ty }
> - Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy
> + Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeInfoTy
> ; tau <- newMetaTyVarTyAtLevel tc_lvl (tYPE rr)
> -- See Note [TcLevel of ExpType]
> ; writeMutVar ref (Just tau)
> @@ -667,10 +667,10 @@ promoteTcType dest_lvl ty
> else promote_it }
> where
> promote_it :: TcM (TcCoercion, TcType)
> - promote_it -- Emit a constraint (alpha :: TYPE rr) ~ ty
> + promote_it -- Emit a constraint (alpha :: TYPE ri) ~ ty
> -- where alpha and rr are fresh and from level dest_lvl
> - = do { rr <- newMetaTyVarTyAtLevel dest_lvl runtimeRepTy
> - ; prom_ty <- newMetaTyVarTyAtLevel dest_lvl (tYPE rr)
> + = do { ri <- newMetaTyVarTyAtLevel dest_lvl runtimeInfoTy
> + ; prom_ty <- newMetaTyVarTyAtLevel dest_lvl (tYPE ri)
> ; let eq_orig = TypeEqOrigin { uo_actual = ty
> , uo_expected = prom_ty
> , uo_thing = Nothing
> @@ -1048,7 +1048,7 @@ newFlexiTyVarTys n kind = replicateM n (newFlexiTyVarTy kind)
>
> newOpenTypeKind :: TcM TcKind
> newOpenTypeKind
> - = do { rr <- newFlexiTyVarTy runtimeRepTy
> + = do { rr <- newFlexiTyVarTy runtimeInfoTy
> ; return (tYPE rr) }
>
> -- | Create a tyvar that can be a lifted or unlifted type.
> @@ -1765,11 +1765,16 @@ defaultTyVar default_kind tv
> -- See Note [Inferring kinds for type declarations] in GHC.Tc.TyCl
> = return False
>
> + | isRuntimeInfoVar tv -- Do not quantify over a RuntimeRep var
> + -- unless it is a TyVarTv, handled earlier
> + = do { traceTc "Defaulting a RuntimeRep var to LiftedRep" (ppr tv)
> + ; writeMetaTyVar tv liftedRepEvalTy
> + ; return True }
>
> | isRuntimeRepVar tv -- Do not quantify over a RuntimeRep var
> -- unless it is a TyVarTv, handled earlier
> = do { traceTc "Defaulting a RuntimeRep var to LiftedRep" (ppr tv)
> - ; writeMetaTyVar tv liftedRepTy
> + ; writeMetaTyVar tv liftedRepEvalTy
I believe your bug is here. You have filled in a RuntimeRep metavar with
a RuntimeInfo. Leave this as liftedRepTy.
Cheers,
- Ben
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 487 bytes
Desc: not available
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20210407/125639f2/attachment.sig>
More information about the ghc-devs
mailing list