summaryrefslogtreecommitdiff
path: root/compiler/GHC/Parser.y
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Parser.y')
-rw-r--r--compiler/GHC/Parser.y95
1 files changed, 83 insertions, 12 deletions
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index ff380f8c75..df581b1898 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -64,7 +64,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Misc ( looksLikePackageName, fstOf3, sndOf3, thdOf3 )
import GHC.Types.Name.Reader
-import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, occNameFS )
+import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, occNameFS, mkVarOcc, occNameString)
import GHC.Types.SrcLoc
import GHC.Types.Basic
import GHC.Types.Fixity
@@ -658,6 +658,8 @@ are the most common patterns, rewritten as regular expressions for clarity:
'-<<' { L _ (ITLarrowtail _) } -- for arrow notation
'>>-' { L _ (ITRarrowtail _) } -- for arrow notation
'.' { L _ ITdot }
+ PREFIX_PROJ { L _ (ITproj True) } -- RecordDotSyntax
+ TIGHT_INFIX_PROJ { L _ (ITproj False) } -- RecordDotSyntax
PREFIX_AT { L _ ITtypeApp }
PREFIX_PERCENT { L _ ITpercent } -- for linear types
@@ -2737,6 +2739,22 @@ fexp :: { ECP }
fmap ecpFromExp $
ams (sLL $1 $> $ HsStatic noExtField $2)
[mj AnnStatic $1] }
+
+ -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+ | fexp TIGHT_INFIX_PROJ field
+ {% runPV (unECP $1) >>= \ $1 ->
+ -- Suppose lhs is an application term e.g. 'f a'
+ -- and rhs is '.b'. Usually we want the parse 'f
+ -- (a.b)' rather than '(f a).b.'. However, if lhs
+ -- is a projection 'r.a' (say) then we want the
+ -- parse '(r.a).b'.
+ fmap ecpFromExp $ ams (case $1 of
+ L _ (HsApp _ f arg) | not $ isGetField f ->
+ let l = comb2 arg $3 in
+ L (getLoc f `combineSrcSpans` l)
+ (HsApp noExtField f (mkRdrGetField l arg $3))
+ _ -> mkRdrGetField (comb2 $1 $>) $1 $3) [mj AnnDot $2] }
+
| aexp { $1 }
aexp :: { ECP }
@@ -2826,10 +2844,12 @@ aexp :: { ECP }
aexp1 :: { ECP }
: aexp1 '{' fbinds '}' { ECP $
- unECP $1 >>= \ $1 ->
- $3 >>= \ $3 ->
- amms (mkHsRecordPV (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3))
- (moc $2:mcc $4:(fst $3)) }
+ getBit OverloadedRecordUpdateBit >>= \ overloaded ->
+ unECP $1 >>= \ $1 ->
+ $3 >>= \ $3 ->
+ amms (mkHsRecordPV overloaded (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3))
+ (moc $2:mcc $4:(fst $3))
+ }
| aexp2 { $1 }
aexp2 :: { ECP }
@@ -2858,6 +2878,14 @@ aexp2 :: { ECP }
amms (mkSumOrTuplePV (comb2 $1 $>) Boxed (snd $2))
((mop $1:fst $2) ++ [mcp $3]) }
+ -- This case is only possible when 'OverloadedRecordDotBit' is enabled.
+ | '(' projection ')' { ECP $
+ let (loc, (anns, fIELDS)) = $2
+ span = combineSrcSpans (combineSrcSpans (getLoc $1) loc) (getLoc $3)
+ expr = mkRdrProjection span (reverse fIELDS)
+ in amms (ecpFromExp' expr) ([mop $1] ++ reverse anns ++ [mcp $3])
+ }
+
| '(#' texp '#)' { ECP $
unECP $2 >>= \ $2 ->
amms (mkSumOrTuplePV (comb2 $1 $>) Unboxed (Tuple [L (gl $2) (Just $2)]))
@@ -2907,6 +2935,14 @@ aexp2 :: { ECP }
Nothing (reverse $3))
[mu AnnOpenB $1,mu AnnCloseB $4] }
+projection :: { (SrcSpan, ([AddAnn], [Located FastString])) }
+projection
+ -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer
+ : projection TIGHT_INFIX_PROJ field
+ { let (loc, (anns, fs)) = $1 in
+ (combineSrcSpans (combineSrcSpans loc (gl $2)) (gl $3), (mj AnnDot $2 : anns, $3 : fs)) }
+ | PREFIX_PROJ field { (comb2 $1 $2, ([mj AnnDot $1], [$2])) }
+
splice_exp :: { LHsExpr GhcPs }
: splice_untyped { mapLoc (HsSpliceE noExtField) $1 }
| splice_typed { mapLoc (HsSpliceE noExtField) $1 }
@@ -3323,33 +3359,65 @@ qual :: { forall b. DisambECP b => PV (LStmt GhcPs (Located b)) }
-----------------------------------------------------------------------------
-- Record Field Update/Construction
-fbinds :: { forall b. DisambECP b => PV ([AddAnn],([LHsRecField GhcPs (Located b)], Maybe SrcSpan)) }
+fbinds :: { forall b. DisambECP b => PV ([AddAnn],([Fbind b], Maybe SrcSpan)) }
: fbinds1 { $1 }
| {- empty -} { return ([],([], Nothing)) }
-fbinds1 :: { forall b. DisambECP b => PV ([AddAnn],([LHsRecField GhcPs (Located b)], Maybe SrcSpan)) }
+fbinds1 :: { forall b. DisambECP b => PV ([AddAnn],([Fbind b], Maybe SrcSpan)) }
: fbind ',' fbinds1
{ $1 >>= \ $1 ->
$3 >>= \ $3 ->
- addAnnotation (gl $1) AnnComma (gl $2) >>
+ let gl' = \case { Left (L l _) -> l; Right (L l _) -> l } in
+ addAnnotation (gl' $1) AnnComma (gl $2) >>
return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
| fbind { $1 >>= \ $1 ->
return ([],([$1], Nothing)) }
| '..' { return ([mj AnnDotdot $1],([], Just (getLoc $1))) }
-fbind :: { forall b. DisambECP b => PV (LHsRecField GhcPs (Located b)) }
+fbind :: { forall b. DisambECP b => PV (Fbind b) }
: qvar '=' texp { unECP $3 >>= \ $3 ->
- ams (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False)
- [mj AnnEqual $2] }
+ fmap Left $ ams (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False) [mj AnnEqual $2]
+ }
-- RHS is a 'texp', allowing view patterns (#6038)
-- and, incidentally, sections. Eg
-- f (R { x = show -> s }) = ...
| qvar { placeHolderPunRhs >>= \rhs ->
- return $ sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) rhs True }
+ fmap Left $ return (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) rhs True)
+ }
-- In the punning case, use a place-holder
-- The renamer fills in the final value
+ -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+ | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp
+ { do
+ let top = $1
+ fields = top : reverse $3
+ final = last fields
+ l = comb2 top final
+ isPun = False
+ $5 <- unECP $5
+ fmap Right $ mkHsProjUpdatePV (comb2 $1 $5) (L l fields) $5 isPun
+ }
+
+ -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+ | field TIGHT_INFIX_PROJ fieldToUpdate
+ { do
+ let top = $1
+ fields = top : reverse $3
+ final = last fields
+ l = comb2 top final
+ isPun = True
+ var <- mkHsVarPV (noLoc (mkRdrUnqual . mkVarOcc . unpackFS . unLoc $ final))
+ fmap Right $ mkHsProjUpdatePV l (L l fields) var isPun
+ }
+
+fieldToUpdate :: { [Located FastString] }
+fieldToUpdate
+ -- See Note [Whitespace-sensitive operator parsing] in Lexer.x
+ : fieldToUpdate TIGHT_INFIX_PROJ field { $3 : $1 }
+ | field { [$1] }
+
-----------------------------------------------------------------------------
-- Implicit Parameter Bindings
@@ -3649,6 +3717,9 @@ qvar :: { Located RdrName }
-- whether it's a qvar or a var can be postponed until
-- *after* we see the close paren.
+field :: { Located FastString }
+ : VARID { sL1 $1 $! getVARID $1 }
+
qvarid :: { Located RdrName }
: varid { $1 }
| QVARID { sL1 $1 $! mkQual varName (getQVARID $1) }
View Lorry Controller Status