From: simonpj <unknown>
Date: Wed, 29 Oct 2003 18:10:14 +0000 (+0000)
Subject: [project @ 2003-10-29 18:10:14 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~315
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=1baf9181713e4aad911cbd82e88b509b6bacb7e8;p=ghc-hetmet.git

[project @ 2003-10-29 18:10:14 by simonpj]
Squish bogus warning
---

diff --git a/ghc/compiler/stranal/DmdAnal.lhs b/ghc/compiler/stranal/DmdAnal.lhs
index fe588f0..2c6f394 100644
--- 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 CoreUtils	( exprIsValue, exprArity )
+import CoreUtils	( exprIsValue, exprIsTrivial, exprArity )
 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
-  (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