[commit: ghc] supercompiler: Check for kindvar/tyvar mismatch in MSG (5725453)
Max Bolingbroke <[email protected]>
| Newsgroups | gmane.comp.lang.haskell.cvs.ghc |
|---|---|
| Message-ID | <[email protected]> |
Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler http://hackage.haskell.org/trac/ghc/changeset/57254539467a9e15182952db4280104f256b485d >--------------------------------------------------------------- commit 57254539467a9e15182952db4280104f256b485d Author: Max Bolingbroke <[email protected]> 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)