Improve treatment of sectioned holes

Summary:
Previously, GHC was pretty-printing left-section holes
incorrectly and not parsing right-sectioned holes at all. This patch
fixes both problems.

Test Plan: make test TEST=T14590

Reviewers: bgamari, simonpj

Reviewed By: simonpj

Subscribers: simonpj, rwbarton, thomie, mpickering, carter

GHC Trac Issues: #14590

Differential Revision: https://phabricator.haskell.org/D4273

5 files changed, 283 insertions, 3 deletions

diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index de0e473ba4..1c7340d216 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -883,6 +883,8 @@ ppr_expr (SectionL expr op)
   = case unLoc op of
       HsVar (L _ v)  -> pp_infixly v
       HsConLikeOut c -> pp_infixly (conLikeName c)
+      HsUnboundVar h@TrueExprHole{}
+                     -> pp_infixly (unboundVarOcc h)
       _              -> pp_prefixly
   where
     pp_expr = pprDebugParendExpr expr
@@ -895,6 +897,8 @@ ppr_expr (SectionR op expr)
   = case unLoc op of
       HsVar (L _ v)  -> pp_infixly v
       HsConLikeOut c -> pp_infixly (conLikeName c)
+      HsUnboundVar h@TrueExprHole{}
+                     -> pp_infixly (unboundVarOcc h)
       _              -> pp_prefixly
   where
     pp_expr = pprDebugParendExpr expr
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 1b593900a7..c920f0c6e4 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -3178,13 +3178,17 @@ varop   :: { Located RdrName }
 qop     :: { LHsExpr GhcPs }   -- used in sections
         : qvarop                { sL1 $1 $ HsVar $1 }
         | qconop                { sL1 $1 $ HsVar $1 }
-        | '`' '_' '`'           {% ams (sLL $1 $> EWildPat)
-                                       [mj AnnBackquote $1,mj AnnVal $2
-                                       ,mj AnnBackquote $3] }
+        | hole_op               { $1 }
 
 qopm    :: { LHsExpr GhcPs }   -- used in sections
         : qvaropm               { sL1 $1 $ HsVar $1 }
         | qconop                { sL1 $1 $ HsVar $1 }
+        | hole_op               { $1 }
+
+hole_op :: { LHsExpr GhcPs }   -- used in sections
+hole_op : '`' '_' '`'           {% ams (sLL $1 $> EWildPat)
+                                       [mj AnnBackquote $1,mj AnnVal $2
+                                       ,mj AnnBackquote $3] }
 
 qvarop :: { Located RdrName }
         : qvarsym               { $1 }
