[commit: ghc] master: Turn a TH Name for built-in syntax into an unqualified RdrName (9868f91)

[git at git.haskell.org]

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

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

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

commit 9868f91fd9f04fdee241df69ae826feeae89a0b6
Author: Chaitanya Koparkar <ckoparkar at gmail.com>
Date:   Mon Mar 19 12:04:03 2018 -0400

    Turn a TH Name for built-in syntax into an unqualified RdrName
    
    Previously, the Renamer would turn any fully qualified Template Haskell
    name into a corresponding fully qualified `RdrName`. But this is not
    what we want for built-in syntax, as it produces unnecessarily qualified
    names (eg. GHC.Types.[], GHC.Tuple.(,) etc.).
    
    Test Plan: ./validate
    
    Reviewers: RyanGlScott, bgamari, goldfire
    
    Reviewed By: RyanGlScott, bgamari
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #13776
    
    Differential Revision: https://phabricator.haskell.org/D4506


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

9868f91fd9f04fdee241df69ae826feeae89a0b6
 compiler/hsSyn/Convert.hs                         |  8 +++++++-
 testsuite/tests/th/T13776.hs                      | 23 +++++++++++++++++++++++
 testsuite/tests/th/T13776.stderr                  | 14 ++++++++++++++
 testsuite/tests/th/T3319.stderr                   |  2 +-
 testsuite/tests/th/T5700.stderr                   |  2 +-
 testsuite/tests/th/TH_foreignInterruptible.stderr |  2 +-
 testsuite/tests/th/all.T                          |  1 +
 7 files changed, 48 insertions(+), 4 deletions(-)

diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 531f146..6440758 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -1625,8 +1625,14 @@ thRdrName loc ctxt_ns th_occ th_name
     occ :: OccName.OccName
     occ = mk_occ ctxt_ns th_occ
 
+-- Return an unqualified exact RdrName if we're dealing with built-in syntax.
+-- See Trac #13776.
 thOrigRdrName :: String -> TH.NameSpace -> PkgName -> ModName -> RdrName
-thOrigRdrName occ th_ns pkg mod = (mkOrig $! (mkModule (mk_pkg pkg) (mk_mod mod))) $! (mk_occ (mk_ghc_ns th_ns) occ)
+thOrigRdrName occ th_ns pkg mod =
+  let occ' = mk_occ (mk_ghc_ns th_ns) occ
+  in case isBuiltInOcc_maybe occ' of
+       Just name -> nameRdrName name
+       Nothing   -> (mkOrig $! (mkModule (mk_pkg pkg) (mk_mod mod))) $! occ'
 
 thRdrNameGuesses :: TH.Name -> [RdrName]
 thRdrNameGuesses (TH.Name occ flavour)
diff --git a/testsuite/tests/th/T13776.hs b/testsuite/tests/th/T13776.hs
new file mode 100644
index 0000000..6082825
--- /dev/null
+++ b/testsuite/tests/th/T13776.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T13776 where
+
+import Language.Haskell.TH
+
+spliceTy1 :: $(conT ''(,) `appT` conT ''Int `appT` conT ''Int)
+spliceTy1 = (1,2)
+
+spliceTy2 :: $(conT ''[] `appT` conT ''Int)
+spliceTy2 = []
+
+spliceExp1 :: (Int, Int)
+spliceExp1 = $(conE '(,) `appE` litE (integerL 1) `appE` litE (integerL 1))
+
+spliceExp2 :: [Int]
+spliceExp2 = $(conE '[])
+
+splicePat1 :: (Int, Int) -> ()
+splicePat1 $(conP '(,) [litP (integerL 1), litP (integerL 1)]) = ()
+
+splicePat2 :: [Int] -> ()
+splicePat2 $(conP '[] []) = ()
diff --git a/testsuite/tests/th/T13776.stderr b/testsuite/tests/th/T13776.stderr
new file mode 100644
index 0000000..485dc64
--- /dev/null
+++ b/testsuite/tests/th/T13776.stderr
@@ -0,0 +1,14 @@
+T13776.hs:10:16-42: Splicing type
+    conT ''[] `appT` conT ''Int ======> [] Int
+T13776.hs:7:16-61: Splicing type
+    conT ''(,) `appT` conT ''Int `appT` conT ''Int ======> (,) Int Int
+T13776.hs:14:16-74: Splicing expression
+    conE '(,) `appE` litE (integerL 1) `appE` litE (integerL 1)
+  ======>
+    ((,) 1) 1
+T13776.hs:17:16-23: Splicing expression
+    conE '[] ======> []
+T13776.hs:20:14-61: Splicing pattern
+    conP '(,) [litP (integerL 1), litP (integerL 1)] ======> (,) 1 1
+T13776.hs:23:14-24: Splicing pattern
+    conP '[] [] ======> []
diff --git a/testsuite/tests/th/T3319.stderr b/testsuite/tests/th/T3319.stderr
index 44ec90f..b88b10f 100644
--- a/testsuite/tests/th/T3319.stderr
+++ b/testsuite/tests/th/T3319.stderr
@@ -4,4 +4,4 @@ T3319.hs:8:3-93: Splicing declarations
          (ImportF
             CCall Unsafe "&" (mkName "foo") (AppT (ConT ''Ptr) (ConT ''())))]
   ======>
-    foreign import ccall unsafe "&" foo :: Ptr GHC.Tuple.()
+    foreign import ccall unsafe "&" foo :: Ptr ()
diff --git a/testsuite/tests/th/T5700.stderr b/testsuite/tests/th/T5700.stderr
index 729a366..3564b8c 100644
--- a/testsuite/tests/th/T5700.stderr
+++ b/testsuite/tests/th/T5700.stderr
@@ -3,4 +3,4 @@ T5700.hs:8:3-9: Splicing declarations
   ======>
     instance C D where
       {-# INLINE inlinable #-}
-      inlinable _ = GHC.Tuple.()
+      inlinable _ = ()
diff --git a/testsuite/tests/th/TH_foreignInterruptible.stderr b/testsuite/tests/th/TH_foreignInterruptible.stderr
index 7131eee..4afc38a 100644
--- a/testsuite/tests/th/TH_foreignInterruptible.stderr
+++ b/testsuite/tests/th/TH_foreignInterruptible.stderr
@@ -8,4 +8,4 @@ TH_foreignInterruptible.hs:8:3-100: Splicing declarations
             (mkName "foo")
             (AppT (ConT ''Ptr) (ConT ''())))]
   ======>
-    foreign import ccall interruptible "&" foo :: Ptr GHC.Tuple.()
+    foreign import ccall interruptible "&" foo :: Ptr ()
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index e9f2838..b51059c 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -403,5 +403,6 @@ test('T14838', [], multimod_compile,
      ['T14838.hs', '-v0 -Wincomplete-patterns ' + config.ghc_th_way_flags])
 test('T14817', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T14843', normal, compile, ['-v0'])
+test('T13776', normal, compile, ['-ddump-splices -v0'])
 test('T14888', normal, compile,
     ['-v0 -ddump-splices -dsuppress-uniques ' + config.ghc_th_way_flags])