--- Move these to Id.lhs
-idNewStrictness_maybe :: Id -> Maybe StrictSig
-idNewStrictness :: Id -> StrictSig
-
-idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
-idNewStrictness id = idNewStrictness_maybe id `orElse` topSig
-
-getNewStrictness :: Id -> StrictSig
--- First tries the "new-strictness" field, and then
--- reverts to the old one. This is just until we have
--- cross-module info for new strictness
-getNewStrictness id = idNewStrictness_maybe id `orElse` newStrictnessFromOld id
-
-newStrictnessFromOld :: Id -> StrictSig
-newStrictnessFromOld id = mkNewStrictnessInfo id (idArity id) (idStrictness id) (idCprInfo id)
-
-setIdNewStrictness :: Id -> StrictSig -> Id
-setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` sig) id
-
-idNewDemandInfo :: Id -> Demand
-idNewDemandInfo id = newDemandInfo (idInfo id)
-
-setIdNewDemandInfo :: Id -> Demand -> Id
-setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` dmd) id
+lub :: Demand -> Demand -> Demand
+
+lub Bot d2 = d2
+lub Abs d2 = absLub d2
+lub Top d2 = Top
+lub (Defer ds1) d2 = defer (Eval ds1 `lub` d2)
+
+lub (Call d1) (Call d2) = Call (d1 `lub` d2)
+lub d1@(Call _) (Box d2) = d1 `lub` d2 -- Just strip the box
+lub d1@(Call _) d2@(Eval _) = d2 -- Presumably seq or vanilla eval
+lub d1@(Call _) d2 = d2 `lub` d1 -- Bot, Abs, Top
+
+-- For the Eval case, we use these approximation rules
+-- Box Bot <= Eval (Box Bot ...)
+-- Box Top <= Defer (Box Bot ...)
+-- Box (Eval ds) <= Eval (map Box ds)
+lub (Eval ds1) (Eval ds2) = Eval (ds1 `lubs` ds2)
+lub (Eval ds1) (Box Bot) = Eval (mapDmds (`lub` Box Bot) ds1)
+lub (Eval ds1) (Box (Eval ds2)) = Eval (ds1 `lubs` mapDmds box ds2)
+lub (Eval ds1) (Box Abs) = deferEval (mapDmds (`lub` Box Bot) ds1)
+lub d1@(Eval _) d2 = d2 `lub` d1 -- Bot,Abs,Top,Call,Defer
+
+lub (Box d1) (Box d2) = box (d1 `lub` d2)
+lub d1@(Box _) d2 = d2 `lub` d1
+
+lubs = zipWithDmds lub
+
+---------------------
+-- box is the smart constructor for Box
+-- It computes <B,bot> & d
+-- INVARIANT: (Box d) => d = Bot, Abs, Eval
+-- Seems to be no point in allowing (Box (Call d))
+box (Call d) = Call d -- The odd man out. Why?
+box (Box d) = Box d
+box (Defer _) = lazyDmd
+box Top = lazyDmd -- Box Abs and Box Top
+box Abs = lazyDmd -- are the same <B,L>
+box d = Box d -- Bot, Eval
+
+---------------
+defer :: Demand -> Demand
+
+-- defer is the smart constructor for Defer
+-- The idea is that (Defer ds) = <U(ds), L>
+--
+-- It specifies what happens at a lazy function argument
+-- or a lambda; the L* operator
+-- Set the strictness part to L, but leave
+-- the boxity side unaffected
+-- It also ensures that Defer (Eval [LLLL]) = L
+
+defer Bot = Abs
+defer Abs = Abs
+defer Top = Top
+defer (Call _) = lazyDmd -- Approximation here?
+defer (Box _) = lazyDmd
+defer (Defer ds) = Defer ds
+defer (Eval ds) = deferEval ds
+
+-- deferEval ds = defer (Eval ds)
+deferEval ds | allTop ds = Top
+ | otherwise = Defer ds
+
+---------------------
+absLub :: Demand -> Demand
+-- Computes (Abs `lub` d)
+-- For the Bot case consider
+-- f x y = if ... then x else error x
+-- Then for y we get Abs `lub` Bot, and we really
+-- want Abs overall
+absLub Bot = Abs
+absLub Abs = Abs
+absLub Top = Top
+absLub (Call _) = Top
+absLub (Box _) = Top
+absLub (Eval ds) = Defer (absLubs ds) -- Or (Defer ds)?
+absLub (Defer ds) = Defer (absLubs ds) -- Or (Defer ds)?
+
+absLubs = mapDmds absLub
+
+---------------
+both :: Demand -> Demand -> Demand
+
+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