-tcRules :: PackageRuleEnv -> [RenamedHsDecl] -> TcM (PackageRuleEnv, LIE, [TypecheckedRuleDecl])
-tcRules pkg_rule_env decls
- = mapAndUnzipTc tcLocalRule local_rules `thenTc` \ (lies, new_local_rules) ->
- mapTc tcIfaceRule imported_rules `thenTc` \ new_imported_rules ->
- returnTc (extendRuleBaseList pkg_rule_env new_imported_rules,
- plusLIEs lies, new_local_rules)
- where
- rule_decls = [rule | RuleD rule <- decls]
- (imported_rules, local_rules) = partition isIfaceRuleDecl rule_decls
-
-tcIfaceRule :: RenamedRuleDecl -> TcM (Id, CoreRule)
- -- No zonking necessary!
-tcIfaceRule (IfaceRule name vars fun args rhs src_loc)
- = tcAddSrcLoc src_loc $
- tcAddErrCtxt (ruleCtxt name) $
- tcVar fun `thenTc` \ fun' ->
- tcCoreLamBndrs vars $ \ vars' ->
- mapTc tcCoreExpr args `thenTc` \ args' ->
- tcCoreExpr rhs `thenTc` \ rhs' ->
- returnTc (fun', Rule name vars' args' rhs')
-
-tcLocalRule :: RenamedRuleDecl -> TcM (LIE, TypecheckedRuleDecl)
-tcLocalRule (HsRule name sig_tvs vars lhs rhs src_loc)
- = tcAddSrcLoc src_loc $
- tcAddErrCtxt (ruleCtxt name) $
- newTyVarTy openTypeKind `thenNF_Tc` \ rule_ty ->
+tcRules :: [RenamedRuleDecl] -> TcM [TypecheckedRuleDecl]
+tcRules decls = mappM tcRule decls
+
+tcRule :: RenamedRuleDecl -> TcM TypecheckedRuleDecl
+tcRule (HsRule name act vars lhs rhs src_loc)
+ = addSrcLoc src_loc $
+ addErrCtxt (ruleCtxt name) $
+ traceTc (ptext SLIT("---- Rule ------")
+ <+> ppr name) `thenM_`
+ newTyVarTy openTypeKind `thenM` \ rule_ty ->