X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fstranal%2FDmdAnal.lhs;h=4660aad56a95160871da7e4f630d68fdb1f53134;hb=e93b244967871dde378b9488c9abe2db3b8d667c;hp=2414aead51a27954da1e8acf511464aae5bd707a;hpb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba;p=ghc-hetmet.git

diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 2414aea..4660aad 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -217,9 +217,9 @@ dmdAnal sigs dmd (Lam var body)
     (deferType lam_ty, Lam var' body')
 
 dmdAnal sigs dmd (Case scrut case_bndr ty [alt@(DataAlt dc,bndrs,rhs)])
-  | let tycon = dataConTyCon dc,
-    isProductTyCon tycon,
-    not (isRecursiveTyCon tycon)
+  | let tycon = dataConTyCon dc
+  , isProductTyCon tycon
+  , not (isRecursiveTyCon tycon)
   = let
 	sigs_alt	      = extendSigEnv NotTopLevel sigs case_bndr case_bndr_sig
 	(alt_ty, alt')	      = dmdAnalAlt sigs_alt dmd alt
@@ -1085,22 +1085,11 @@ both :: Demand -> Demand -> Demand
 
 both Abs d2 = d2
 
+-- Note [Bottom demands]
 both Bot Bot 	   = Bot
 both Bot Abs 	   = Bot 
 both Bot (Eval ds) = Eval (mapDmds (`both` Bot) ds)
-	-- Consider
-	--	f x = error x
-	-- From 'error' itself we get demand Bot on x
-	-- From the arg demand on x we get 
-	--	x :-> evalDmd = Box (Eval (Poly Abs))
-	-- So we get  Bot `both` Box (Eval (Poly Abs))
-	--	    = Seq Keep (Poly Bot)
-	--
-	-- Consider also
-	--	f x = if ... then error (fst x) else fst x
-	-- Then we get (Eval (Box Bot, Bot) `lub` Eval (SA))
-	--	= Eval (SA)
-	-- which is what we want.
+both Bot (Defer ds) = Eval (mapDmds (`both` Bot) ds)
 both Bot d = errDmd
 
 both Top Bot 	     = errDmd
@@ -1134,3 +1123,30 @@ both d1@(Defer ds1) d2	     = d2 `both` d1
  
 boths ds1 ds2 = zipWithDmds both ds1 ds2
 \end{code}
+
+Note [Bottom demands]
+~~~~~~~~~~~~~~~~~~~~~
+Consider
+	f x = error x
+From 'error' itself we get demand Bot on x
+From the arg demand on x we get 
+	x :-> evalDmd = Box (Eval (Poly Abs))
+So we get  Bot `both` Box (Eval (Poly Abs))
+	    = Seq Keep (Poly Bot)
+
+Consider also
+	f x = if ... then error (fst x) else fst x
+Then we get (Eval (Box Bot, Bot) `lub` Eval (SA))
+	= Eval (SA)
+which is what we want.
+
+Consider also
+  f x = error [fst x]
+Then we get 
+     x :-> Bot `both` Defer [SA]
+and we want the Bot demand to cancel out the Defer
+so that we get Eval [SA].  Otherwise we'd have the odd
+situation that
+  f x = error (fst x)      -- Strictness U(SA)b
+  g x = error ('y':fst x)  -- Strictness Tb
+