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

git at git.haskell.org git at git.haskell.org
Thu Oct 16 14:24:13 UTC 2014


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

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

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

commit 09a6b895b8ba9431566f4ef339d6cc4e7d44a12d
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


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

09a6b895b8ba9431566f4ef339d6cc4e7d44a12d
 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 f649e27..666a270 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -56,6 +56,7 @@ import Data.List	( partition, sort )
 import Maybes		( orElse )
 import Control.Monad
 import Data.Traversable ( traverse )
+import Util             ( filterOut )
 \end{code}
 
 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
@@ -855,10 +856,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
 



More information about the ghc-commits mailing list