[commit: ghc] wip/T8584: universially-bound tyvars are in scope when renaming existentially-bound tyvars in a pattern synonym signature (ffc72bb)

[git at git.haskell.org]

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

On branch  : wip/T8584
Link       : http://ghc.haskell.org/trac/ghc/changeset/ffc72bb3e9193eb6335899430c5b80328d322ba1/ghc

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

commit ffc72bb3e9193eb6335899430c5b80328d322ba1
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Mon Jul 28 16:42:30 2014 +0200

    universially-bound tyvars are in scope when renaming existentially-bound
    tyvars in a pattern synonym signature


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

ffc72bb3e9193eb6335899430c5b80328d322ba1
 compiler/rename/RnBinds.lhs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index 7f715b6..4a98a35 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -50,6 +50,7 @@ import FastString
 import Data.List        ( partition, sort )
 import Maybes           ( orElse )
 import Control.Monad
+import Util             ( filterOut )
 #if __GLASGOW_HASKELL__ < 709
 import Data.Traversable ( traverse )
 #endif
@@ -865,10 +866,14 @@ renameSig ctxt sig@(PatSynSig v args ty (ex_flag, _ex_tvs, prov) (univ_flag, _un
                               (ty2', fvs2) <- rnLHsType doc ty2
                               return (InfixPatSyn ty1' ty2', fvs1 `plusFV` fvs2)
                       in ([ty1, ty2], rnArgs)
+
         ; let (ex_kvs, ex_tvs) = extractHsTysRdrTyVars (arg_tys ++ unLoc prov)
-        ; let ex_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ ex_tvs
+              ex_kvs' = filterOut (`elem` univ_kvs) ex_kvs
+              ex_tvs' = filterOut (`elem` univ_tvs) ex_tvs
+
+        ; let ex_tv_bndrs = mkHsQTvs . userHsTyVarBndrs loc $ ex_tvs'
 
-        ; bindHsTyVars doc Nothing ex_kvs ex_tv_bndrs $ \ ex_tyvars -> do
+        ; bindHsTyVars doc Nothing ex_kvs' ex_tv_bndrs $ \ ex_tyvars -> do
         { (prov', fvs3) <- rnContext doc prov
         ; (args', fvs4) <- rnArgs