Commit 2d88a531 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Improve warnings for rules that might not fire

Two main things here

* Previously we only warned about the "head" function of the rule,
  but actually the warning applies to any free variable on the LHS.

* We now warn not only when one of these free vars can inline, but
  also if it has an active RULE (c.f. Trac #10528)

See Note [Rules and inlining/other rules] in Desugar

This actually shows up quite a few warnings in the libraries, notably
in Control.Arrow, where it correctly points out that rules like
    "compose/arr"   forall f g .
                    (arr f) . (arr g) = arr (f . g)
might never fire, because the rule for 'arr' (dictionary selection)
might fire first.  I'm not really sure what to do here; there is some
discussion in Trac #10595.

A minor change is adding BasicTypes.pprRuleName to pretty-print RuleName.
parent bc4b64ca
......@@ -37,7 +37,7 @@ module BasicTypes(
RecFlag(..), isRec, isNonRec, boolToRecFlag,
Origin(..), isGenerated,
RuleName,
RuleName, pprRuleName,
TopLevelFlag(..), isTopLevel, isNotTopLevel,
......@@ -68,8 +68,10 @@ module BasicTypes(
SwapFlag(..), flipSwap, unSwap, isSwapped,
CompilerPhase(..), PhaseNum,
Activation(..), isActive, isActiveIn,
Activation(..), isActive, isActiveIn, competesWith,
isNeverActive, isAlwaysActive, isEarlyActive,
RuleMatchInfo(..), isConLike, isFunLike,
InlineSpec(..), isEmptyInlineSpec,
InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
......@@ -291,6 +293,9 @@ instance Outputable WarningTxt where
type RuleName = FastString
pprRuleName :: RuleName -> SDoc
pprRuleName rn = doubleQuotes (ftext rn)
{-
************************************************************************
* *
......@@ -877,7 +882,7 @@ instance Outputable CompilerPhase where
data Activation = NeverActive
| AlwaysActive
| ActiveBefore PhaseNum -- Active only *before* this phase
| ActiveBefore PhaseNum -- Active only *strictly before* this phase
| ActiveAfter PhaseNum -- Active in this phase and later
deriving( Eq, Data, Typeable ) -- Eq used in comparing rules in HsDecls
......@@ -1078,6 +1083,34 @@ isActiveIn _ AlwaysActive = True
isActiveIn p (ActiveAfter n) = p <= n
isActiveIn p (ActiveBefore n) = p > n
competesWith :: Activation -> Activation -> Bool
-- See Note [Activation competition]
competesWith NeverActive _ = False
competesWith _ NeverActive = False
competesWith AlwaysActive _ = True
competesWith (ActiveBefore {}) AlwaysActive = True
competesWith (ActiveBefore {}) (ActiveBefore {}) = True
competesWith (ActiveBefore a) (ActiveAfter b) = a > b
competesWith (ActiveAfter {}) AlwaysActive = False
competesWith (ActiveAfter {}) (ActiveBefore {}) = False
competesWith (ActiveAfter a) (ActiveAfter b) = a >= b
{- Note [Competing activations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sometimes a RULE and an inlining may compete, or two RULES.
See Note [Rules and inlining/other rules] in Desugar.
We say that act1 "competes with" act2 iff
act1 is active in the phase when act2 *becomes* active
It's too conservative to ensure that the two are never simultaneously
active. For example, a rule might be always active, and an inlining
might switch on in phase 2. We could switch off the rule, but it does
no harm.
-}
isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
isNeverActive NeverActive = True
isNeverActive _ = False
......
......@@ -25,6 +25,7 @@ import InstEnv
import Class
import Avail
import CoreSyn
import CoreFVs( exprsSomeFreeVars )
import CoreSubst
import PprCore
import DsMonad
......@@ -37,10 +38,11 @@ import NameEnv
import Rules
import TysPrim (eqReprPrimTyCon)
import TysWiredIn (coercibleTyCon )
import BasicTypes ( Activation(.. ) )
import BasicTypes ( Activation(.. ), competesWith, pprRuleName )
import CoreMonad ( CoreToDo(..) )
import CoreLint ( endPassIO )
import MkCore
import VarSet
import FastString
import ErrUtils
import Outputable
......@@ -346,7 +348,7 @@ Reason
-}
dsRule :: LRuleDecl Id -> DsM (Maybe CoreRule)
dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
dsRule (L loc (HsRule name rule_act vars lhs _tv_lhs rhs _fv_rhs))
= putSrcSpanDs loc $
do { let bndrs' = [var | L _ (RuleBndr (L _ var)) <- vars]
......@@ -355,7 +357,6 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
dsLExpr lhs -- Note [Desugaring RULE left hand sides]
; rhs' <- dsLExpr rhs
; dflags <- getDynFlags
; this_mod <- getModule
; (bndrs'', lhs'', rhs'') <- unfold_coerce bndrs' lhs' rhs'
......@@ -372,35 +373,55 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
-- because they don't show up in the bindings until just before code gen
fn_name = idName fn_id
final_rhs = simpleOptExpr rhs'' -- De-crap it
rule_name = snd (unLoc name)
rule = mkRule this_mod False {- Not auto -} is_local
(snd $ unLoc name) act fn_name final_bndrs args
rule_name rule_act fn_name final_bndrs args
final_rhs
arg_ids = varSetElems (exprsSomeFreeVars isId args `delVarSetList` final_bndrs)
; dflags <- getDynFlags
; when (wopt Opt_WarnInlineRuleShadowing dflags) $
warnRuleShadowing rule_name rule_act fn_id arg_ids
inline_shadows_rule -- Function can be inlined before rule fires
| wopt Opt_WarnInlineRuleShadowing dflags
, isLocalId fn_id || hasSomeUnfolding (idUnfolding fn_id)
; return (Just rule)
} } }
warnRuleShadowing :: RuleName -> Activation -> Id -> [Id] -> DsM ()
-- See Note [Rules and inlining/other rules]
warnRuleShadowing rule_name rule_act fn_id arg_ids
= do { check False fn_id -- We often have multiple rules for the same Id in a
-- module. Maybe we should check that they don't overlap
-- but currently we don't
; mapM_ (check True) arg_ids }
where
check check_rules_too lhs_id
| isLocalId lhs_id || canUnfold (idUnfolding lhs_id)
-- If imported with no unfolding, no worries
= case (idInlineActivation fn_id, act) of
(NeverActive, _) -> False
(AlwaysActive, _) -> True
(ActiveBefore {}, _) -> True
(ActiveAfter {}, NeverActive) -> True
(ActiveAfter n, ActiveAfter r) -> r < n -- Rule active strictly first
(ActiveAfter {}, AlwaysActive) -> False
(ActiveAfter {}, ActiveBefore {}) -> False
| otherwise = False
; when inline_shadows_rule $
warnDs (vcat [ hang (ptext (sLit "Rule")
<+> doubleQuotes (ftext $ snd $ unLoc name)
, idInlineActivation lhs_id `competesWith` rule_act
= warnDs (vcat [ hang (ptext (sLit "Rule") <+> pprRuleName rule_name
<+> ptext (sLit "may never fire"))
2 (ptext (sLit "because") <+> quotes (ppr fn_id)
2 (ptext (sLit "because") <+> quotes (ppr lhs_id)
<+> ptext (sLit "might inline first"))
, ptext (sLit "Probable fix: add an INLINE[n] or NOINLINE[n] pragma on")
<+> quotes (ppr fn_id) ])
, ptext (sLit "Probable fix: add an INLINE[n] or NOINLINE[n] pragma for")
<+> quotes (ppr lhs_id) ])
; return (Just rule)
} } }
| check_rules_too
, bad_rule : _ <- get_bad_rules lhs_id
= warnDs (vcat [ hang (ptext (sLit "Rule") <+> pprRuleName rule_name
<+> ptext (sLit "may never fire"))
2 (ptext (sLit "because rule") <+> pprRuleName (ruleName bad_rule)
<+> ptext (sLit "for")<+> quotes (ppr lhs_id)
<+> ptext (sLit "might fire first"))
, ptext (sLit "Probable fix: add phase [n] or [~n] to the competing rule")
, ifPprDebug (ppr bad_rule) ])
| otherwise
= return ()
get_bad_rules lhs_id
= [ rule | rule <- idCoreRules lhs_id
, ruleActivation rule `competesWith` rule_act ]
-- See Note [Desugaring coerce as cast]
unfold_coerce :: [Id] -> CoreExpr -> CoreExpr -> DsM ([Var], CoreExpr, CoreExpr)
......@@ -422,9 +443,8 @@ unfold_coerce bndrs lhs rhs = do
(bndrs,wrap) <- go vs
return (v:bndrs, wrap)
{-
Note [Desugaring RULE left hand sides]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
{- Note [Desugaring RULE left hand sides]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For the LHS of a RULE we do *not* want to desugar
[x] to build (\cn. x `c` n)
We want to leave explicit lists simply as chains
......@@ -439,7 +459,6 @@ Nor do we want to warn of conversion identities on the LHS;
the rule is precisly to optimise them:
{-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-}
Note [Desugaring coerce as cast]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We want the user to express a rule saying roughly “mapping a coercion over a
......@@ -454,6 +473,42 @@ corresponding `co :: a ~#R b` and wrap the LHS and the RHS in
`let c = MkCoercible co in ...`. This is later simplified to the desired form
by simpleOptExpr (for the LHS) resp. the simplifiers (for the RHS).
Note [Rules and inlining/other rules]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If you have
f x = ...
g x = ...
{-# RULES "rule-for-f" forall x. f (g x) = ... #-}
then there's a good chance that in a potential rule redex
...f (g e)...
then 'f' or 'g' will inline befor the rule can fire. Solution: add an
INLINE [n] or NOINLINE [n] pragma to 'f' and 'g'.
Note that this applies to all the free variables on the LHS, both the
main function and things in its arguments.
We also check if there are Ids on the LHS that have competing RULES.
In the above example, suppose we had
{-# RULES "rule-for-g" forally. g [y] = ... #-}
Then "rule-for-f" and "rule-for-g" would compete. Better to add phase
control, so "rule-for-f" has a chance to fire before "rule-for-g" becomes
active; or perhpas after "rule-for-g" has become inactive. This is checked
by 'competesWith'
Class methods have a built-in RULE to select the method from the dictionary,
so you can't change the phase on this. That makes id very dubious to
match on class methods in RULE lhs's. See Trac #10595. I'm not happy
about this. For exmaple in Control.Arrow we have
{-# RULES "compose/arr" forall f g .
(arr f) . (arr g) = arr (f . g) #-}
and similar, which will elicit exactly these warnings, and risk never
firing. But it's not clear what to do instead. We could make the
class methocd rules inactive in phase 2, but that would delay when
subsequent transformations could fire.
************************************************************************
* *
* Desugaring vectorisation declarations
......
......@@ -839,7 +839,7 @@ pprIfaceConDecl ss gadt_style mk_user_con_res_ty
instance Outputable IfaceRule where
ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
= sep [hsep [doubleQuotes (ftext name), ppr act,
= sep [hsep [pprRuleName name, ppr act,
ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
ptext (sLit "=") <+> ppr rhs])
......
......@@ -49,7 +49,8 @@ import DataCon
import PrelNames
import TysWiredIn
import TysPrim ( superKindTyConName )
import BasicTypes ( strongLoopBreaker, Arity, TupleSort(..), Boxity(..) )
import BasicTypes ( strongLoopBreaker, Arity, TupleSort(..)
, Boxity(..), pprRuleName )
import Literal
import qualified Var
import VarEnv
......@@ -638,7 +639,7 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
ifRuleAuto = auto, ifRuleOrph = orph })
= do { ~(bndrs', args', rhs') <-
-- Typecheck the payload lazily, in the hope it'll never be looked at
forkM (ptext (sLit "Rule") <+> ftext name) $
forkM (ptext (sLit "Rule") <+> pprRuleName name) $
bindIfaceBndrs bndrs $ \ bndrs' ->
do { args' <- mapM tcIfaceExpr args
; rhs' <- tcIfaceExpr rhs
......
......@@ -2128,7 +2128,7 @@ pprSkolInfo (InstSC n) = ptext (sLit "the instance declaration") <> ifPpr
pprSkolInfo DataSkol = ptext (sLit "a data type declaration")
pprSkolInfo FamInstSkol = ptext (sLit "a family instance declaration")
pprSkolInfo BracketSkol = ptext (sLit "a Template Haskell bracket")
pprSkolInfo (RuleSkol name) = ptext (sLit "the RULE") <+> doubleQuotes (ftext name)
pprSkolInfo (RuleSkol name) = ptext (sLit "the RULE") <+> pprRuleName name
pprSkolInfo ArrowSkol = ptext (sLit "an arrow form")
pprSkolInfo (PatSkol cl mc) = sep [ pprPatSkolInfo cl
, ptext (sLit "in") <+> pprMatchContext mc ]
......
......@@ -10,6 +10,7 @@ instance (C a, C b) => C (a,b) where
data T (a,b) = TPair (T a) (T b)
mapT :: (C a, C b) => (a -> b) -> T a -> T b
{-# NOINLINE mapT #-} -- Otherwwise we get a warning from the rule
mapT = undefined
zipT :: (C a, C b) => T a -> T b -> T (a,b)
......
......@@ -4,9 +4,21 @@ module Small where
class CoCCC k where
type Coexp k :: * -> * -> *
type Sum k :: * -> * -> *
coapply :: k b (Sum k (Coexp k a b) a)
cocurry :: k c (Sum k a b) -> k (Coexp k b c) a
uncocurry :: k (Coexp k b c) a -> k c (Sum k a b)
coapply' :: k b (Sum k (Coexp k a b) a)
cocurry' :: k c (Sum k a b) -> k (Coexp k b c) a
uncocurry' :: k (Coexp k b c) a -> k c (Sum k a b)
coapply :: CoCCC k => k b (Sum k (Coexp k a b) a)
{-# INLINE [1] coapply #-}
coapply = coapply'
cocurry :: CoCCC k => k c (Sum k a b) -> k (Coexp k b c) a
{-# INLINE [1] cocurry #-}
cocurry = cocurry'
uncocurry :: CoCCC k => k (Coexp k b c) a -> k c (Sum k a b)
{-# INLINE [1] uncocurry #-}
uncocurry = uncocurry'
{-# RULES
"cocurry coapply" cocurry coapply = id
......
......@@ -3,26 +3,30 @@ module T5776 where
-- The point about this test is that we should get a rule like this:
-- "foo" [ALWAYS]
-- forall (@ a)
-- ($dEq :: GHC.Classes.Eq a)
-- ($dEq1 :: GHC.Classes.Eq a)
-- ($dEq :: Eq a)
-- ($dEq1 :: Eq a)
-- (x :: a)
-- (y :: a)
-- (z :: a).
-- T5776.f (GHC.Classes.== @ a $dEq1 x y)
-- (GHC.Classes.== @ a $dEq y z)
-- T5776.f (g @ a $dEq1 x y)
-- (g @ a $dEq y z)
-- = GHC.Types.True
--
-- Note the *two* forall'd dEq parameters. This is important.
-- See Note [Simplifying RULE lhs constraints] in TcSimplify
{-# RULES "foo" forall x y z.
f (x == y) (y == z) = True
f (g x y) (g y z) = True
#-}
g :: Eq a => a -> a -> Bool
{-# NOINLINE g #-}
g = (==)
f :: Bool -> Bool -> Bool
{-# NOINLINE f #-}
f a b = False
blah :: Int -> Int -> Bool
blah x y = f (x==y) (x==y)
blah x y = f (g x y) (g x y)
T6082-RULE.hs:5:11: Warning:
T6082-RULE.hs:5:11: warning:
Rule "foo1" may never fire because ‘foo1’ might inline first
Probable fix: add an INLINE[n] or NOINLINE[n] pragma on ‘foo1’
Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo1’
T6082-RULE.hs:10:11: Warning:
T6082-RULE.hs:10:11: warning:
Rule "foo2" may never fire because ‘foo2’ might inline first
Probable fix: add an INLINE[n] or NOINLINE[n] pragma on ‘foo2’
Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo2’
......@@ -6,3 +6,14 @@ import GHC.Prim
{-# RULES
"int2Word#/word2Int#" forall x. int2Word# (word2Int# x) = x
#-}
{- We get a legitmiate
T7287.hs:7:3: warning:
Rule int2Word#/word2Int# may never fire because
rule "word2Int#" for ‘word2Int#’ might fire first
Probable fix: add phase [n] or [~n] to the competing rule
because rule "word2Int#" is the constant folding rule that converts
a sufficiently-narrow Word# literal to an Int#. There is a similar
one for int2Word#, so the whole lot is confluent. -}
\ No newline at end of file
......@@ -9,6 +9,7 @@ module ShouldCompile where
{-# NOINLINE [1] foo #-}
foo 1 = 2
{-# NOINLINE [1] bar #-}
bar 0 = 1
foobar = 2
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment