projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
90ba37a
)
[project @ 2003-10-29 18:10:14 by simonpj]
author
simonpj
<unknown>
Wed, 29 Oct 2003 18:10:14 +0000
(18:10 +0000)
committer
simonpj
<unknown>
Wed, 29 Oct 2003 18:10:14 +0000
(18:10 +0000)
Squish bogus warning
ghc/compiler/stranal/DmdAnal.lhs
patch
|
blob
|
history
diff --git
a/ghc/compiler/stranal/DmdAnal.lhs
b/ghc/compiler/stranal/DmdAnal.lhs
index
fe588f0
..
2c6f394
100644
(file)
--- a/
ghc/compiler/stranal/DmdAnal.lhs
+++ b/
ghc/compiler/stranal/DmdAnal.lhs
@@
-17,7
+17,7
@@
import CmdLineOpts ( DynFlags, DynFlag(..), opt_MaxWorkerArgs )
import NewDemand -- All of it
import CoreSyn
import PprCore
import NewDemand -- All of it
import CoreSyn
import PprCore
-import CoreUtils ( exprIsValue, exprArity )
+import CoreUtils ( exprIsValue, exprIsTrivial, exprArity )
import DataCon ( dataConTyCon )
import TyCon ( isProductTyCon, isRecursiveTyCon )
import Id ( Id, idType, idInlinePragma,
import DataCon ( dataConTyCon )
import TyCon ( isProductTyCon, isRecursiveTyCon )
import Id ( Id, idType, idInlinePragma,
@@
-415,7
+415,9
@@
dmdAnalRhs top_lvl rec_flag sigs (id, rhs)
arity = idArity id -- The idArity should be up to date
-- The simplifier was run just beforehand
(rhs_dmd_ty, rhs') = dmdAnal sigs (vanillaCall arity) rhs
arity = idArity id -- The idArity should be up to date
-- The simplifier was run just beforehand
(rhs_dmd_ty, rhs') = dmdAnal sigs (vanillaCall arity) rhs
- (lazy_fv, sig_ty) = WARN( arity /= dmdTypeDepth rhs_dmd_ty, ppr id )
+ (lazy_fv, sig_ty) = WARN( arity /= dmdTypeDepth rhs_dmd_ty && not (exprIsTrivial rhs), ppr id )
+ -- The RHS can be eta-reduced to just a variable,
+ -- in which case we should not complain.
mkSigTy top_lvl rec_flag id rhs rhs_dmd_ty
id' = id `setIdNewStrictness` sig_ty
sigs' = extendSigEnv top_lvl sigs id sig_ty
mkSigTy top_lvl rec_flag id rhs rhs_dmd_ty
id' = id `setIdNewStrictness` sig_ty
sigs' = extendSigEnv top_lvl sigs id sig_ty