diff --git a/testsuite/tests/typecheck/should_compile/T14590.hs b/testsuite/tests/typecheck/should_compile/T14590.hs
new file mode 100644
index 0000000000..f687d52dea
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T14590.hs
@@ -0,0 +1,7 @@
+module T14590 where
+
+f1, f2, f3, f4 :: Int -> Int -> Int
+f1 x y = (x `_`)  y
+f2 x y = (x `_a`) y
+f3 x y = (`_`  x) y
+f4 x y = (`_a` x) y
diff --git a/testsuite/tests/typecheck/should_compile/T14590.stderr b/testsuite/tests/typecheck/should_compile/T14590.stderr
new file mode 100644
index 0000000000..ee186d06e7
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T14590.stderr
@@ -0,0 +1,264 @@
+
+T14590.hs:4:13: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _ :: Int -> Int -> Int
+    • In the expression: _
+      In the expression: x `_`
+      In the expression: (x `_`) y
+    • Relevant bindings include
+        y :: Int (bound at T14590.hs:4:6)
+        x :: Int (bound at T14590.hs:4:4)
+        f1 :: Int -> Int -> Int (bound at T14590.hs:4:1)
+      Valid substitutions include
+        (-) :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        asTypeOf :: forall a. a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Base’))
+        const :: forall a b. a -> b -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Base’))
+        (*) :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        (+) :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        subtract :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        (^) :: forall a b. (Num a, Integral b) => a -> b -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        div :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        gcd :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        lcm :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        mod :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        quot :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        rem :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        undefined :: forall (a :: TYPE r).
+                     GHC.Stack.Types.HasCallStack =>
+                     a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Err’))
+        max :: forall a. Ord a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Classes’))
+        min :: forall a. Ord a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Classes’))
+        seq :: forall a b. a -> b -> b
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Prim’))
+
+T14590.hs:5:13: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _a :: Int -> Int -> Int
+      Or perhaps ‘_a’ is mis-spelled, or not in scope
+    • In the expression: _a
+      In the expression: x `_a`
+      In the expression: (x `_a`) y
+    • Relevant bindings include
+        y :: Int (bound at T14590.hs:5:6)
+        x :: Int (bound at T14590.hs:5:4)
+        f2 :: Int -> Int -> Int (bound at T14590.hs:5:1)
+      Valid substitutions include
+        f1 :: Int -> Int -> Int (defined at T14590.hs:4:1)
+        (-) :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        asTypeOf :: forall a. a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Base’))
+        const :: forall a b. a -> b -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Base’))
+        (*) :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        (+) :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        subtract :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        (^) :: forall a b. (Num a, Integral b) => a -> b -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        div :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        gcd :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        lcm :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        mod :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        quot :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        rem :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        undefined :: forall (a :: TYPE r).
+                     GHC.Stack.Types.HasCallStack =>
+                     a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Err’))
+        max :: forall a. Ord a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Classes’))
+        min :: forall a. Ord a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Classes’))
+        seq :: forall a b. a -> b -> b
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Prim’))
+
+T14590.hs:6:11: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _ :: Int -> Int -> Int
+    • In the expression: _
+      In the expression: `_` x
+      In the expression: (`_` x) y
+    • Relevant bindings include
+        y :: Int (bound at T14590.hs:6:6)
+        x :: Int (bound at T14590.hs:6:4)
+        f3 :: Int -> Int -> Int (bound at T14590.hs:6:1)
+      Valid substitutions include
+        f1 :: Int -> Int -> Int (defined at T14590.hs:4:1)
+        f2 :: Int -> Int -> Int (defined at T14590.hs:5:1)
+        (-) :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        asTypeOf :: forall a. a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Base’))
+        const :: forall a b. a -> b -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Base’))
+        (*) :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        (+) :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        subtract :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        (^) :: forall a b. (Num a, Integral b) => a -> b -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        div :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        gcd :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        lcm :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        mod :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        quot :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        rem :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        undefined :: forall (a :: TYPE r).
+                     GHC.Stack.Types.HasCallStack =>
+                     a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Err’))
+        max :: forall a. Ord a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Classes’))
+        min :: forall a. Ord a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Classes’))
+        seq :: forall a b. a -> b -> b
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Prim’))
+
+T14590.hs:7:11: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _a :: Int -> Int -> Int
+      Or perhaps ‘_a’ is mis-spelled, or not in scope
+    • In the expression: _a
+      In the expression: `_a` x
+      In the expression: (`_a` x) y
+    • Relevant bindings include
+        y :: Int (bound at T14590.hs:7:6)
+        x :: Int (bound at T14590.hs:7:4)
+        f4 :: Int -> Int -> Int (bound at T14590.hs:7:1)
+      Valid substitutions include
+        f1 :: Int -> Int -> Int (defined at T14590.hs:4:1)
+        f2 :: Int -> Int -> Int (defined at T14590.hs:5:1)
+        f3 :: Int -> Int -> Int (defined at T14590.hs:6:1)
+        (-) :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        asTypeOf :: forall a. a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Base’))
+        const :: forall a b. a -> b -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Base’))
+        (*) :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        (+) :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        subtract :: forall a. Num a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Num’))
+        (^) :: forall a b. (Num a, Integral b) => a -> b -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        div :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        gcd :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        lcm :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        mod :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        quot :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        rem :: forall a. Integral a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Real’))
+        undefined :: forall (a :: TYPE r).
+                     GHC.Stack.Types.HasCallStack =>
+                     a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Err’))
+        max :: forall a. Ord a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Classes’))
+        min :: forall a. Ord a => a -> a -> a
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Classes’))
+        seq :: forall a b. a -> b -> b
+          (imported from ‘Prelude’ at T14590.hs:1:8-13
+           (and originally defined in ‘GHC.Prim’))
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 3c6ef7fb5a..e516d36f6c 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -586,3 +586,4 @@ test('T14434', [], run_command, ['$MAKE -s --no-print-directory T14434'])
 test('MissingExportList01', normal, compile, [''])
 test('MissingExportList02', normal, compile, [''])
 test('T14488', normal, compile, [''])
+test('T14590', normal, compile, ['-fdefer-type-errors -fno-max-valid-substitutions'])