X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FNewDemand.lhs;h=0ca93ea396e76c4b08f3d918c37df928bc6eaf68;hp=6da4c470097cec8fb1b27deff33c3fd668ac3cc7;hb=17b297d97d327620ed6bfab942f8992b2446f1bf;hpb=49c98d143c382a1341e1046f5ca00819a25691ba

diff --git a/compiler/basicTypes/NewDemand.lhs b/compiler/basicTypes/NewDemand.lhs
index 6da4c47..0ca93ea 100644
--- a/compiler/basicTypes/NewDemand.lhs
+++ b/compiler/basicTypes/NewDemand.lhs
@@ -5,6 +5,13 @@
 \section[Demand]{@Demand@: the amount of demand on a value}
 
 \begin{code}
+{-# OPTIONS_GHC -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+-- for details
+
 module NewDemand(
 	Demand(..), 
 	topDmd, lazyDmd, seqDmd, evalDmd, errDmd, isStrictDmd, 
@@ -80,7 +87,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