projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Separate NondecreasingIndentation out into its own extension
[ghc-hetmet.git]
/
compiler
/
deSugar
/
Desugar.lhs
diff --git
a/compiler/deSugar/Desugar.lhs
b/compiler/deSugar/Desugar.lhs
index
d154e04
..
073e873
100644
(file)
--- a/
compiler/deSugar/Desugar.lhs
+++ b/
compiler/deSugar/Desugar.lhs
@@
-34,7
+34,6
@@
import CoreMonad ( endPass, CoreToDo(..) )
import ErrUtils
import Outputable
import SrcLoc
import ErrUtils
import Outputable
import SrcLoc
-import FastString
import Coverage
import Util
import MonadUtils
import Coverage
import Util
import MonadUtils
@@
-338,16
+337,17
@@
dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
= putSrcSpanDs loc $
do { let bndrs' = [var | RuleBndr (L _ var) <- vars]
= 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
; 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
{ let is_local = isLocalId fn_id
-- NB: isLocalId is False of implicit Ids. This is good becuase
@@
-356,12
+356,9
@@
dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
fn_name = idName fn_id
final_rhs = simpleOptExpr rhs' -- De-crap it
rule = mkRule False {- Not auto -} is_local
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)
} } }
; 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]
\end{code}
Note [Desugaring RULE left hand sides]
@@
-374,4
+371,6
@@
switching off EnableRewriteRules. See DsExpr.dsExplicitList.
That keeps the desugaring of list comprehensions simple too.
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 #-}