import ErrUtils
import Outputable
import SrcLoc
-import FastString
import Coverage
import Util
import MonadUtils
; endPass dflags CoreDesugar ds_binds ds_rules_for_imps
- ; used_names <- mkUsedNames tcg_env
+ ; let used_names = mkUsedNames tcg_env
; deps <- mkDependencies tcg_env
; let mod_guts = ModGuts {
= putSrcSpanDs loc $
do { let bndrs' = [var | RuleBndr (L _ var) <- vars]
- ; lhs' <- unsetOptM Opt_EnableRewriteRules $
- dsLExpr lhs -- Note [Desugaring RULE left hand sides]
+ ; lhs' <- unsetOptM Opt_EnableRewriteRules $
+ unsetOptM Opt_WarnIdentities $
+ dsLExpr lhs -- Note [Desugaring RULE left hand sides]
; rhs' <- dsLExpr rhs
-- Substitute the dict bindings eagerly,
-- and take the body apart into a (f args) form
- ; case decomposeRuleLhs lhs' of {
- Nothing -> do { warnDs msg; return Nothing } ;
- Just (fn_id, args) -> do
+ ; case decomposeRuleLhs bndrs' lhs' of {
+ Left msg -> do { warnDs msg; return Nothing } ;
+ Right (final_bndrs, fn_id, args) -> do
{ let is_local = isLocalId fn_id
-- NB: isLocalId is False of implicit Ids. This is good becuase
fn_name = idName fn_id
final_rhs = simpleOptExpr rhs' -- De-crap it
rule = mkRule False {- Not auto -} is_local
- name act fn_name bndrs' args final_rhs
+ name act fn_name final_bndrs args final_rhs
; return (Just rule)
} } }
- where
- msg = hang (ptext (sLit "RULE left-hand side too complicated to desugar; ignored"))
- 2 (ppr lhs)
\end{code}
Note [Desugaring RULE left hand sides]
That keeps the desugaring of list comprehensions simple too.
-
+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 #-}