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

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/57254539467a9e15182952db4280104f256b485d

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

commit 57254539467a9e15182952db4280104f256b485d
Author: Max Bolingbroke <batterseapo...@hotmail.com>
Date:   Wed Apr 25 18:31:52 2012 +0100

    Check for kindvar/tyvar mismatch in MSG

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

 compiler/supercompile/Supercompile/Drive/MSG.hs |   14 ++++++++------
 1 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Drive/MSG.hs 
b/compiler/supercompile/Supercompile/Drive/MSG.hs
index 90ecaf8..d131eee 100644
--- a/compiler/supercompile/Supercompile/Drive/MSG.hs
+++ b/compiler/supercompile/Supercompile/Drive/MSG.hs
@@ -595,9 +595,10 @@ msgAltCon rn2 DefaultAlt                    DefaultAlt     
               k = li
 msgAltCon _ _ _ _ = fail "msgAltCon"
 
 msgVarBndr :: (Var -> b -> c) -> RnEnv2 -> Var -> Var -> (RnEnv2 -> MSG b) -> 
MSG c
-msgVarBndr f rn2 v_l v_r | isId v_l,    isId v_r    = msgIdCoVarBndr f rn2 v_l 
v_r
-                         | isTyVar v_l, isTyVar v_r = msgTyVarBndr   f rn2 v_l 
v_r
-                         | otherwise                = \_ -> fail "msgVarBndr"
+msgVarBndr f rn2 v_l v_r k | isId      v_l = guard "msgVarBndr: Id"      (isId 
v_r)      >> msgIdCoVarBndr f rn2 v_l v_r k
+                           | isKindVar v_l = guard "msgVarBndr: KindVar" 
(isKindVar v_r) >> msgTyVarBndr   f rn2 v_l v_r k
+                           | isTyVar   v_l = guard "msgVarBndr: TyVar"   
(isTyVar v_r)   >> msgTyVarBndr   f rn2 v_l v_r k
+                           | otherwise     = panic "msgVarBndr"
 
 msgTyVarBndr :: (TyVar -> b -> c) -> RnEnv2 -> TyVar -> TyVar -> (RnEnv2 -> 
MSG b) -> MSG c
 msgTyVarBndr f rn2 a_l a_r k = do
@@ -622,9 +623,10 @@ msgIdCoVarBndr' init_rn2 x_l x_r = (pprTraceSC 
"msgIdCoVarBndr'" (ppr (x_l, x_r)
 
 msgBndrExtras :: RnEnv2 -> Var -> Var -> Var -> MSG Var
 msgBndrExtras rn2 v v_l v_r
-  | isId v_l,    isId v_r    = msgIdCoVarBndrExtras rn2 v v_l v_r
-  | isTyVar v_l, isTyVar v_r = msgTyVarBndrExtras   rn2 v v_l v_r
-  | otherwise                = fail "msgBndrExtras"
+  | isId      v_l = guard "msgBndrExtras: Id"      (isId      v_r) >> 
msgIdCoVarBndrExtras rn2 v v_l v_r
+  | isKindVar v_l = guard "msgBndrExtras: KindVar" (isKindVar v_r) >> 
msgTyVarBndrExtras   rn2 v v_l v_r
+  | isTyVar   v_l = guard "msgBndrExtras: TyVar"   (isTyVar   v_r) >> 
msgTyVarBndrExtras   rn2 v v_l v_r
+  | otherwise     = panic "msgBndrExtras"
 
 msgTyVarBndrExtras :: RnEnv2 -> TyVar -> TyVar -> TyVar -> MSG TyVar
 msgTyVarBndrExtras rn2 a a_l a_r = liftM (a `setTyVarKind`) $ msgKind rn2 
(tyVarKind a_l) (tyVarKind a_r)



_______________________________________________
Cvs-ghc mailing list
Cvs-ghc@haskell.org
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to