X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fstranal%2FDmdAnal.lhs;fp=compiler%2Fstranal%2FDmdAnal.lhs;h=4660aad56a95160871da7e4f630d68fdb1f53134;hp=31648b0b1d2c6b0df7fcc39ced92a4ef1d213e4a;hb=a33b1cd8490faf8a3b6bdc163555c3f986048231;hpb=b84ba676034763b3082bbd9405794a4fde499d14

diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 31648b0..4660aad 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -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
+