[commit: ghc] ghc-8.0: Filter out invisible kind arguments during TH reification (a1fa34c)

[git at git.haskell.org]

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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/a1fa34ced8f317dcaa63babaf50040a7d8c68827/ghc

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

commit a1fa34ced8f317dcaa63babaf50040a7d8c68827
Author: RyanGlScott <ryan.gl.scott at gmail.com>
Date:   Mon Apr 11 02:34:55 2016 +0200

    Filter out invisible kind arguments during TH reification
    
    Previously, all kind arguments were being reified, which would cause
    something like this:
    
    ```
    type Id a = a
    data Proxy (a :: Id k) = Proxy
    ```
    
    to output
    
    ```
    data Proxy (a :: Id * k) = Proxy
    ```
    
    when `Proxy`'s `Info` is reified. The fix is simple: simply call
    `filterOutInvisibleTypes` on the kind arguments of a kind synonym
    application.
    
    Fixes #11463.
    
    Test Plan: ./validate
    
    Reviewers: austin, bgamari, goldfire
    
    Reviewed By: goldfire
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2081
    
    GHC Trac Issues: #11463
    
    (cherry picked from commit 02a5c580b6078630842f4c3db5d92631fada21e9)


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

a1fa34ced8f317dcaa63babaf50040a7d8c68827
 compiler/typecheck/TcSplice.hs   |  4 +++-
 testsuite/tests/th/T11463.hs     | 18 ++++++++++++++++++
 testsuite/tests/th/T11463.stdout |  2 ++
 testsuite/tests/th/all.T         |  1 +
 4 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index fc13b3f..5b9fbad 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -1649,12 +1649,14 @@ reifyKind  ki
 
 reify_kc_app :: TyCon -> [TyCoRep.Kind] -> TcM TH.Kind
 reify_kc_app kc kis
-  = fmap (mkThAppTs r_kc) (mapM reifyKind kis)
+  = fmap (mkThAppTs r_kc) (mapM reifyKind vis_kis)
   where
     r_kc | isTupleTyCon kc          = TH.TupleT (tyConArity kc)
          | kc `hasKey` listTyConKey = TH.ListT
          | otherwise                = TH.ConT (reifyName kc)
 
+    vis_kis = filterOutInvisibleTypes kc kis
+
 reifyCxt :: [PredType] -> TcM [TH.Pred]
 reifyCxt   = mapM reifyPred
 
diff --git a/testsuite/tests/th/T11463.hs b/testsuite/tests/th/T11463.hs
new file mode 100644
index 0000000..1faf596
--- /dev/null
+++ b/testsuite/tests/th/T11463.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeInType #-}
+module Main where
+
+import Data.Kind
+import Language.Haskell.TH
+
+type Id1    a       = a
+type Id2 k (a :: k) = a
+data Proxy1 (a :: Id1   k) = Proxy1
+data Proxy2 (a :: Id2 * k) = Proxy2
+
+$(return [])
+
+main :: IO ()
+main = do
+  putStrLn $(reify ''Proxy1 >>= stringE . pprint)
+  putStrLn $(reify ''Proxy2 >>= stringE . pprint)
diff --git a/testsuite/tests/th/T11463.stdout b/testsuite/tests/th/T11463.stdout
new file mode 100644
index 0000000..d33038a
--- /dev/null
+++ b/testsuite/tests/th/T11463.stdout
@@ -0,0 +1,2 @@
+data Main.Proxy1 (a_0 :: Main.Id1 k_1) = Main.Proxy1
+data Main.Proxy2 (a_0 :: Main.Id2 * k_1) = Main.Proxy2
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index c398a31..9055430 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -400,5 +400,6 @@ test('TH_finalizer', normal, compile, ['-v0'])
 test('T10603', normal, compile, ['-ddump-splices -dsuppress-uniques'])
 test('T11452', normal, compile_fail, ['-v0'])
 test('T11145', normal, compile_fail, ['-v0 -dsuppress-uniques'])
+test('T11463', normal, compile_and_run, ['-v0 -dsuppress-uniques'])
 test('T11680', normal, compile_fail, ['-v0'])
 test('T11809', normal, compile, ['-v0'])