summaryrefslogtreecommitdiff
path: root/compiler/parser/Parser.y
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/parser/Parser.y')
-rw-r--r--compiler/parser/Parser.y141
1 files changed, 93 insertions, 48 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 0076a01992..4272da7c82 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1080,7 +1080,7 @@ topdecl :: { LHsDecl GhcPs }
-- The $(..) form is one possible form of infixexp
-- but we treat an arbitrary expression just as if
-- it had a $(..) wrapped around it
- | infixexp_top {% runECP_P $1 >>= \ $1 ->
+ | infixexp {% runECP_P $1 >>= \ $1 ->
return $ sLL $1 $> $ mkSpliceDecl $1 }
-- Type classes
@@ -2430,7 +2430,7 @@ docdecld :: { LDocDecl }
decl_no_th :: { LHsDecl GhcPs }
: sigdecl { $1 }
- | infixexp_top opt_sig rhs {% runECP_P $1 >>= \ $1 ->
+ | infixexp opt_sig rhs {% runECP_P $1 >>= \ $1 ->
do { (ann,r) <- checkValDef $1 (snd $2) $3;
let { l = comb2 $1 $> };
-- Depending upon what the pattern looks like we might get either
@@ -2476,7 +2476,7 @@ gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) }
sigdecl :: { LHsDecl GhcPs }
:
-- See Note [Declaration/signature overlap] for why we need infixexp here
- infixexp_top '::' sigtypedoc
+ infixexp '::' sigtypedoc
{% do { $1 <- runECP_P $1
; v <- checkValSigLhs $1
; _ <- amsL (comb2 $1 $>) [mu AnnDcolon $2]
@@ -2571,7 +2571,8 @@ quasiquote :: { Located (HsSplice GhcPs) }
in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
exp :: { ECP }
- : infixexp '::' sigtype { ECP $
+ : infixexp_no_prag '::' sigtype
+ { ECP $
runECP_PV $1 >>= \ $1 ->
amms (mkHsTySigPV (comb2 $1 $>) $1 $3)
[mu AnnDcolon $2] }
@@ -2600,10 +2601,35 @@ exp :: { ECP }
HsHigherOrderApp False)
[mu AnnRarrowtail $2] }
| infixexp { $1 }
+ | exp_prag(exp) { $1 } -- See Note [Pragmas and operator fixity]
infixexp :: { ECP }
+ : infixexp_no_prag { $1 }
+ | infixexp_no_prag qop exp_prag(last_exp10) -- See Note [Pragmas and operator fixity]
+ { ECP $
+ superInfixOp $
+ $2 >>= \ $2 ->
+ runECP_PV $1 >>= \ $1 ->
+ runECP_PV $3 >>= \ $3 ->
+ amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3)
+ [mj AnnVal $2] }
+ -- AnnVal annotation for NPlusKPat, which discards the operator
+
+last_exp10 :: { ECP }
+ : exp10 { $1 }
+ | exp_prag(last_exp10) { $1 } -- See Note [Pragmas and operator fixity]
+
+exp_prag(e) :: { ECP }
+ : prag_e e -- See Note [Pragmas and operator fixity]
+ {% runECP_P $2 >>= \ $2 ->
+ fmap ecpFromExp $
+ ams (sLL $1 $> $ HsPragE noExtField (snd $ unLoc $1) $2)
+ (fst $ unLoc $1) }
+
+infixexp_no_prag :: { ECP }
: exp10 { $1 }
- | infixexp qop exp10 { ECP $
+ | infixexp_no_prag qop exp10
+ { ECP $
superInfixOp $
$2 >>= \ $2 ->
runECP_PV $1 >>= \ $1 ->
@@ -2612,49 +2638,75 @@ infixexp :: { ECP }
[mj AnnVal $2] }
-- AnnVal annotation for NPlusKPat, which discards the operator
-infixexp_top :: { ECP }
- : exp10_top { $1 }
- | infixexp_top qop exp10_top
- { ECP $
- superInfixOp $
- $2 >>= \ $2 ->
- runECP_PV $1 >>= \ $1 ->
- runECP_PV $3 >>= \ $3 ->
- amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3)
- [mj AnnVal $2] }
-
-exp10_top :: { ECP }
+exp10 :: { ECP }
: '-' fexp { ECP $
runECP_PV $2 >>= \ $2 ->
amms (mkHsNegAppPV (comb2 $1 $>) $2)
[mj AnnMinus $1] }
-
- | exp_annot (prag_hpc) { $1 }
- | exp_annot (prag_core) { $1 }
| fexp { $1 }
-exp10 :: { ECP }
- : exp10_top { $1 }
- | exp_annot(prag_scc) { $1 }
-
optSemi :: { ([Located Token],Bool) }
: ';' { ([$1],True) }
| {- empty -} { ([],False) }
-prag_scc :: { Located ([AddAnn], HsPragE GhcPs) }
- : '{-# SCC' STRING '#-}' {% do scc <- getSCC $2
- ; return $ sLL $1 $>
- ([mo $1,mj AnnValStr $2,mc $3],
- HsPragSCC noExtField
- (getSCC_PRAGs $1)
- (StringLiteral (getSTRINGs $2) scc)) }
- | '{-# SCC' VARID '#-}' { sLL $1 $> ([mo $1,mj AnnVal $2,mc $3],
- HsPragSCC noExtField
- (getSCC_PRAGs $1)
- (StringLiteral NoSourceText (getVARID $2))) }
-
-prag_hpc :: { Located ([AddAnn], HsPragE GhcPs) }
- : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
+{- Note [Pragmas and operator fixity]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+'prag_e' is an expression pragma, such as {-# SCC ... #-}, {-# CORE ... #-}, or
+{-# GENERATED ... #-}.
+
+It must be used with care, or else #15730 happens. Consider this infix
+expression:
+
+ 1 / 2 / 2
+
+There are two ways to parse it:
+
+ 1. (1 / 2) / 2 = 0.25
+ 2. 1 / (2 / 2) = 1.0
+
+Due to the fixity of the (/) operator (assuming it comes from Prelude),
+option 1 is the correct parse. However, in the past GHC's parser used to get
+confused by the SCC annotation when it occurred in the middle of an infix
+expression:
+
+ 1 / {-# SCC ann #-} 2 / 2 -- used to get parsed as option 2
+
+There are several ways to address this issue, see GHC Proposal #176 for a
+detailed exposition:
+
+ https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0176-scc-parsing.rst
+
+The accepted fix is to disallow pragmas that occur within infix expressions.
+Infix expressions are assembled out of 'exp10', so 'exp10' must not accept
+pragmas. Instead, we accept them in exactly two places:
+
+* at the start of an expression or a parenthesized subexpression:
+
+ f = {-# SCC ann #-} 1 / 2 / 2 -- at the start of the expression
+ g = 5 + ({-# SCC ann #-} 1 / 2 / 2) -- at the start of a parenthesized subexpression
+
+* immediately after the last operator:
+
+ f = 1 / 2 / {-# SCC ann #-} 2
+
+In both cases, the parse does not depend on operator fixity. The second case
+may sound unnecessary, but it's actually needed to support a common idiom:
+
+ f $ {-# SCC ann $-} ...
+
+-}
+prag_e :: { Located ([AddAnn], HsPragE GhcPs) }
+ : '{-# SCC' STRING '#-}' {% do scc <- getSCC $2
+ ; return $ sLL $1 $>
+ ([mo $1,mj AnnValStr $2,mc $3],
+ HsPragSCC noExtField
+ (getSCC_PRAGs $1)
+ (StringLiteral (getSTRINGs $2) scc)) }
+ | '{-# SCC' VARID '#-}' { sLL $1 $> ([mo $1,mj AnnVal $2,mc $3],
+ HsPragSCC noExtField
+ (getSCC_PRAGs $1)
+ (StringLiteral NoSourceText (getVARID $2))) }
+ | '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
{ let getINT = fromInteger . il_value . getINTEGER in
sLL $1 $> $ ([mo $1,mj AnnVal $2
,mj AnnVal $3,mj AnnColon $4
@@ -2668,19 +2720,11 @@ prag_hpc :: { Located ([AddAnn], HsPragE GhcPs) }
(getINT $7, getINT $9))
((getINTEGERs $3, getINTEGERs $5),
(getINTEGERs $7, getINTEGERs $9) )) }
-
-prag_core :: { Located ([AddAnn], HsPragE GhcPs) }
- : '{-# CORE' STRING '#-}'
+ | '{-# CORE' STRING '#-}'
{ sLL $1 $> $
([mo $1,mj AnnVal $2,mc $3],
HsPragCore noExtField (getCORE_PRAGs $1) (getStringLiteral $2)) }
-exp_annot(prag) :: { ECP }
- : prag exp {% runECP_P $2 >>= \ $2 ->
- fmap ecpFromExp $
- ams (sLL $1 $> $ HsPragE noExtField (snd $ unLoc $1) $2)
- (fst $ unLoc $1) }
-
fexp :: { ECP }
: fexp aexp { ECP $
superFunArg $
@@ -2912,7 +2956,8 @@ texp :: { ECP }
-- Then when converting expr to pattern we unravel it again
-- Meanwhile, the renamer checks that real sections appear
-- inside parens.
- | infixexp qop {% runECP_P $1 >>= \ $1 ->
+ | infixexp_no_prag qop
+ {% runECP_P $1 >>= \ $1 ->
runPV $2 >>= \ $2 ->
return $ ecpFromExp $
sLL $1 $> $ SectionL noExtField $1 $2 }
View Lorry Controller Status