-both Bot Bot = Bot
-both Bot Abs = Bot
-both Bot d = Err
-
-both Err d = Err
-
-both Abs d = d
-
-both Lazy Bot = Err
-both Lazy Err = Err
-both Lazy Eval = Eval
-both Lazy (Call d) = Call d
-both Lazy (Seq Defer ds) = Lazy
-both Lazy (Seq k ds) = Seq Keep ds
-both Lazy d = Lazy
-
--- For the (Eval `both` Bot) case, consider
--- f x = error x
--- From 'error' itself we get demand Bot on x
--- From the arg demand on x we get Eval
--- So we want Eval `both` Bot to be Err.
--- That's what Err is *for*
-both Eval Bot = Err
-both Eval Err = Err
-both Eval (Seq k ds) = Seq Keep ds
-both Eval d = Eval
-
-both (Call d1) (Call d2) = Call (d1 `both` d2)
-both d1@(Call _) d2 = d2 `both` d1
-
-both (Seq k1 ds1) (Seq k2 ds2)
- = Seq (k1 `both_keep` k2) (both_ds k1 ds1 k2 ds2)
- where
- ----------------
- both_keep Keep k2 = Keep
-
- both_keep Drop Keep = Keep
- both_keep Drop k2 = Drop
-
- both_keep Defer k2 = k2
-
- ----------------
- both_ds Defer ds1 Defer ds2 = ds1 `boths` ds2
- both_ds Defer ds1 non_defer ds2 = map defer ds1 `boths` ds2
-
- both_ds non_defer ds1 Defer ds2 = ds1 `boths` map defer ds2
-
- both_ds k1 ds1 k2 ds2 = ds1 `boths` ds2
-
-both d1@(Seq _ _) d2 = d2 `both` d1
+both Abs d2 = d2
+
+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 d = errDmd
+
+both Top Bot = errDmd
+both Top Abs = Top
+both Top Top = Top
+both Top (Box d) = Box d
+both Top (Call d) = Call d
+both Top (Eval ds) = Eval (mapDmds (`both` Top) ds)
+both Top (Defer ds) -- = defer (Top `both` Eval ds)
+ -- = defer (Eval (mapDmds (`both` Top) ds))
+ = deferEval (mapDmds (`both` Top) ds)
+
+
+both (Box d1) (Box d2) = box (d1 `both` d2)
+both (Box d1) d2@(Call _) = box (d1 `both` d2)
+both (Box d1) d2@(Eval _) = box (d1 `both` d2)
+both (Box d1) (Defer d2) = Box d1
+both d1@(Box _) d2 = d2 `both` d1
+
+both (Call d1) (Call d2) = Call (d1 `both` d2)
+both (Call d1) (Eval ds2) = Call d1 -- Could do better for (Poly Bot)?
+both (Call d1) (Defer ds2) = Call d1 -- Ditto
+both d1@(Call _) d2 = d1 `both` d1
+
+both (Eval ds1) (Eval ds2) = Eval (ds1 `boths` ds2)
+both (Eval ds1) (Defer ds2) = Eval (ds1 `boths` mapDmds defer ds2)
+both d1@(Eval ds1) d2 = d2 `both` d1
+
+both (Defer ds1) (Defer ds2) = deferEval (ds1 `boths` ds2)
+both d1@(Defer ds1) d2 = d2 `both` d1
+
+boths = zipWithDmds both