-data ProtoCoreRule
- = ProtoCoreRule
- Bool -- True <=> this rule was defined in this module,
- Id -- What Id is it for
- CoreRule -- The rule itself
-
-
-pprProtoCoreRule (ProtoCoreRule _ fn rule) = pprCoreRule (Just fn) rule
-
-lookupRule :: InScopeSet -> Id -> [CoreExpr] -> Maybe (FAST_STRING, CoreExpr, [CoreExpr])
-lookupRule in_scope fn args
- = case getIdSpecialisation fn of
- Rules rules _ -> matchRules in_scope rules args
-
-orphanRule :: ProtoCoreRule -> Bool
--- An "orphan rule" is one that is defined in this
--- module, but of ran *imported* function. We need
--- to track these separately when generating the interface file
-orphanRule (ProtoCoreRule local fn _)
- = local && not (isLocallyDefined fn)
+ruleCheckFun :: RuleCheckEnv -> Id -> [CoreExpr] -> Bag SDoc
+-- Produce a report for all rules matching the predicate
+-- saying why it doesn't match the specified application
+
+ruleCheckFun (phase, pat) fn args
+ | null name_match_rules = emptyBag
+ | otherwise = unitBag (ruleAppCheck_help phase fn args name_match_rules)
+ where
+ name_match_rules = case idSpecialisation fn of
+ Rules rules _ -> filter match rules
+ match rule = pat `isPrefixOf` unpackFS (ruleName rule)
+
+ruleAppCheck_help :: CompilerPhase -> Id -> [CoreExpr] -> [CoreRule] -> SDoc
+ruleAppCheck_help phase fn args rules
+ = -- The rules match the pattern, so we want to print something
+ vcat [text "Expression:" <+> ppr (mkApps (Var fn) args),
+ vcat (map check_rule rules)]
+ where
+ n_args = length args
+ i_args = args `zip` [1::Int ..]
+
+ check_rule rule = rule_herald rule <> colon <+> rule_info rule
+
+ rule_herald (BuiltinRule name _) =
+ ptext SLIT("Builtin rule") <+> doubleQuotes (ftext name)
+ rule_herald (Rule name _ _ _ _) =
+ ptext SLIT("Rule") <+> doubleQuotes (ftext name)
+
+ rule_info rule
+ | Just (name,_) <- matchRule noBlackList emptyInScopeSet rule args
+ = text "matches (which is very peculiar!)"
+
+ rule_info (BuiltinRule name fn) = text "does not match"
+
+ rule_info (Rule name act rule_bndrs rule_args _)
+ | not (isActive phase act) = text "active only in later phase"
+ | n_args < n_rule_args = text "too few arguments"
+ | n_mismatches == n_rule_args = text "no arguments match"
+ | n_mismatches == 0 = text "all arguments match (considered individually), but the rule as a whole does not"
+ | otherwise = text "arguments" <+> ppr mismatches <+> text "do not match (1-indexing)"
+ where
+ n_rule_args = length rule_args
+ n_mismatches = length mismatches
+ mismatches = [i | (rule_arg, (arg,i)) <- rule_args `zip` i_args,
+ not (isJust (match_fn rule_arg arg))]
+
+ bndr_set = mkVarSet rule_bndrs
+ match_fn rule_arg arg = match rule_arg arg bndr_set (\s -> Just ()) emptySubst