From: simonpj <unknown>
Date: Fri, 24 Aug 2001 13:22:25 +0000 (+0000)
Subject: [project @ 2001-08-24 13:22:25 by simonpj]
X-Git-Tag: Approximately_9120_patches~1077
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=2daf21bbb3aaf6f6df4d12c374a55d3cb054411e;p=ghc-hetmet.git

[project @ 2001-08-24 13:22:25 by simonpj]
Make when comparing old and new strictness information,
we were being a bit too generous with the old case.
When a function has (say) arity 2, we can't use strictness
info like SSS, because that only applies if the fn is
applied to 3 args.  So it's an unfair comparison.

This commit makes the old->new conversion function more
truthful in this regard, which should eliminate the
erroneously-claimed "worse" strictness results.
---

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 24dfce3..049a9d6 100644
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -134,15 +134,18 @@ To be removed later
 
 \begin{code}
 mkNewStrictnessInfo :: Id -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig
-mkNewStrictnessInfo id arity Demand.NoStrictnessInfo cpr
-  = mkStrictSig id arity $
-    mkTopDmdType (replicate arity lazyDmd) (newRes False cpr)
-
 mkNewStrictnessInfo id arity (Demand.StrictnessInfo ds res) cpr
-  = mkStrictSig id arity $
-    mkTopDmdType (take arity (map newDemand ds)) (newRes res cpr)
+  | length ds <= arity
 	-- Sometimes the old strictness analyser has more
 	-- demands than the arity justifies
+  = mkStrictSig id arity $
+    mkTopDmdType (map newDemand ds) (newRes res cpr)
+
+mkNewStrictnessInfo id arity other cpr
+  =	-- Either no strictness info, or arity is too small
+	-- In either case we can't say anything useful
+    mkStrictSig id arity $
+    mkTopDmdType (replicate arity lazyDmd) (newRes False cpr)
 
 newRes True  _ 	        = BotRes
 newRes False ReturnsCPR = RetCPR