Remember the free vars in HsRule.

[ghc-hetmet.git] / ghc / compiler / typecheck / TcHsSyn.lhs

diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs
index c938a76..6389f34 100644 (file)
--- a/ghc/compiler/typecheck/TcHsSyn.lhs
+++ b/ghc/compiler/typecheck/TcHsSyn.lhs
@@ -72,7 +72,7 @@ mkVanillaTuplePat pats box
   = TuplePat pats box (mkTupleTy box (length pats) (map hsPatType pats))
 
 hsPatType :: OutPat Id -> Type
-hsPatType pat = pat_type (unLoc pat)
+hsPatType (L _ pat) = pat_type pat
 
 pat_type (ParPat pat)             = hsPatType pat
 pat_type (WildPat ty)             = ty
@@ -822,7 +822,7 @@ zonkRules :: ZonkEnv -> [LRuleDecl TcId] -> TcM [LRuleDecl Id]
 zonkRules env rs = mappM (wrapLocM (zonkRule env)) rs
 
 zonkRule :: ZonkEnv -> RuleDecl TcId -> TcM (RuleDecl Id)
-zonkRule env (HsRule name act (vars::[RuleBndr TcId]) lhs rhs)
+zonkRule env (HsRule name act (vars::[RuleBndr TcId]) lhs fv_lhs rhs fv_rhs)
   = mappM zonk_bndr vars               `thenM` \ new_bndrs ->
     newMutVar emptyVarSet              `thenM` \ unbound_tv_set ->
     let
@@ -858,7 +858,7 @@ zonkRule env (HsRule name act (vars::[RuleBndr TcId]) lhs rhs)
        final_bndrs :: [Located Var]
        final_bndrs = map noLoc (varSetElems unbound_tvs) ++ new_bndrs
     in
-    returnM (HsRule name act (map RuleBndr final_bndrs) new_lhs new_rhs)
+    returnM (HsRule name act (map RuleBndr final_bndrs) new_lhs fv_lhs new_rhs fv_rhs)
                -- I hate this map RuleBndr stuff
   where
    zonk_bndr (RuleBndr v)