Tidy up the treatment of dead binders

This patch does a lot of tidying up of the way that dead variables are
handled in Core.  Just the sort of thing to do on an aeroplane.

* The tricky "binder-swap" optimisation is moved from the Simplifier
  to the Occurrence Analyser.  See Note [Binder swap] in OccurAnal.
  This is really a nice change.  It should reduce the number of
  simplifier iteratoins (slightly perhaps).  And it means that
  we can be much less pessimistic about zapping occurrence info
  on binders in a case expression.  

* For example:
	case x of y { (a,b) -> e }
  Previously, each time around, even if y,a,b were all dead, the
  Simplifier would pessimistically zap their OccInfo, so that we
  can't see they are dead any more.  As a result virtually no 
  case expression ended up with dead binders.  This wasn't Bad
  in itself, but it always felt wrong.

* I added a check to CoreLint to check that a dead binder really
  isn't used.  That showed up a couple of bugs in CSE. (Only in
  this sense -- they didn't really matter.)
  
* I've changed the PprCore printer to print "_" for a dead variable.
  (Use -dppr-debug to see it again.)  This reduces clutter quite a
  bit, and of course it's much more useful with the above change.

* Another benefit of the binder-swap change is that I could get rid of
  the Simplifier hack (working, but hacky) in which the InScopeSet was
  used to map a variable to a *different* variable. That allowed me
  to remove VarEnv.modifyInScopeSet, and to simplify lookupInScopeSet
  so that it doesn't look for a fixpoint.  This fixes no bugs, but 
  is a useful cleanup.

* Roman pointed out that Id.mkWildId is jolly dangerous, because
  of its fixed unique.  So I've 

     - localied it to MkCore, where it is private (not exported)

     - renamed it to 'mkWildBinder' to stress that you should only
       use it at binding sites, unless you really know what you are
       doing

     - provided a function MkCore.mkWildCase that emodies the most
       common use of mkWildId, and use that elsewhere

   So things are much better

* A knock-on change is that I found a common pattern of localising
  a potentially global Id, and made a function for it: Id.localiseId

5 files changed, 332 insertions, 264 deletions

diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs
index 495ea42fc4..1386197eba 100644
--- a/compiler/simplCore/CSE.lhs
+++ b/compiler/simplCore/CSE.lhs
@@ -11,7 +11,7 @@ module CSE (
 #include "HsVersions.h"
 
 import DynFlags	( DynFlag(..), DynFlags )
-import Id		( Id, idType, idInlinePragma )
+import Id		( Id, idType, idInlinePragma, zapIdOccInfo )
 import CoreUtils	( hashExpr, cheapEqExpr, exprIsBig, mkAltExpr, exprIsCheap )
 import DataCon		( isUnboxedTupleCon )
 import Type		( tyConAppArgs )
@@ -69,7 +69,7 @@ to run the substitution over types and IdInfo.  No no no.  Instead, we just thro
 (In fact, I think the simplifier does guarantee no-shadowing for type variables.)
 
 
-[Note: case binders 1]
+Note [Case binders 1]
 ~~~~~~~~~~~~~~~~~~~~~~
 Consider
 
@@ -83,9 +83,9 @@ but for CSE purpose that's a bad idea.
 
 So we add the binding (wild1 -> a) to the extra var->var mapping.
 Notice this is exactly backwards to what the simplifier does, which is
-to try to replaces uses of a with uses of wild1
+to try to replaces uses of 'a' with uses of 'wild1'
 
-[Note: case binders 2]
+Note [Case binders 2]
 ~~~~~~~~~~~~~~~~~~~~~~
 Consider
 	case (h x) of y -> ...(h x)...
@@ -98,7 +98,7 @@ to the reverse CSE mapping if the scrutinee is a non-trivial expression.
 	case binder -> scrutinee 
 to the substitution
 
-[Note: unboxed tuple case binders]
+Note [Unboxed tuple case binders]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
 	case f x of t { (# a,b #) -> 
@@ -233,34 +233,40 @@ cseExpr env (Lam b e)	     	   = let (env', b') = addBinder env b
 				     in Lam b' (cseExpr env' e)
 cseExpr env (Let bind e)    	   = let (env', bind') = cseBind env bind
 				     in Let bind' (cseExpr env' e)
-cseExpr env (Case scrut bndr ty alts) = Case scrut' bndr' ty (cseAlts env' scrut' bndr bndr' alts)
+cseExpr env (Case scrut bndr ty alts) = Case scrut' bndr'' ty (cseAlts env' scrut' bndr bndr'' alts)
 				   where
 				     scrut' = tryForCSE env scrut
 				     (env', bndr') = addBinder env bndr
-
+				     bndr'' = zapIdOccInfo bndr'
+					-- The swizzling from Note [Case binders 2] may
+					-- cause a dead case binder to be alive, so we
+					-- play safe here and bring them all to life
 
 cseAlts :: CSEnv -> CoreExpr -> CoreBndr -> CoreBndr -> [CoreAlt] -> [CoreAlt]
 
 cseAlts env scrut' bndr _bndr' [(DataAlt con, args, rhs)]
   | isUnboxedTupleCon con
 	-- Unboxed tuples are special because the case binder isn't
-	-- a real values.  See [Note: unboxed tuple case binders]
-  = [(DataAlt con, args', tryForCSE new_env rhs)]
+	-- a real values.  See Note [Unboxed tuple case binders]
+  = [(DataAlt con, args'', tryForCSE new_env rhs)]
   where
     (env', args') = addBinders env args
+    args'' = map zapIdOccInfo args'	-- They should all be ids
+	-- Same motivation for zapping as [Case binders 2] only this time
+	-- it's Note [Unboxed tuple case binders]
     new_env | exprIsCheap scrut' = env'
 	    | otherwise 	 = extendCSEnv env' scrut' tup_value
-    tup_value = mkAltExpr (DataAlt con) args' (tyConAppArgs (idType bndr))
+    tup_value = mkAltExpr (DataAlt con) args'' (tyConAppArgs (idType bndr))
 
 cseAlts env scrut' bndr bndr' alts
   = map cse_alt alts
   where
     (con_target, alt_env)
 	= case scrut' of
-		Var v' -> (v',    extendSubst env bndr v')	-- See [Note: case binder 1]
+		Var v' -> (v',     extendSubst env bndr v')	-- See Note [Case binders 1]
 								-- map: bndr -> v'
 
-		_      ->  (bndr', extendCSEnv env scrut' (Var  bndr'))	-- See [Note: case binder 2]
+		_      ->  (bndr', extendCSEnv env scrut' (Var  bndr'))	-- See Note [Case binders 2]
 									-- map: scrut' -> bndr'
 
     arg_tys = tyConAppArgs (idType bndr)
diff --git a/compiler/simplCore/LiberateCase.lhs b/compiler/simplCore/LiberateCase.lhs
index ab7923947a..9fe6b87481 100644
--- a/compiler/simplCore/LiberateCase.lhs
+++ b/compiler/simplCore/LiberateCase.lhs
@@ -18,7 +18,6 @@ import UniqSupply	( UniqSupply )
 import SimplMonad	( SimplCount, zeroSimplCount )
 import Id
 import VarEnv
-import Name		( localiseName )
 import Util             ( notNull )
 \end{code}
 
@@ -171,10 +170,10 @@ libCaseBind env (Rec pairs)
 	-- processing the rhs with an *un-extended* environment, so
 	-- that the same process doesn't occur for ever!
 	--
-    extended_env = addRecBinds env [ (adjust binder, libCase env_body rhs)
+    extended_env = addRecBinds env [ (localiseId binder, libCase env_body rhs)
 				   | (binder, rhs) <- pairs ]
 
-	-- Two subtle things: 
+	-- The call to localiseId is needed for two subtle reasons
 	-- (a)  Reset the export flags on the binders so
 	-- 	that we don't get name clashes on exported things if the 
 	-- 	local binding floats out to top level.  This is most unlikely
@@ -184,7 +183,6 @@ libCaseBind env (Rec pairs)
 	-- (b)  Make the name an Internal one.  External Names should never be
 	--	nested; if it were floated to the top level, we'd get a name
 	-- 	clash at code generation time.
-    adjust bndr = setIdNotExported (setIdName bndr (localiseName (idName bndr)))
 
     rhs_small_enough (id,rhs)
 	=  idArity id > 0	-- Note [Only functions!]
diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
index 2b2c058194..58f72cbbc2 100644
--- a/compiler/simplCore/OccurAnal.lhs
+++ b/compiler/simplCore/OccurAnal.lhs
@@ -20,6 +20,7 @@ module OccurAnal (
 import CoreSyn
 import CoreFVs
 import CoreUtils        ( exprIsTrivial, isDefaultAlt )
+import Coercion		( mkSymCoercion )
 import Id
 import IdInfo
 import BasicTypes
@@ -769,8 +770,8 @@ occAnal env expr@(Lam _ _)
     is_one_shot b   = isId b && isOneShotBndr b
 
 occAnal env (Case scrut bndr ty alts)
-  = case occ_anal_scrut scrut alts                  of { (scrut_usage, scrut') ->
-    case mapAndUnzip (occAnalAlt alt_env bndr) alts of { (alts_usage_s, alts')   ->
+  = case occ_anal_scrut scrut alts     of { (scrut_usage, scrut') ->
+    case mapAndUnzip occ_anal_alt alts of { (alts_usage_s, alts')   ->
     let
         alts_usage  = foldr1 combineAltsUsageDetails alts_usage_s
         alts_usage' = addCaseBndrUsage alts_usage
@@ -779,6 +780,8 @@ occAnal env (Case scrut bndr ty alts)
     in
     total_usage `seq` (total_usage, Case scrut' tagged_bndr ty alts') }}
   where
+	-- Note [Case binder usage]	
+	-- ~~~~~~~~~~~~~~~~~~~~~~~~
         -- The case binder gets a usage of either "many" or "dead", never "one".
         -- Reason: we like to inline single occurrences, to eliminate a binding,
         -- but inlining a case binder *doesn't* eliminate a binding.
@@ -787,18 +790,27 @@ occAnal env (Case scrut bndr ty alts)
         -- into
         --      case x of w { (p,q) -> f (p,q) }
     addCaseBndrUsage usage = case lookupVarEnv usage bndr of
-                                Nothing  -> usage
-                                Just occ -> extendVarEnv usage bndr (markMany occ)
+                                Nothing -> usage
+                                Just _  -> extendVarEnv usage bndr NoOccInfo
 
     alt_env = setVanillaCtxt env
         -- Consider     x = case v of { True -> (p,q); ... }
         -- Then it's fine to inline p and q
 
+    bndr_swap = case scrut of
+		  Var v           -> Just (v, Var bndr)
+		  Cast (Var v) co -> Just (v, Cast (Var bndr) (mkSymCoercion co))
+		  _other          -> Nothing
+
+    occ_anal_alt = occAnalAlt alt_env bndr bndr_swap
+
     occ_anal_scrut (Var v) (alt1 : other_alts)
-                                | not (null other_alts) || not (isDefaultAlt alt1)
-                                = (mkOneOcc env v True, Var v)
-    occ_anal_scrut scrut _alts  = occAnal vanillaCtxt scrut
-                                        -- No need for rhsCtxt
+        | not (null other_alts) || not (isDefaultAlt alt1)
+        = (mkOneOcc env v True, Var v)	-- The 'True' says that the variable occurs
+					-- in an interesting context; the case has
+					-- at least one non-default alternative
+    occ_anal_scrut scrut _alts  
+	= occAnal vanillaCtxt scrut    -- No need for rhsCtxt
 
 occAnal env (Let bind body)
   = case occAnal env body                of { (body_usage, body') ->
@@ -900,38 +912,104 @@ appSpecial env n ctxt args
 \end{code}
 
 
-Case alternatives
-~~~~~~~~~~~~~~~~~
-If the case binder occurs at all, the other binders effectively do too.
-For example
-        case e of x { (a,b) -> rhs }
-is rather like
-        let x = (a,b) in rhs
-If e turns out to be (e1,e2) we indeed get something like
-        let a = e1; b = e2; x = (a,b) in rhs
-
-Note [Aug 06]: I don't think this is necessary any more, and it helpe
-               to know when binders are unused.  See esp the call to
-               isDeadBinder in Simplify.mkDupableAlt
+Note [Binder swap]
+~~~~~~~~~~~~~~~~~~
+We do these two transformations right here:
+
+ (1)   case x of b { pi -> ri }
+    ==>
+      case x of b { pi -> let x=b in ri }
+
+ (2)  case (x |> co) of b { pi -> ri }
+    ==>
+      case (x |> co) of b { pi -> let x = b |> sym co in ri }
+
+    Why (2)?  See Note [Ccase of cast]
+
+In both cases, in a particular alternative (pi -> ri), we only 
+add the binding if
+  (a) x occurs free in (pi -> ri)
+	(ie it occurs in ri, but is not bound in pi)
+  (b) the pi does not bind b (or the free vars of co)
+  (c) x is not a 
+We need (a) and (b) for the inserted binding to be correct.
+
+Notice that (a) rapidly becomes false, so no bindings are injected.
+
+Notice the deliberate shadowing of 'x'. But we must call localiseId 
+on 'x' first, in case it's a GlobalId, or has an External Name.
+See, for example, SimplEnv Note [Global Ids in the substitution].
+
+For the alternatives where we inject the binding, we can transfer
+all x's OccInfo to b.  And that is the point.
+
+The reason for doing these transformations here is because it allows
+us to adjust the OccInfo for 'x' and 'b' as we go.
+
+  * Suppose the only occurrences of 'x' are the scrutinee and in the
+    ri; then this transformation makes it occur just once, and hence
+    get inlined right away.
+
+  * If we do this in the Simplifier, we don't know whether 'x' is used
+    in ri, so we are forced to pessimistically zap b's OccInfo even
+    though it is typically dead (ie neither it nor x appear in the
+    ri).  There's nothing actually wrong with zapping it, except that
+    it's kind of nice to know which variables are dead.  My nose
+    tells me to keep this information as robustly as possible.
+
+The Maybe (Id,CoreExpr) passed to occAnalAlt is the extra let-binding
+{x=b}; it's Nothing if the binder-swap doesn't happen.
+
+Note [Case of cast]
+~~~~~~~~~~~~~~~~~~~
+Consider        case (x `cast` co) of b { I# ->
+                ... (case (x `cast` co) of {...}) ...
+We'd like to eliminate the inner case.  That is the motivation for
+equation (2) in Note [Binder swap].  When we get to the inner case, we
+inline x, cancel the casts, and away we go.
+
+Note [Binders in case alternatives]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+    case x of y { (a,b) -> f y }
+We treat 'a', 'b' as dead, because they don't physically occur in the
+case alternative.  (Indeed, a variable is dead iff it doesn't occur in
+its scope in the output of OccAnal.)  This invariant is It really
+helpe to know when binders are unused.  See esp the call to
+isDeadBinder in Simplify.mkDupableAlt
+
+In this example, though, the Simplifier will bring 'a' and 'b' back to
+life, beause it binds 'y' to (a,b) (imagine got inlined and
+scrutinised y).
 
 \begin{code}
 occAnalAlt :: OccEnv
            -> CoreBndr
+	   -> Maybe (Id, CoreExpr)  -- Note [Binder swap]
            -> CoreAlt
            -> (UsageDetails, Alt IdWithOccInfo)
-occAnalAlt env _case_bndr (con, bndrs, rhs)
+occAnalAlt env case_bndr mb_scrut_var (con, bndrs, rhs)
   = case occAnal env rhs of { (rhs_usage, rhs') ->
     let
-        (final_usage, tagged_bndrs) = tagBinders rhs_usage bndrs
-        final_bndrs = tagged_bndrs      -- See Note [Aug06] above
-{-
-        final_bndrs | case_bndr `elemVarEnv` final_usage = bndrs
-                    | otherwise                         = tagged_bndrs
-                -- Leave the binders untagged if the case
-                -- binder occurs at all; see note above
--}
+        (alt_usg, tagged_bndrs) = tagBinders rhs_usage bndrs
+        bndrs' = tagged_bndrs      -- See Note [Binders in case alternatives]
     in
-    (final_usage, (con, final_bndrs, rhs')) }
+    case mb_scrut_var of
+	Just (scrut_var, scrut_rhs)		-- See Note [Binder swap]
+	  | scrut_var `localUsedIn` alt_usg	-- (a) Fast path, usually false
+	  , not (any shadowing bndrs)		-- (b) 
+	  -> (addOneOcc usg_wo_scrut case_bndr NoOccInfo,
+			-- See Note [Case binder usage] for the NoOccInfo
+	      (con, bndrs', Let (NonRec scrut_var' scrut_rhs) rhs'))
+	  where
+	   (usg_wo_scrut, scrut_var') = tagBinder alt_usg (localiseId scrut_var)
+			-- Note the localiseId; we're making a new binding
+			-- for it, and it might have an External Name, or
+			-- even be a GlobalId
+	   shadowing bndr = bndr `elemVarSet` rhs_fvs
+	   rhs_fvs = exprFreeVars scrut_rhs
+
+	_other -> (alt_usg, (con, bndrs', rhs')) }
 \end{code}
 
 
@@ -1022,6 +1100,8 @@ addAppCtxt (OccEnv encl ctxt) args
 
 \begin{code}
 type UsageDetails = IdEnv OccInfo       -- A finite map from ids to their usage
+		-- INVARIANT: never IAmDead
+		-- (Deadness is signalled by not being in the map at all)
 
 (+++), combineAltsUsageDetails
         :: UsageDetails -> UsageDetails -> UsageDetails
@@ -1040,8 +1120,9 @@ addOneOcc usage id info
 emptyDetails :: UsageDetails
 emptyDetails = (emptyVarEnv :: UsageDetails)
 
-usedIn :: Id -> UsageDetails -> Bool
-v `usedIn` details =  isExportedId v || v `elemVarEnv` details
+localUsedIn, usedIn :: Id -> UsageDetails -> Bool
+v `localUsedIn` details = v `elemVarEnv` details
+v `usedIn`      details =  isExportedId v || v `localUsedIn` details
 
 type IdWithOccInfo = Id
 
@@ -1099,8 +1180,7 @@ mkOneOcc _env id int_cxt
 
 markMany, markInsideLam, markInsideSCC :: OccInfo -> OccInfo
 
-markMany IAmDead = IAmDead
-markMany _       = NoOccInfo
+markMany _  = NoOccInfo
 
 markInsideSCC occ = markMany occ
 
@@ -1109,19 +1189,18 @@ markInsideLam occ                       = occ
 
 addOccInfo, orOccInfo :: OccInfo -> OccInfo -> OccInfo
 
-addOccInfo IAmDead info2       = info2
-addOccInfo info1 IAmDead       = info1
-addOccInfo _     _             = NoOccInfo
+addOccInfo a1 a2  = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) )
+		    NoOccInfo	-- Both branches are at least One
+				-- (Argument is never IAmDead)
 
 -- (orOccInfo orig new) is used
 -- when combining occurrence info from branches of a case
 
-orOccInfo IAmDead info2 = info2
-orOccInfo info1 IAmDead = info1
 orOccInfo (OneOcc in_lam1 _ int_cxt1)
           (OneOcc in_lam2 _ int_cxt2)
   = OneOcc (in_lam1 || in_lam2)
            False        -- False, because it occurs in both branches
            (int_cxt1 && int_cxt2)
-orOccInfo _     _       = NoOccInfo
+orOccInfo a1 a2 = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) )
+		  NoOccInfo
 \end{code}
diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 70e0fa1149..a2e06a0bf7 100644
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -271,9 +271,12 @@ addNewInScopeIds env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) v
 	-- _delete_ it from the substitution when going inside
 	-- the (\x -> ...)!
 
-modifyInScope :: SimplEnv -> CoreBndr -> CoreBndr -> SimplEnv
-modifyInScope env@(SimplEnv {seInScope = in_scope}) v v'
-  = env {seInScope = modifyInScopeSet in_scope v v'}
+modifyInScope :: SimplEnv -> CoreBndr -> SimplEnv
+-- The variable should already be in scope, but 
+-- replace the existing version with this new one
+-- which has more information
+modifyInScope env@(SimplEnv {seInScope = in_scope}) v 
+  = env {seInScope = extendInScopeSet in_scope v}
 
 ---------------------
 zapSubstEnv :: SimplEnv -> SimplEnv
@@ -440,20 +443,25 @@ floatBinds (Floats bs _) = fromOL bs
 %*									*
 %************************************************************************
 
+Note [Global Ids in the substitution]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We look up even a global (eg imported) Id in the substitution. Consider
+   case X.g_34 of b { (a,b) ->  ... case X.g_34 of { (p,q) -> ...} ... }
+The binder-swap in the occurence analyser will add a binding
+for a LocalId version of g (with the same unique though):
+   case X.g_34 of b { (a,b) ->  let g_34 = b in 
+				... case X.g_34 of { (p,q) -> ...} ... }
+So we want to look up the inner X.g_34 in the substitution, where we'll
+find that it has been substituted by b.  (Or conceivably cloned.)
 
 \begin{code}
 substId :: SimplEnv -> InId -> SimplSR
 -- Returns DoneEx only on a non-Var expression
 substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v 
-  | not (isLocalId v) 
-  = DoneId v
-  | otherwise	-- A local Id
-  = case lookupVarEnv ids v of
+  = case lookupVarEnv ids v of		-- Note [Global Ids in the substitution]
 	Nothing		      -> DoneId (refine in_scope v)
 	Just (DoneId v)       -> DoneId (refine in_scope v)
-	Just (DoneEx (Var v)) 
-	       | isLocalId v  -> DoneId (refine in_scope v)
-	       | otherwise    -> DoneId v
+	Just (DoneEx (Var v)) -> DoneId (refine in_scope v)
 	Just res	      -> res	-- DoneEx non-var, or ContEx
   where
 
@@ -461,9 +469,11 @@ substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
 	-- Even though it isn't in the substitution, it may be in
 	-- the in-scope set with better IdInfo
 refine :: InScopeSet -> Var -> Var
-refine in_scope v = case lookupInScope in_scope v of
+refine in_scope v 
+  | isLocalId v = case lookupInScope in_scope v of
 			 Just v' -> v'
 			 Nothing -> WARN( True, ppr v ) v	-- This is an error!
+  | otherwise = v
 
 lookupRecBndr :: SimplEnv -> InId -> OutId
 -- Look up an Id which has been put into the envt by simplRecBndrs,
@@ -519,7 +529,7 @@ simplLamBndr env bndr
     old_unf = idUnfolding bndr
     (env1, id1) = substIdBndr env bndr
     id2  = id1 `setIdUnfolding` substUnfolding env old_unf
-    env2 = modifyInScope env1 id1 id2
+    env2 = modifyInScope env1 id2
 
 ---------------
 simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
@@ -644,7 +654,7 @@ addBndrRules :: SimplEnv -> InBndr -> OutBndr -> (SimplEnv, OutBndr)
 -- Rules are added back in to to the bin
 addBndrRules env in_id out_id
   | isEmptySpecInfo old_rules = (env, out_id)
-  | otherwise = (modifyInScope env out_id final_id, final_id)
+  | otherwise = (modifyInScope env final_id, final_id)
   where
     subst     = mkCoreSubst env
     old_rules = idSpecialisation in_id
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 39bf3d825c..14d11dff97 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -14,6 +14,7 @@ import Type hiding      ( substTy, extendTvSubst )
 import SimplEnv
 import SimplUtils
 import MkId		( rUNTIME_ERROR_ID )
+import FamInstEnv	( FamInstEnv )
 import Id
 import Var
 import IdInfo
@@ -365,6 +366,9 @@ simplNonRecX :: SimplEnv
              -> SimplM SimplEnv
 
 simplNonRecX env bndr new_rhs
+  | isDeadBinder bndr	-- Not uncommon; e.g. case (a,b) of b { (p,q) -> p }
+  = return env		-- 		 Here b is dead, and we avoid creating
+  | otherwise		--		 the binding b = (a,b)
   = do  { (env', bndr') <- simplBinder env bndr
         ; completeNonRecX env' (isStrictId bndr) bndr bndr' new_rhs }
 
@@ -1191,7 +1195,91 @@ all this at once is TOO HARD!
 %*                                                                      *
 %************************************************************************
 
-Blob of helper functions for the "case-of-something-else" situation.
+Note [Case elimination]
+~~~~~~~~~~~~~~~~~~~~~~~
+The case-elimination transformation discards redundant case expressions.
+Start with a simple situation:
+
+        case x# of      ===>   e[x#/y#]
+          y# -> e
+
+(when x#, y# are of primitive type, of course).  We can't (in general)
+do this for algebraic cases, because we might turn bottom into
+non-bottom!
+
+The code in SimplUtils.prepareAlts has the effect of generalise this
+idea to look for a case where we're scrutinising a variable, and we
+know that only the default case can match.  For example:
+
+        case x of
+          0#      -> ...
+          DEFAULT -> ...(case x of
+                         0#      -> ...
+                         DEFAULT -> ...) ...
+
+Here the inner case is first trimmed to have only one alternative, the
+DEFAULT, after which it's an instance of the previous case.  This
+really only shows up in eliminating error-checking code.
+
+We also make sure that we deal with this very common case:
+
+        case e of
+          x -> ...x...
+
+Here we are using the case as a strict let; if x is used only once
+then we want to inline it.  We have to be careful that this doesn't
+make the program terminate when it would have diverged before, so we
+check that
+        - e is already evaluated (it may so if e is a variable)
+        - x is used strictly, or
+
+Lastly, the code in SimplUtils.mkCase combines identical RHSs.  So
+
+        case e of       ===> case e of DEFAULT -> r
+           True  -> r
+           False -> r
+
+Now again the case may be elminated by the CaseElim transformation.
+
+
+Further notes about case elimination
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider:       test :: Integer -> IO ()
+                test = print
+
+Turns out that this compiles to:
+    Print.test
+      = \ eta :: Integer
+          eta1 :: State# RealWorld ->
+          case PrelNum.< eta PrelNum.zeroInteger of wild { __DEFAULT ->
+          case hPutStr stdout
+                 (PrelNum.jtos eta ($w[] @ Char))
+                 eta1
+          of wild1 { (# new_s, a4 #) -> PrelIO.lvl23 new_s  }}
+
+Notice the strange '<' which has no effect at all. This is a funny one.
+It started like this:
+
+f x y = if x < 0 then jtos x
+          else if y==0 then "" else jtos x
+
+At a particular call site we have (f v 1).  So we inline to get
+
+        if v < 0 then jtos x
+        else if 1==0 then "" else jtos x
+
+Now simplify the 1==0 conditional:
+
+        if v<0 then jtos v else jtos v
+
+Now common-up the two branches of the case:
+
+        case (v<0) of DEFAULT -> jtos v
+
+Why don't we drop the case?  Because it's strict in v.  It's technically
+wrong to drop even unnecessary evaluations, and in practice they
+may be a result of 'seq' so we *definitely* don't want to drop those.
+I don't really know how to improve this situation.
 
 \begin{code}
 ---------------------------------------------------------
@@ -1225,7 +1313,7 @@ rebuildCase env scrut case_bndr alts cont
 
 rebuildCase env scrut case_bndr [(_, bndrs, rhs)] cont
   -- See if we can get rid of the case altogether
-  -- See the extensive notes on case-elimination above
+  -- See Note [Case eliminiation] 
   -- mkCase made sure that if all the alternatives are equal,
   -- then there is now only one (DEFAULT) rhs
  | all isDeadBinder bndrs       -- bndrs are [InId]
@@ -1301,78 +1389,15 @@ try to eliminate uses of v in the RHSs in favour of case_bndr; that
 way, there's a chance that v will now only be used once, and hence
 inlined.
 
-Note [no-case-of-case]
-~~~~~~~~~~~~~~~~~~~~~~
-We *used* to suppress the binder-swap in case expressoins when 
--fno-case-of-case is on.  Old remarks:
-    "This happens in the first simplifier pass,
-    and enhances full laziness.  Here's the bad case:
-            f = \ y -> ...(case x of I# v -> ...(case x of ...) ... )
-    If we eliminate the inner case, we trap it inside the I# v -> arm,
-    which might prevent some full laziness happening.  I've seen this
-    in action in spectral/cichelli/Prog.hs:
-             [(m,n) | m <- [1..max], n <- [1..max]]
-    Hence the check for NoCaseOfCase."
-However, now the full-laziness pass itself reverses the binder-swap, so this
-check is no longer necessary.
-
-Note [Suppressing the case binder-swap]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-There is another situation when it might make sense to suppress the
-case-expression binde-swap. If we have
-
-    case x of w1 { DEFAULT -> case x of w2 { A -> e1; B -> e2 }
-                   ...other cases .... }
-
-We'll perform the binder-swap for the outer case, giving
-
-    case x of w1 { DEFAULT -> case w1 of w2 { A -> e1; B -> e2 }
-                   ...other cases .... }
-
-But there is no point in doing it for the inner case, because w1 can't
-be inlined anyway.  Furthermore, doing the case-swapping involves
-zapping w2's occurrence info (see paragraphs that follow), and that
-forces us to bind w2 when doing case merging.  So we get
-
-    case x of w1 { A -> let w2 = w1 in e1
-                   B -> let w2 = w1 in e2
-                   ...other cases .... }
-
-This is plain silly in the common case where w2 is dead.
-
-Even so, I can't see a good way to implement this idea.  I tried
-not doing the binder-swap if the scrutinee was already evaluated
-but that failed big-time:
-
-        data T = MkT !Int
-
-        case v of w  { MkT x ->
-        case x of x1 { I# y1 ->
-        case x of x2 { I# y2 -> ...
-
-Notice that because MkT is strict, x is marked "evaluated".  But to
-eliminate the last case, we must either make sure that x (as well as
-x1) has unfolding MkT y1.  THe straightforward thing to do is to do
-the binder-swap.  So this whole note is a no-op.
+Historical note: we use to do the "case binder swap" in the Simplifier
+so there were additional complications if the scrutinee was a variable.
+Now the binder-swap stuff is done in the occurrence analyer; see
+OccurAnal Note [Binder swap].
 
 Note [zapOccInfo]
 ~~~~~~~~~~~~~~~~~
-If we replace the scrutinee, v, by tbe case binder, then we have to nuke
-any occurrence info (eg IAmDead) in the case binder, because the
-case-binder now effectively occurs whenever v does.  AND we have to do
-the same for the pattern-bound variables!  Example:
-
-        (case x of { (a,b) -> a }) (case x of { (p,q) -> q })
-
-Here, b and p are dead.  But when we move the argment inside the first
-case RHS, and eliminate the second case, we get
-
-        case x of { (a,b) -> a b }
-
-Urk! b is alive!  Reason: the scrutinee was a variable, and case elimination
-happened.
-
-Indeed, this can happen anytime the case binder isn't dead:
+If the case binder is not dead, then neither are the pattern bound
+variables:  
         case <any> of x { (a,b) ->
         case x of { (p,q) -> p } }
 Here (a,b) both look dead, but come alive after the inner case is eliminated.
@@ -1381,15 +1406,6 @@ The point is that we bring into the envt a binding
 after the outer case, and that makes (a,b) alive.  At least we do unless
 the case binder is guaranteed dead.
 
-Note [Case of cast]
-~~~~~~~~~~~~~~~~~~~
-Consider        case (v `cast` co) of x { I# ->
-                ... (case (v `cast` co) of {...}) ...
-We'd like to eliminate the inner case.  We can get this neatly by
-arranging that inside the outer case we add the unfolding
-        v |-> x `cast` (sym co)
-to v.  Then we should inline v at the inner case, cancel the casts, and away we go
-
 Note [Improving seq]
 ~~~~~~~~~~~~~~~~~~~
 Consider
@@ -1420,121 +1436,78 @@ At one point I did transformation in LiberateCase, but it's more robust here.
 (Otherwise, there's a danger that we'll simply drop the 'seq' altogether, before
 LiberateCase gets to see it.)
 
-Note [Case elimination]
-~~~~~~~~~~~~~~~~~~~~~~~
-The case-elimination transformation discards redundant case expressions.
-Start with a simple situation:
-
-        case x# of      ===>   e[x#/y#]
-          y# -> e
-
-(when x#, y# are of primitive type, of course).  We can't (in general)
-do this for algebraic cases, because we might turn bottom into
-non-bottom!
-
-The code in SimplUtils.prepareAlts has the effect of generalise this
-idea to look for a case where we're scrutinising a variable, and we
-know that only the default case can match.  For example:
-
-        case x of
-          0#      -> ...
-          DEFAULT -> ...(case x of
-                         0#      -> ...
-                         DEFAULT -> ...) ...
-
-Here the inner case is first trimmed to have only one alternative, the
-DEFAULT, after which it's an instance of the previous case.  This
-really only shows up in eliminating error-checking code.
-
-We also make sure that we deal with this very common case:
-
-        case e of
-          x -> ...x...
-
-Here we are using the case as a strict let; if x is used only once
-then we want to inline it.  We have to be careful that this doesn't
-make the program terminate when it would have diverged before, so we
-check that
-        - e is already evaluated (it may so if e is a variable)
-        - x is used strictly, or
-
-Lastly, the code in SimplUtils.mkCase combines identical RHSs.  So
-
-        case e of       ===> case e of DEFAULT -> r
-           True  -> r
-           False -> r
-
-Now again the case may be elminated by the CaseElim transformation.
 
+Historical note [no-case-of-case]
+~~~~~~~~~~~~~~~~~~~~~~
+We *used* to suppress the binder-swap in case expressoins when 
+-fno-case-of-case is on.  Old remarks:
+    "This happens in the first simplifier pass,
+    and enhances full laziness.  Here's the bad case:
+            f = \ y -> ...(case x of I# v -> ...(case x of ...) ... )
+    If we eliminate the inner case, we trap it inside the I# v -> arm,
+    which might prevent some full laziness happening.  I've seen this
+    in action in spectral/cichelli/Prog.hs:
+             [(m,n) | m <- [1..max], n <- [1..max]]
+    Hence the check for NoCaseOfCase."
+However, now the full-laziness pass itself reverses the binder-swap, so this
+check is no longer necessary.
 
-Further notes about case elimination
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider:       test :: Integer -> IO ()
-                test = print
+Historical note [Suppressing the case binder-swap]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There is another situation when it might make sense to suppress the
+case-expression binde-swap. If we have
 
-Turns out that this compiles to:
-    Print.test
-      = \ eta :: Integer
-          eta1 :: State# RealWorld ->
-          case PrelNum.< eta PrelNum.zeroInteger of wild { __DEFAULT ->
-          case hPutStr stdout
-                 (PrelNum.jtos eta ($w[] @ Char))
-                 eta1
-          of wild1 { (# new_s, a4 #) -> PrelIO.lvl23 new_s  }}
+    case x of w1 { DEFAULT -> case x of w2 { A -> e1; B -> e2 }
+                   ...other cases .... }
 
-Notice the strange '<' which has no effect at all. This is a funny one.
-It started like this:
+We'll perform the binder-swap for the outer case, giving
 
-f x y = if x < 0 then jtos x
-          else if y==0 then "" else jtos x
+    case x of w1 { DEFAULT -> case w1 of w2 { A -> e1; B -> e2 }
+                   ...other cases .... }
 
-At a particular call site we have (f v 1).  So we inline to get
+But there is no point in doing it for the inner case, because w1 can't
+be inlined anyway.  Furthermore, doing the case-swapping involves
+zapping w2's occurrence info (see paragraphs that follow), and that
+forces us to bind w2 when doing case merging.  So we get
 
-        if v < 0 then jtos x
-        else if 1==0 then "" else jtos x
+    case x of w1 { A -> let w2 = w1 in e1
+                   B -> let w2 = w1 in e2
+                   ...other cases .... }
 
-Now simplify the 1==0 conditional:
+This is plain silly in the common case where w2 is dead.
 
-        if v<0 then jtos v else jtos v
+Even so, I can't see a good way to implement this idea.  I tried
+not doing the binder-swap if the scrutinee was already evaluated
+but that failed big-time:
 
-Now common-up the two branches of the case:
+        data T = MkT !Int
 
-        case (v<0) of DEFAULT -> jtos v
+        case v of w  { MkT x ->
+        case x of x1 { I# y1 ->
+        case x of x2 { I# y2 -> ...
 
-Why don't we drop the case?  Because it's strict in v.  It's technically
-wrong to drop even unnecessary evaluations, and in practice they
-may be a result of 'seq' so we *definitely* don't want to drop those.
-I don't really know how to improve this situation.
+Notice that because MkT is strict, x is marked "evaluated".  But to
+eliminate the last case, we must either make sure that x (as well as
+x1) has unfolding MkT y1.  THe straightforward thing to do is to do
+the binder-swap.  So this whole note is a no-op.
 
 
 \begin{code}
-simplCaseBinder :: SimplEnv -> OutExpr -> OutId -> [InAlt]
-                -> SimplM (SimplEnv, OutExpr, OutId)
-simplCaseBinder env0 scrut0 case_bndr0 alts
-  = do  { (env1, case_bndr1) <- simplBinder env0 case_bndr0
-
-        ; fam_envs <- getFamEnvs
-        ; (env2, scrut2, case_bndr2) <- improve_seq fam_envs env1 scrut0
-                                                case_bndr0 case_bndr1 alts
-                        -- Note [Improving seq]
-
-        ; let (env3, case_bndr3) = improve_case_bndr env2 scrut2 case_bndr2
-                        -- Note [Case of cast]
-
-        ; return (env3, scrut2, case_bndr3) }
-  where
-
-    improve_seq fam_envs env scrut case_bndr case_bndr1 [(DEFAULT,_,_)]
-        | Just (co, ty2) <- topNormaliseType fam_envs (idType case_bndr1)
-        =  do { case_bndr2 <- newId (fsLit "nt") ty2
-              ; let rhs  = DoneEx (Var case_bndr2 `Cast` mkSymCoercion co)
-                    env2 = extendIdSubst env case_bndr rhs
-              ; return (env2, scrut `Cast` co, case_bndr2) }
-
-    improve_seq _ env scrut _ case_bndr1 _
-        = return (env, scrut, case_bndr1)
-
-
+improveSeq :: (FamInstEnv, FamInstEnv) -> SimplEnv
+	   -> OutExpr -> InId -> OutId -> [InAlt]
+	   -> SimplM (SimplEnv, OutExpr, OutId)
+-- Note [Improving seq]
+improveSeq fam_envs env scrut case_bndr case_bndr1 [(DEFAULT,_,_)]
+  | Just (co, ty2) <- topNormaliseType fam_envs (idType case_bndr1)
+  =  do { case_bndr2 <- newId (fsLit "nt") ty2
+        ; let rhs  = DoneEx (Var case_bndr2 `Cast` mkSymCoercion co)
+              env2 = extendIdSubst env case_bndr rhs
+        ; return (env2, scrut `Cast` co, case_bndr2) }
+
+improveSeq _ env scrut _ case_bndr1 _
+  = return (env, scrut, case_bndr1)
+
+{-
     improve_case_bndr env scrut case_bndr
         -- See Note [no-case-of-case]
 	--  | switchIsOn (getSwitchChecker env) NoCaseOfCase
@@ -1555,12 +1528,9 @@ simplCaseBinder env0 scrut0 case_bndr0 alts
 
             _ -> (env, case_bndr)
         where
-          case_bndr' = zapOccInfo case_bndr
+          case_bndr' = zapIdOccInfo case_bndr
           env1       = modifyInScope env case_bndr case_bndr'
-
-
-zapOccInfo :: InId -> InId      -- See Note [zapOccInfo]
-zapOccInfo b = b `setIdOccInfo` NoOccInfo
+-}
 \end{code}
 
 
@@ -1616,10 +1586,15 @@ simplAlts :: SimplEnv
 
 simplAlts env scrut case_bndr alts cont'
   = -- pprTrace "simplAlts" (ppr alts $$ ppr (seIdSubst env)) $
-    do  { let alt_env = zapFloats env
-        ; (alt_env', scrut', case_bndr') <- simplCaseBinder alt_env scrut case_bndr alts
+    do  { let env0 = zapFloats env
+
+        ; (env1, case_bndr1) <- simplBinder env0 case_bndr
+
+        ; fam_envs <- getFamEnvs
+	; (alt_env', scrut', case_bndr') <- improveSeq fam_envs env1 scrut 
+						       case_bndr case_bndr1 alts
 
-        ; (imposs_deflt_cons, in_alts) <- prepareAlts alt_env' scrut case_bndr' alts
+        ; (imposs_deflt_cons, in_alts) <- prepareAlts alt_env' scrut' case_bndr' alts
 
         ; alts' <- mapM (simplAlt alt_env' imposs_deflt_cons case_bndr' cont') in_alts
         ; return (scrut', case_bndr', alts') }
@@ -1685,6 +1660,7 @@ simplAlt env _ case_bndr' cont' (DataAlt con, vs, rhs)
               evald_v  = zapped_v `setIdUnfolding` evaldUnfolding
           go _ _ = pprPanic "cat_evals" (ppr con $$ ppr vs $$ ppr the_strs)
 
+	-- See Note [zapOccInfo]
         -- zap_occ_info: if the case binder is alive, then we add the unfolding
         --      case_bndr = C vs
         -- to the envt; so vs are now very much alive
@@ -1693,15 +1669,15 @@ simplAlt env _ case_bndr' cont' (DataAlt con, vs, rhs)
         --   ==>  case e of t { (a,b) -> ...(a)... }
         -- Look, Ma, a is alive now.
     zap_occ_info | isDeadBinder case_bndr' = \ident -> ident
-                 | otherwise               = zapOccInfo
+                 | otherwise               = zapIdOccInfo
 
 addBinderUnfolding :: SimplEnv -> Id -> CoreExpr -> SimplEnv
 addBinderUnfolding env bndr rhs
-  = modifyInScope env bndr (bndr `setIdUnfolding` mkUnfolding False rhs)
+  = modifyInScope env (bndr `setIdUnfolding` mkUnfolding False rhs)
 
 addBinderOtherCon :: SimplEnv -> Id -> [AltCon] -> SimplEnv
 addBinderOtherCon env bndr cons
-  = modifyInScope env bndr (bndr `setIdUnfolding` mkOtherCon cons)
+  = modifyInScope env (bndr `setIdUnfolding` mkOtherCon cons)
 \end{code}
 
 
@@ -1770,8 +1746,7 @@ knownAlt env scrut the_args bndr (DataAlt dc, bs, rhs) cont
                                 -- args are aready OutExprs, but bs are InIds
 
         ; env'' <- simplNonRecX env' bndr bndr_rhs
-        ; -- pprTrace "knownCon2" (ppr bs $$ ppr rhs $$ ppr (seIdSubst env'')) $
-          simplExprF env'' rhs cont }
+        ; simplExprF env'' rhs cont }
   where
     -- Ugh!
     bind_args env' _ [] _  = return env'
@@ -1782,7 +1757,7 @@ knownAlt env scrut the_args bndr (DataAlt dc, bs, rhs) cont
 
     bind_args env' dead_bndr (b:bs') (arg : args)
       = ASSERT( isId b )
-        do { let b' = if dead_bndr then b else zapOccInfo b
+        do { let b' = if dead_bndr then b else zapIdOccInfo b
              -- Note that the binder might be "dead", because it doesn't
              -- occur in the RHS; and simplNonRecX may therefore discard
              -- it via postInlineUnconditionally.