Commit 243c72eb authored by Ryan Scott's avatar Ryan Scott Committed by Marge Bot

Mark promoted InfixT names as IsPromoted (#17394)

We applied a similar fix for `ConT` in #15572 but forgot to apply the
fix to `InfixT` as well. This patch fixes #17394 by doing just that.
parent 9de3f8b1
Pipeline #11823 failed with stages
in 2 minutes and 16 seconds
......@@ -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
......
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -ddump-splices #-}
module T17394 where
import GHC.Generics
import Language.Haskell.TH
type T1 = $(infixT (promotedT 'Nothing) '(:*:) (promotedT 'Nothing))
type T2 = $(infixT (conT ''Maybe) ''(:*:) (conT ''Maybe))
T17394.hs:10:13-65: Splicing type
infixT (conT ''Maybe) ''(:*:) (conT ''Maybe)
======>
(:*:) Maybe Maybe
T17394.hs:9:13-67: Splicing type
infixT (promotedT 'Nothing) '(:*:) (promotedT 'Nothing)
======>
'(:*:) 'Nothing 'Nothing
......@@ -487,3 +487,4 @@ test('T16976z', normal, compile_fail, [''])
test('T16980', normal, compile, [''])
test('T16980a', normal, compile_fail, [''])
test('T17296', normal, compile, ['-v0'])
test('T17394', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment