diff options
| author | sheaf <sam.derbyshire@gmail.com> | 2022-04-01 12:02:46 +0200 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2022-04-01 11:17:56 +0100 |
| commit | d85c7dcb7c457efc23b20ac8f4e4ae88bae5b050 (patch) | |
| tree | 6a052785be9dd3b67e42637102de21f0630f6ddf /compiler/GHC/Parser.y | |
| parent | 950f58e7bf584ec6970327ac7c7ae3f3fdbc9882 (diff) | |
| download | haskell-d85c7dcb7c457efc23b20ac8f4e4ae88bae5b050.tar.gz | |
Keep track of promotion ticks in HsOpTywip/no-c-stubswip/matt-merge-batch
This patch adds a PromotionFlag field to HsOpTy, which is used
in pretty-printing and when determining whether to emit warnings
with -fwarn-unticked-promoted-constructors.
This allows us to correctly report tick-related warnings for things
like:
type A = Int : '[]
type B = [Int, Bool]
Updates haddock submodule
Fixes #19984
Diffstat (limited to 'compiler/GHC/Parser.y')
| -rw-r--r-- | compiler/GHC/Parser.y | 23 |
1 files changed, 13 insertions, 10 deletions
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index af6bb3d51a..55052f0df6 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -2168,14 +2168,15 @@ infixtype :: { forall b. DisambTD b => PV (LocatedA b) } : ftype %shift { $1 } | ftype tyop infixtype { $1 >>= \ $1 -> $3 >>= \ $3 -> - do { when (looksLikeMult $1 $2 $3) $ hintLinear (getLocA $2) - ; mkHsOpTyPV $1 $2 $3 } } + do { let (op, prom) = $2 + ; when (looksLikeMult $1 op $3) $ hintLinear (getLocA op) + ; mkHsOpTyPV prom $1 op $3 } } | unpackedness infixtype { $2 >>= \ $2 -> mkUnpackednessPV $1 $2 } ftype :: { forall b. DisambTD b => PV (LocatedA b) } : atype { mkHsAppTyHeadPV $1 } - | tyop { failOpFewArgs $1 } + | tyop { failOpFewArgs (fst $1) } | ftype tyarg { $1 >>= \ $1 -> mkHsAppTyPV $1 $2 } | ftype PREFIX_AT atype { $1 >>= \ $1 -> @@ -2185,13 +2186,15 @@ tyarg :: { LHsType GhcPs } : atype { $1 } | unpackedness atype {% addUnpackednessP $1 $2 } -tyop :: { LocatedN RdrName } - : qtyconop { $1 } - | tyvarop { $1 } - | SIMPLEQUOTE qconop {% amsrn (sLL $1 (reLoc $>) (unLoc $2)) - (NameAnnQuote (glAA $1) (gl $2) []) } - | SIMPLEQUOTE varop {% amsrn (sLL $1 (reLoc $>) (unLoc $2)) - (NameAnnQuote (glAA $1) (gl $2) []) } +tyop :: { (LocatedN RdrName, PromotionFlag) } + : qtyconop { ($1, NotPromoted) } + | tyvarop { ($1, NotPromoted) } + | SIMPLEQUOTE qconop {% do { op <- amsrn (sLL $1 (reLoc $>) (unLoc $2)) + (NameAnnQuote (glAA $1) (gl $2) []) + ; return (op, IsPromoted) } } + | SIMPLEQUOTE varop {% do { op <- amsrn (sLL $1 (reLoc $>) (unLoc $2)) + (NameAnnQuote (glAA $1) (gl $2) []) + ; return (op, IsPromoted) } } atype :: { LHsType GhcPs } : ntgtycon {% acsa (\cs -> sL1a (reLocN $1) (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- Not including unit tuples |