-tcRule (HsRule name act vars lhs fv_lhs rhs fv_rhs)
- = addErrCtxt (ruleCtxt name) $
- traceTc (ptext SLIT("---- Rule ------")
- <+> ppr name) `thenM_`
- newFlexiTyVarTy openTypeKind `thenM` \ rule_ty ->
-
- -- Deal with the tyvars mentioned in signatures
- tcRuleBndrs vars (\ ids ->
- -- Now LHS and RHS
- getLIE (tcMonoExpr lhs rule_ty) `thenM` \ (lhs', lhs_lie) ->
- getLIE (tcMonoExpr rhs rule_ty) `thenM` \ (rhs', rhs_lie) ->
- returnM (ids, lhs', rhs', lhs_lie, rhs_lie)
- ) `thenM` \ (ids, lhs', rhs', lhs_lie, rhs_lie) ->
-
- -- Check that LHS has no overloading at all
- getLIE (tcSimplifyToDicts lhs_lie) `thenM` \ (lhs_binds, lhs_dicts) ->
-
- -- 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