[commit: ghc] supercompiler: Make corresponding TyVar/KindVar changes to Match (75adf92)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/75adf92acf2eb9a9a4e1adedba1e53acf5e1377e

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

commit 75adf92acf2eb9a9a4e1adedba1e53acf5e1377e
Author: Max Bolingbroke <[email protected]>
Date:   Wed Apr 25 18:37:02 2012 +0100

    Make corresponding TyVar/KindVar changes to Match

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

 compiler/supercompile/Supercompile/Drive/Match.hs |   16 +++++++++-------
 1 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Drive/Match.hs b/compiler/supercompile/Supercompile/Drive/Match.hs
index 02d6135..cade7f7 100644
--- a/compiler/supercompile/Supercompile/Drive/Match.hs
+++ b/compiler/supercompile/Supercompile/Drive/Match.hs
@@ -23,7 +23,7 @@ import Var        (TyVar, isTyVar, isId, tyVarKind, setVarType)
 import Id         (Id, idType, realIdUnfolding, idSpecialisation, zapFragileIdInfo)
 import IdInfo     (SpecInfo(..), emptySpecInfo)
 import VarEnv
-import TypeRep    (Kind, Type(..))
+import TypeRep    (Kind, Type(..), isKindVar)
 
 import qualified Control.Monad
 import Control.Monad.Fix
@@ -240,9 +240,10 @@ matchAltCon rn2 DefaultAlt                    DefaultAlt                    k =
 matchAltCon _ _ _ _ = fail "matchAltCon"
 
 matchVarBndr :: Bool -> RnEnv2 -> Var -> Var -> (RnEnv2 -> Match [MatchLR]) -> Match [MatchLR]
-matchVarBndr lambdaish rn2 v_l v_r | isId v_l,    isId v_r    = matchIdCoVarBndr lambdaish rn2 v_l v_r
-                                   | isTyVar v_l, isTyVar v_r = matchTyVarBndr             rn2 v_l v_r -- Type variable binders never lose work sharing
-                                   | otherwise                = fail "matchVarBndr"
+matchVarBndr lambdaish rn2 v_l v_r k | isId      v_l = guard "matchVarBndr: Id"      (isId      v_r) >> matchIdCoVarBndr lambdaish rn2 v_l v_r k
+                                     | isKindVar v_l = guard "matchVarBndr: KindVar" (isKindVar v_r) >> matchTyVarBndr             rn2 v_l v_r k -- Type variable binders never
+                                     | isTyVar   v_l = guard "matchVarBndr: TyVar"   (isTyVar   v_r) >> matchTyVarBndr             rn2 v_l v_r k -- lose work sharing
+                                     | otherwise     = panic "matchVarBndr"
 
 matchTyVarBndr :: RnEnv2 -> TyVar -> TyVar -> (RnEnv2 -> Match [MatchLR]) -> Match [MatchLR]
 matchTyVarBndr rn2 a_l a_r k = liftM2 (++) (matchKind rn2 (tyVarKind a_l) (tyVarKind a_r)) (k (rnBndr2 rn2 a_l a_r))
@@ -273,9 +274,10 @@ matchIdCoVarBndr' init_rn2 x_l x_r = (pprTraceSC "matchIdCoVarBndr'" (ppr (x_l,
 
 matchBndrExtras :: RnEnv2 -> Var -> Var -> Match [MatchLR]
 matchBndrExtras rn2 v_l v_r
-  | isId v_l,    isId v_r    = matchIdCoVarBndrExtras rn2 v_l v_r
-  | isTyVar v_l, isTyVar v_r = matchTyVarBndrExtras   rn2 v_l v_r
-  | otherwise                = fail "matchBndrExtras"
+  | isId      v_l = guard "matchBndrExtras: Id"      (isId      v_r) >> matchIdCoVarBndrExtras rn2 v_l v_r
+  | isKindVar v_l = guard "matchBndrExtras: KindVar" (isKindVar v_r) >> matchTyVarBndrExtras   rn2 v_l v_r
+  | isTyVar   v_l = guard "matchBndrExtras: TyVar"   (isTyVar   v_r) >> matchTyVarBndrExtras   rn2 v_l v_r
+  | otherwise     = panic "matchBndrExtras"
 
 matchTyVarBndrExtras :: RnEnv2 -> TyVar -> TyVar -> Match [MatchLR]
 matchTyVarBndrExtras rn2 a_l a_r = matchKind rn2 (tyVarKind a_l) (tyVarKind a_r)