Print module when dumping rules
authorMatthew Pickering <matthewtpickering@gmail.com>
Wed, 29 Mar 2017 20:08:40 +0000 (16:08 -0400)
committerBen Gamari <ben@smart-cactus.org>
Wed, 29 Mar 2017 20:08:45 +0000 (16:08 -0400)
It is sometimes hard to find where a rule is defined. Printing the
module where it comes from will make it much easier to find.

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3378

compiler/coreSyn/CoreSyn.hs
compiler/simplCore/Simplify.hs
compiler/specialise/Rules.hs
testsuite/tests/indexed-types/should_compile/T7837.stderr
testsuite/tests/perf/compiler/T4007.stdout
testsuite/tests/simplCore/should_compile/T6056.stderr
testsuite/tests/simplCore/should_compile/T8848.stdout

index 6762ed6..bee6289 100644 (file)
@@ -4,6 +4,7 @@
 -}
 
 {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
 module CoreSyn (
@@ -89,7 +90,7 @@ module CoreSyn (
 
         -- ** Operations on 'CoreRule's
         ruleArity, ruleName, ruleIdName, ruleActivation,
-        setRuleIdName,
+        setRuleIdName, ruleModule,
         isBuiltinRule, isLocalRule, isAutoRule,
 
         -- * Core vectorisation declarations data type
@@ -1246,6 +1247,10 @@ ruleArity (Rule {ru_args = args})      = length args
 ruleName :: CoreRule -> RuleName
 ruleName = ru_name
 
+ruleModule :: CoreRule -> Maybe Module
+ruleModule Rule { ru_origin } = Just ru_origin
+ruleModule BuiltinRule {} = Nothing
+
 ruleActivation :: CoreRule -> Activation
 ruleActivation (BuiltinRule { })       = AlwaysActive
 ruleActivation (Rule { ru_act = act }) = act
index 43006f8..2e814b6 100644 (file)
@@ -51,6 +51,7 @@ import FastString
 import Pair
 import Util
 import ErrUtils
+import Module          ( moduleName, pprModuleName )
 
 {-
 The guts of the simplifier is in this module, but the driver loop for
@@ -1784,7 +1785,7 @@ tryRules env rules fn args call_cont
              do { nodump dflags  -- This ensures that an empty file is written
                 ; return Nothing } ;  -- No rule matches
            Just (rule, rule_rhs) ->
-             do { checkedTick (RuleFired (ru_name rule))
+             do { checkedTick (RuleFired (ruleName rule))
                 ; let cont' = pushSimplifiedArgs env
                                                  (drop (ruleArity rule) args)
                                                  call_cont
@@ -1796,17 +1797,23 @@ tryRules env rules fn args call_cont
                 ; dump dflags rule rule_rhs
                 ; return (Just (occ_anald_rhs, cont')) }}}
   where
+    printRuleModule rule =
+      parens
+        (maybe (text "BUILTIN") (pprModuleName . moduleName) (ruleModule rule))
+
     dump dflags rule rule_rhs
       | dopt Opt_D_dump_rule_rewrites dflags
       = log_rule dflags Opt_D_dump_rule_rewrites "Rule fired" $ vcat
-          [ text "Rule:" <+> ftext (ru_name rule)
+          [ text "Rule:" <+> ftext (ruleName rule)
+          , text "Module:" <+>  printRuleModule rule
           , text "Before:" <+> hang (ppr fn) 2 (sep (map ppr args))
           , text "After: " <+> pprCoreExpr rule_rhs
           , text "Cont:  " <+> ppr call_cont ]
 
       | dopt Opt_D_dump_rule_firings dflags
       = log_rule dflags Opt_D_dump_rule_firings "Rule fired:" $
-          ftext (ru_name rule)
+          ftext (ruleName rule)
+            <+> printRuleModule rule
 
       | otherwise
       = return ()
index 1dcff82..83b4e8d 100644 (file)
@@ -263,7 +263,7 @@ pprRulesForUser :: DynFlags -> [CoreRule] -> SDoc
 pprRulesForUser dflags rules
   = withPprStyle (defaultUserStyle dflags) $
     pprRules $
-    sortBy (comparing ru_name) $
+    sortBy (comparing ruleName) $
     tidyRules emptyTidyEnv rules
 
 {-
@@ -420,7 +420,7 @@ findBest target (rule1,ans1) ((rule2,ans2):prs)
   | rule2 `isMoreSpecific` rule1 = findBest target (rule2,ans2) prs
   | debugIsOn = let pp_rule rule = sdocWithPprDebug $ \dbg -> if dbg
                         then ppr rule
-                        else doubleQuotes (ftext (ru_name rule))
+                        else doubleQuotes (ftext (ruleName rule))
                 in pprTrace "Rules.findBest: rule overlap (Rule 1 wins)"
                          (vcat [ sdocWithPprDebug $ \dbg -> if dbg
                                    then text "Expression to match:" <+> ppr fn
index 7fd0a48..eb68261 100644 (file)
@@ -1,5 +1,5 @@
-Rule fired: Class op signum
-Rule fired: Class op abs
-Rule fired: Class op HEq_sc
-Rule fired: normalize/Double
-Rule fired: Class op HEq_sc
+Rule fired: Class op signum (BUILTIN)
+Rule fired: Class op abs (BUILTIN)
+Rule fired: Class op HEq_sc (BUILTIN)
+Rule fired: normalize/Double (T7837)
+Rule fired: Class op HEq_sc (BUILTIN)
index 59c81d9..7cbc345 100644 (file)
@@ -1,8 +1,8 @@
-Rule fired: Class op >>
-Rule fired: Class op return
-Rule fired: unpack
-Rule fired: Class op foldr
-Rule fired: fold/build
-Rule fired: <#
-Rule fired: tagToEnum#
-Rule fired: unpack-list
+Rule fired: Class op >> (BUILTIN)
+Rule fired: Class op return (BUILTIN)
+Rule fired: unpack (GHC.Base)
+Rule fired: Class op foldr (BUILTIN)
+Rule fired: fold/build (GHC.Base)
+Rule fired: <# (BUILTIN)
+Rule fired: tagToEnum# (BUILTIN)
+Rule fired: unpack-list (GHC.Base)
index 5ef76c0..a1f022e 100644 (file)
@@ -1,5 +1,5 @@
-Rule fired: SPEC/T6056 $wsmallerAndRest @ Int
-Rule fired: Class op <
-Rule fired: SPEC/T6056 $wsmallerAndRest @ Int
-Rule fired: SPEC/T6056 $wsmallerAndRest @ Int
-Rule fired: SPEC/T6056 $wsmallerAndRest @ Int
+Rule fired: SPEC/T6056 $wsmallerAndRest @ Int (T6056)
+Rule fired: Class op < (BUILTIN)
+Rule fired: SPEC/T6056 $wsmallerAndRest @ Int (T6056)
+Rule fired: SPEC/T6056 $wsmallerAndRest @ Int (T6056)
+Rule fired: SPEC/T6056 $wsmallerAndRest @ Int (T6056)
index de0d424..c4a33ad 100644 (file)
@@ -1,2 +1,2 @@
-Rule fired: SPEC map2
-Rule fired: SPEC map2
+Rule fired: SPEC map2 (T8848)
+Rule fired: SPEC map2 (T8848)