X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FRules.lhs;h=24c400491ce85b5d1c12281bb18311cdea097b65;hb=92e7ecbcc393caab7f0d8883a51cbfca42767cb1;hp=26a499bfebc8a1f00c4264eb2f213d38043742de;hpb=262c142b90c94ca1aa577c950a6ceae1f255e2d6;p=ghc-hetmet.git diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs index 26a499b..24c4004 100644 --- a/compiler/specialise/Rules.lhs +++ b/compiler/specialise/Rules.lhs @@ -4,6 +4,13 @@ \section[CoreRules]{Transformation rules} \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module Rules ( RuleBase, emptyRuleBase, mkRuleBase, extendRuleBaseList, unionRuleBase, pprRuleBase, ruleCheckProgram, @@ -588,11 +595,8 @@ match menv subst (Type ty1) (Type ty2) = match_ty menv subst ty1 ty2 match menv subst (Cast e1 co1) (Cast e2 co2) - | (from1, to1) <- coercionKind co1 - , (from2, to2) <- coercionKind co2 - = do { subst1 <- match_ty menv subst to1 to2 - ; subst2 <- match_ty menv subst1 from1 from2 - ; match menv subst2 e1 e2 } + = do { subst1 <- match_ty menv subst co1 co2 + ; match menv subst1 e1 e2 } {- REMOVING OLD CODE: I think that the above handling for let is better than the stuff here, which looks @@ -639,6 +643,8 @@ match_var menv subst@(tv_subst, id_subst, binds) v1 e2 | otherwise -- No renaming to do on e2, because no free var -- of e2 is in the rnEnvR of the envt + -- Note [Matching variable types] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- However, we must match the *types*; e.g. -- forall (c::Char->Int) (x::Char). -- f (c x) = "RULE FIRED"