[commit: ghc] master: Fix #15815 by parenthesizing the arguments to infix ~ (b8a797e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/b8a797ecc34a309bd78f5a290e3554642a3a478a/ghc

>---------------------------------------------------------------

commit b8a797ecc34a309bd78f5a290e3554642a3a478a
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Sun Oct 28 16:08:11 2018 -0400

    Fix #15815 by parenthesizing the arguments to infix ~
    
    An unfortunate consequence of commit
    b9483981d128f55d8dae3f434f49fa6b5b30c779 (`Remove HsEqTy and XEqTy`)
    is infix uses of `~` in TH quotes now desugar differently than
    before. In particular, we have that:
    
    ```haskell
    a ~ (Int -> Int)
    ```
    
    Now desugars to:
    
    ```haskell
    HsOpTy a (~) (HsOpTy Int (->) Int)
    ```
    
    Which GHC interprets as being:
    
    ```haskell
    a ~ Int -> Int
    ```
    
    Or, equivalently:
    
    ```haskell
    (a ~ Int) -> Int
    ```
    
    Which is different than what was intended! This is the cause
    of #15815.
    
    All of this has revealed that we likely need to renovate the way we
    desugar infix type operators to be more consistent with the treatment
    for infix expressions (see
    https://ghc.haskell.org/trac/ghc/ticket/15815#comment:5 for more on
    this.) Doing so would constitute a breaking change, however, so we
    will likely want to wait until another major GHC release to do this.
    
    In the meantime, this patch offers a non-invasive change to the way
    that infix uses of `~` are desugared. This makes the program
    in #15815 compile again by inserting extra `HsParTy`s around the
    arguments to `~` if they are lacking them.
    
    Test Plan: make test TEST=T15815
    
    Reviewers: int-index, goldfire, bgamari
    
    Reviewed By: int-index
    
    Subscribers: int-e, rwbarton, carter
    
    GHC Trac Issues: #15815
    
    Differential Revision: https://phabricator.haskell.org/D5274


>---------------------------------------------------------------

b8a797ecc34a309bd78f5a290e3554642a3a478a
 compiler/hsSyn/Convert.hs     | 8 +++++++-
 testsuite/tests/th/T15815A.hs | 7 +++++++
 testsuite/tests/th/T15815B.hs | 6 ++++++
 testsuite/tests/th/all.T      | 2 ++
 4 files changed, 22 insertions(+), 1 deletion(-)

diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 8b12a78..06d5d6c 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -1437,7 +1437,13 @@ cvtTypeKind ty_str ty
 
            EqualityT
              | [x',y'] <- tys' ->
-                   returnL (HsOpTy noExt x' (noLoc eqTyCon_RDR) y')
+                   let px = parenthesizeHsType opPrec x'
+                       py = parenthesizeHsType opPrec y'
+                   in returnL (HsOpTy noExt px (noLoc eqTyCon_RDR) py)
+               -- The long-term goal is to remove the above case entirely and
+               -- subsume it under the case for InfixT. See #15815, comment:6,
+               -- for more details.
+
              | otherwise ->
                    mk_apps (HsTyVar noExt NotPromoted
                             (noLoc eqTyCon_RDR)) tys'
diff --git a/testsuite/tests/th/T15815A.hs b/testsuite/tests/th/T15815A.hs
new file mode 100644
index 0000000..4025f38
--- /dev/null
+++ b/testsuite/tests/th/T15815A.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T15815A where
+
+mkFoo tyQ = [d|
+    foo :: a ~ $(tyQ) => a
+    foo = undefined
+  |]
diff --git a/testsuite/tests/th/T15815B.hs b/testsuite/tests/th/T15815B.hs
new file mode 100644
index 0000000..32bf2ed
--- /dev/null
+++ b/testsuite/tests/th/T15815B.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell, GADTs #-}
+module T15815B where
+
+import T15815A
+
+mkFoo [t| Int -> Int |]
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 50154a4..2481a2a 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -446,3 +446,5 @@ test('T15738', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T15783', normal, multimod_compile,
     ['T15783A', '-v0 ' + config.ghc_th_way_flags])
 test('T15792', normal, compile, ['-v0 -dsuppress-uniques'])
+test('T15815', normal, multimod_compile,
+    ['T15815B', '-v0 ' + config.ghc_th_way_flags])