-tcRule (HsRule name act vars lhs fv_lhs rhs fv_rhs)
- = addErrCtxt (ruleCtxt name) $ do
- traceTc (ptext SLIT("---- Rule ------") <+> ppr name)
- rule_ty <- newFlexiTyVarTy openTypeKind
-
- -- Deal with the tyvars mentioned in signatures
- (ids, lhs', rhs', lhs_lie, rhs_lie) <-
- tcRuleBndrs vars $ \ ids -> do
- -- Now LHS and RHS
- (lhs', lhs_lie) <- getLIE (tcMonoExpr lhs rule_ty)
- (rhs', rhs_lie) <- getLIE (tcMonoExpr rhs rule_ty)
- return (ids, lhs', rhs', lhs_lie, rhs_lie)
-
- -- Check that LHS has no overloading at all
- (lhs_dicts, lhs_binds) <- tcSimplifyRuleLhs lhs_lie
-
- -- Gather the template variables and tyvars
- let
- tpl_ids = map instToId lhs_dicts ++ ids
+tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs)
+ = addErrCtxt (ruleCtxt name) $
+ do { traceTc "---- Rule ------" (ppr name)
+
+ -- Note [Typechecking rules]
+ ; vars <- tcRuleBndrs hs_bndrs
+ ; let (id_bndrs, tv_bndrs) = partition isId vars
+ ; (lhs', lhs_lie, rhs', rhs_lie, rule_ty)
+ <- tcExtendTyVarEnv tv_bndrs $
+ tcExtendIdEnv id_bndrs $
+ do { ((lhs', rule_ty), lhs_lie) <- captureConstraints (tcInferRho lhs)
+ ; (rhs', rhs_lie) <- captureConstraints (tcMonoExpr rhs rule_ty)
+ ; return (lhs', lhs_lie, rhs', rhs_lie, rule_ty) }
+
+ ; (lhs_dicts, lhs_ev_binds, rhs_ev_binds)
+ <- simplifyRule name tv_bndrs lhs_lie rhs_lie