diff options
Diffstat (limited to 'compiler/GHC/ThToHs.hs')
| -rw-r--r-- | compiler/GHC/ThToHs.hs | 21 |
1 files changed, 13 insertions, 8 deletions
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs index 8c3e6a5f1e..29f7b1e139 100644 --- a/compiler/GHC/ThToHs.hs +++ b/compiler/GHC/ThToHs.hs @@ -1421,13 +1421,7 @@ cvtTypeKind ty_str ty VarT nm -> do { nm' <- tNameL nm ; mk_apps (HsTyVar noExtField NotPromoted nm') tys' } ConT nm -> do { nm' <- tconName nm - ; -- ConT can contain both data constructor (i.e., - -- promoted) names and other (i.e, unpromoted) - -- names, as opposed to PromotedT, which can only - -- contain data constructor names. See #15572. - let prom = if isRdrDataCon nm' - then IsPromoted - else NotPromoted + ; let prom = name_promotedness nm' ; mk_apps (HsTyVar noExtField prom (noLoc nm')) tys'} ForallT tvs cxt ty @@ -1464,8 +1458,9 @@ cvtTypeKind ty_str ty -> do { s' <- tconName s ; t1' <- cvtType t1 ; t2' <- cvtType t2 + ; let prom = name_promotedness s' ; mk_apps - (HsTyVar noExtField NotPromoted (noLoc s')) + (HsTyVar noExtField prom (noLoc s')) ([HsValArg t1', HsValArg t2'] ++ tys') } @@ -1540,6 +1535,16 @@ cvtTypeKind ty_str ty _ -> failWith (ptext (sLit ("Malformed " ++ ty_str)) <+> text (show ty)) } +-- ConT/InfixT can contain both data constructor (i.e., promoted) names and +-- other (i.e, unpromoted) names, as opposed to PromotedT, which can only +-- contain data constructor names. See #15572/#17394. We use this function to +-- determine whether to mark a name as promoted/unpromoted when dealing with +-- ConT/InfixT. +name_promotedness :: RdrName -> Hs.PromotionFlag +name_promotedness nm + | isRdrDataCon nm = IsPromoted + | otherwise = NotPromoted + -- | Constructs an application of a type to arguments passed in a list. mk_apps :: HsType GhcPs -> [LHsTypeArg GhcPs] -> CvtM (LHsType GhcPs) mk_apps head_ty type_args = do |