Fix record dot precedence (#19521)

By moving the handling of TIGHT_INFIX_PROJ to the correct place,
we can remove the isGetField hack and fix a bug at the same time.

4 files changed, 20 insertions, 21 deletions

diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index df581b1898..c17444ddcb 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2740,21 +2740,6 @@ fexp    :: { ECP }
                                         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 }
@@ -2850,6 +2835,12 @@ aexp1   :: { ECP }
                                    amms (mkHsRecordPV overloaded (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3))
                                         (moc $2:mcc $4:(fst $3))
                                }
+
+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+        | aexp1 TIGHT_INFIX_PROJ field
+            {% runPV (unECP $1) >>= \ $1 ->
+               fmap ecpFromExp $ ams (mkRdrGetField (comb2 $1 $>) $1 $3) [mj AnnDot $2] }
+
         | aexp2                { $1 }
 
 aexp2   :: { ECP }
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 9ab0ef2370..6a0f86aefe 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -16,7 +16,7 @@
 -- Functions over HsSyn specialised to RdrName.
 
 module GHC.Parser.PostProcess (
-        mkRdrGetField, mkRdrProjection, isGetField, Fbind, -- RecordDot
+        mkRdrGetField, mkRdrProjection, Fbind, -- RecordDot
         mkHsOpApp,
         mkHsIntegral, mkHsFractional, mkHsIsString,
         mkHsDo, mkSpliceDecl,
@@ -2704,11 +2704,6 @@ starSym False = "*"
 -----------------------------------------
 -- Bits and pieces for RecordDotSyntax.
 
--- Test if the expression is a 'getField @"..."' expression.
-isGetField :: LHsExpr GhcPs -> Bool
-isGetField (L _ HsGetField{}) = True
-isGetField _ = False
-
 mkRdrGetField :: SrcSpan -> LHsExpr GhcPs -> Located FieldLabelString -> LHsExpr GhcPs
 mkRdrGetField loc arg field =
   L loc HsGetField {
diff --git a/testsuite/tests/parser/should_compile/T19521.hs b/testsuite/tests/parser/should_compile/T19521.hs
new file mode 100644
index 0000000000..5ebca17a3e
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T19521.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module T19521 where
+
+data Foo =
+  Foo {
+    val :: Int,
+    fun :: Int -> Int
+  }
+
+apply :: Foo -> Int
+apply foo = foo.fun foo.val
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index 4aa6d17ec0..d2b3a69385 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -174,3 +174,4 @@ test('T18834a', normal, compile, [''])
 test('T18834b', normal, compile, [''])
 test('T12862', normal, compile, [''])
 test('T19082', normal, compile, [''])
+test('T19521', normal, compile, [''])