[project @ 2001-08-24 13:22:25 by simonpj]

[ghc-hetmet.git] / ghc / compiler / basicTypes / IdInfo.lhs

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 8e8d3f8..049a9d6 100644 (file)
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -99,8 +99,7 @@ import Demand         hiding( Demand )
 import qualified Demand
 import NewDemand       ( Demand(..), Keepity(..), Deferredness(..), DmdResult(..),
                          lazyDmd, topDmd,
-                         StrictSig, mkStrictSig, 
-                         DmdType, mkTopDmdType
+                         StrictSig, mkStrictSig, mkTopDmdType
                        )
 import Outputable      
 import Util            ( seqList )
@@ -135,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