[commit: ghc] master: Use a correct substitution in tcCheckPatSynDecl (07ed241)

[git at git.haskell.org]

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

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

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

commit 07ed24132ebe62aab15f14a655506decdf252ff9
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Tue Feb 2 05:02:23 2016 -0800

    Use a correct substitution in tcCheckPatSynDecl
    
    The `substTheta` call didn't have the free variables of the
    `prov_theta` in the `in_scope` set. It should be enough to add
    `univ_tvs`, as all the `ex_tvs` are already in the domain of
    the substitution.
    
    Test Plan: added a testcase
    
    Reviewers: simonpj, bgamari, goldfire, austin
    
    Reviewed By: simonpj, bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1879
    
    GHC Trac Issues: #11524


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

07ed24132ebe62aab15f14a655506decdf252ff9
 compiler/typecheck/TcPatSyn.hs                     |  8 +++++++-
 testsuite/tests/typecheck/should_compile/T11524.hs | 18 ++++++++++++++++++
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 3 files changed, 26 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs
index 707f706..f3aaa23 100644
--- a/compiler/typecheck/TcPatSyn.hs
+++ b/compiler/typecheck/TcPatSyn.hs
@@ -251,7 +251,13 @@ tcCheckPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details
                                     else newMetaSigTyVars ex_tvs
                     -- See the "Existential type variables part of
                     -- Note [Checking against a pattern signature]
-              ; prov_dicts <- mapM (emitWanted origin) (substTheta subst prov_theta)
+              ; prov_dicts <- mapM (emitWanted origin)
+                  (substTheta (extendTCvInScopeList subst univ_tvs) prov_theta)
+                  -- Add the free vars of 'prov_theta' to the in_scope set to
+                  -- satisfy the substition invariant. There's no need to
+                  -- add 'ex_tvs' as they are already in the domain of the
+                  -- substitution.
+                  -- See also Note [The substitution invariant] in TyCoRep.
               ; args'      <- zipWithM (tc_arg subst) arg_names arg_tys
               ; return (ex_tvs', prov_dicts, args') }
 
diff --git a/testsuite/tests/typecheck/should_compile/T11524.hs b/testsuite/tests/typecheck/should_compile/T11524.hs
new file mode 100644
index 0000000..d257554
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T11524.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TypeInType #-}
+
+module T11524 where
+
+data AType (a :: k) where
+    AMaybe :: AType Maybe
+    AInt :: AType Int
+    AApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
+            AType a -> AType b -> AType (a b)
+
+pattern PApp :: () => (fun ~ a b) => AType a -> AType b -> AType fun
+--pattern PApp :: forall k (fun :: k) k1 (a :: k1 -> k) (b :: k1).
+--            () => (fun ~ a b) => AType a -> AType b -> AType fun
+pattern PApp fun arg <- AApp fun arg
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index e6f0cfa..b269f58 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -502,3 +502,4 @@ test('RebindHR', normal, compile, [''])
 test('RebindNegate', normal, compile, [''])
 test('T11397', normal, compile, [''])
 test('T11458', normal, compile, [''])
+test('T11524', normal, compile, [''])