[commit: ghc] wip/T9732: When calling the success continuation of a matcher, pass existential tyvars as type arguments, not value arguments (ab4762a)

git at git.haskell.org git at git.haskell.org
Thu Nov 13 10:53:10 UTC 2014


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

On branch  : wip/T9732
Link       : http://ghc.haskell.org/trac/ghc/changeset/ab4762a15268206bce3a45f662c50d2469ed5b4c/ghc

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

commit ab4762a15268206bce3a45f662c50d2469ed5b4c
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Thu Nov 13 17:47:18 2014 +0800

    When calling the success continuation of a matcher, pass existential tyvars
    as type arguments, not value arguments


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

ab4762a15268206bce3a45f662c50d2469ed5b4c
 compiler/typecheck/TcPatSyn.lhs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs
index 8ba69fd..d6f6817 100644
--- a/compiler/typecheck/TcPatSyn.lhs
+++ b/compiler/typecheck/TcPatSyn.lhs
@@ -37,7 +37,6 @@ import Data.Monoid
 import Bag
 import TcEvidence
 import BuildTyCl
-import TypeRep
 import Data.Maybe
 
 #include "HsVersions.h"
@@ -139,7 +138,7 @@ tcPatSynMatcher (L loc name) lpat args univ_tvs ex_tvs ev_binds prov_dicts req_d
               ; let tv_name = mkInternalName uniq (mkTyVarOcc "r") loc
               ; return $ mkTcTyVar tv_name openTypeKind (SkolemTv False) }
        ; matcher_name <- newImplicitBinder name mkMatcherOcc
-       ; let res_ty = TyVarTy res_tv
+       ; let res_ty = mkTyVarTy res_tv
              cont_args = if null args then [voidPrimId] else args
              cont_ty = mkSigmaTy ex_tvs prov_theta $
                        mkFunTys (map varType cont_args) res_ty
@@ -154,7 +153,8 @@ tcPatSynMatcher (L loc name) lpat args univ_tvs ex_tvs ev_binds prov_dicts req_d
 
        ; scrutinee <- mkId "scrut" pat_ty
        ; cont <- mkId "cont" cont_ty
-       ; let cont' = nlHsApps cont $ map nlHsVar (ex_tvs ++ prov_dicts ++ cont_args)
+       ; let cont' = nlHsTyApps cont (map mkTyVarTy ex_tvs) $
+                     map nlHsVar (prov_dicts ++ cont_args)
        ; fail <- mkId "fail" fail_ty
        ; let fail' = nlHsApps fail [nlHsVar voidPrimId]
 



More information about the ghc-commits mailing list