X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FNewDemand.lhs;h=6e97dcb7fd45d41c3f22590e471b40a982669cc1;hb=59264221c24a17e7c8ecde3e289882b9620bd5a8;hp=8e68fd87d23cd00495ee25ff460358cd903a8031;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/NewDemand.lhs b/compiler/basicTypes/NewDemand.lhs
index 8e68fd8..6e97dcb 100644
--- a/compiler/basicTypes/NewDemand.lhs
+++ b/compiler/basicTypes/NewDemand.lhs
@@ -1,4 +1,5 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section[Demand]{@Demand@: the amount of demand on a value}
@@ -24,11 +25,11 @@ module NewDemand(
 
 #include "HsVersions.h"
 
-import StaticFlags	( opt_CprOff )
-import BasicTypes	( Arity )
-import VarEnv		( VarEnv, emptyVarEnv, isEmptyVarEnv )
-import UniqFM		( ufmToList )
-import Util             ( listLengthCmp, zipWithEqual )
+import StaticFlags
+import BasicTypes
+import VarEnv
+import UniqFM
+import Util
 import Outputable
 \end{code}
 
@@ -79,7 +80,13 @@ zipWithDmds :: (Demand -> Demand -> Demand)
 zipWithDmds f (Poly d1)  (Poly d2)  = Poly (d1 `f` d2)
 zipWithDmds f (Prod ds1) (Poly d2)  = Prod [d1 `f` d2 | d1 <- ds1]
 zipWithDmds f (Poly d1)  (Prod ds2) = Prod [d1 `f` d2 | d2 <- ds2]
-zipWithDmds f (Prod ds1) (Prod ds2) = Prod (zipWithEqual "zipWithDmds" f ds1 ds2)
+zipWithDmds f (Prod ds1) (Prod ds2) 
+  | length ds1 == length ds2 = Prod (zipWithEqual "zipWithDmds" f ds1 ds2)
+  | otherwise		     = Poly topDmd
+	-- This really can happen with polymorphism
+	-- \f. case f x of (a,b) -> ...
+	--     case f y of (a,b,c) -> ...
+	-- Here the two demands on f are C(LL) and C(LLL)!
 
 topDmd, lazyDmd, seqDmd :: Demand
 topDmd  = Top			-- The most uninformative demand