preInlineUnconditionally :: SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool
preInlineUnconditionally env top_lvl bndr rhs
  | not active 		                     = False
  | isStableUnfolding (idUnfolding bndr)     = False    -- Note [InlineRule and preInlineUnconditionally]
  | isTopLevel top_lvl && isBottomingId bndr = False	-- Note [Top-level bottoming Ids]
  | opt_SimplNoPreInlining                   = False
  | isCoVar bndr                             = False -- Note [Do not inline CoVars unconditionally]
  | otherwise = case idOccInfo bndr of
		  IAmDead	     	     -> True	-- Happens in ((\x.1) v)
	  	  OneOcc in_lam True int_cxt -> try_once in_lam int_cxt
		  _                          -> False
  where
    mode = getMode env
    active = isActive (sm_phase mode) act
             -- See Note [pre/postInlineUnconditionally in gentle mode]
    act = idInlineActivation bndr
    try_once in_lam int_cxt	-- There's one textual occurrence
	| not in_lam = isNotTopLevel top_lvl || early_phase
	| otherwise  = int_cxt && canInlineInLam rhs

-- Be very careful before inlining inside a lambda, because (a) we must not 
-- invalidate occurrence information, and (b) we want to avoid pushing a
-- single allocation (here) into multiple allocations (inside lambda).  
-- Inlining a *function* with a single *saturated* call would be ok, mind you.
--	|| (if is_cheap && not (canInlineInLam rhs) then pprTrace "preinline" (ppr bndr <+> ppr rhs) ok else ok)
--	where 
--	 	is_cheap = exprIsCheap rhs
--		ok = is_cheap && int_cxt

	-- 	int_cxt		The context isn't totally boring
	-- E.g. let f = \ab.BIG in \y. map f xs
	-- 	Don't want to substitute for f, because then we allocate
	--	its closure every time the \y is called
	-- But: let f = \ab.BIG in \y. map (f y) xs
	--	Now we do want to substitute for f, even though it's not 
	--	saturated, because we're going to allocate a closure for 
	--	(f y) every time round the loop anyhow.

	-- canInlineInLam => free vars of rhs are (Once in_lam) or Many,
	-- so substituting rhs inside a lambda doesn't change the occ info.
	-- Sadly, not quite the same as exprIsHNF.
    canInlineInLam (Lit _)		= True
    canInlineInLam (Lam b e)		= isRuntimeVar b || canInlineInLam e
    canInlineInLam (Note _ e)		= canInlineInLam e
    canInlineInLam _			= False

    early_phase = case sm_phase mode of
                    Phase 0 -> False
                    _       -> True
-- If we don't have this early_phase test, consider
--	x = length [1,2,3]
-- The full laziness pass carefully floats all the cons cells to
-- top level, and preInlineUnconditionally floats them all back in.
-- Result is (a) static allocation replaced by dynamic allocation
--	     (b) many simplifier iterations because this tickles
--		 a related problem; only one inlining per pass
-- 
-- On the other hand, I have seen cases where top-level fusion is
-- lost if we don't inline top level thing (e.g. string constants)
-- Hence the test for phase zero (which is the phase for all the final
-- simplifications).  Until phase zero we take no special notice of
-- top level things, but then we become more leery about inlining
-- them.  

postInlineUnconditionally 
    :: SimplEnv -> TopLevelFlag
    -> OutId		-- The binder (an InId would be fine too)
       			--            (*not* a CoVar)
    -> OccInfo 		-- From the InId
    -> OutExpr
    -> Unfolding
    -> Bool
postInlineUnconditionally env top_lvl bndr occ_info rhs unfolding
  | not active		        = False
  | isWeakLoopBreaker occ_info  = False	-- If it's a loop-breaker of any kind, don't inline
					-- because it might be referred to "earlier"
  | isExportedId bndr           = False
  | isStableUnfolding unfolding = False	-- Note [InlineRule and postInlineUnconditionally]
  | isTopLevel top_lvl          = False	-- Note [Top level and postInlineUnconditionally]
  | exprIsTrivial rhs 	        = True
  | otherwise
  = case occ_info of
	-- The point of examining occ_info here is that for *non-values* 
	-- that occur outside a lambda, the call-site inliner won't have
	-- a chance (becuase it doesn't know that the thing
	-- only occurs once).   The pre-inliner won't have gotten
	-- it either, if the thing occurs in more than one branch
	-- So the main target is things like
	--	let x = f y in
	--	case v of
	--	   True  -> case x of ...
	--	   False -> case x of ...
	-- This is very important in practice; e.g. wheel-seive1 doubles 
	-- in allocation if you miss this out
      OneOcc in_lam _one_br int_cxt	-- OneOcc => no code-duplication issue
	->     smallEnoughToInline unfolding	-- Small enough to dup
			-- ToDo: consider discount on smallEnoughToInline if int_cxt is true
			--
		 	-- NB: Do NOT inline arbitrarily big things, even if one_br is True
			-- Reason: doing so risks exponential behaviour.  We simplify a big
			--	   expression, inline it, and simplify it again.  But if the
			--	   very same thing happens in the big expression, we get 
			--	   exponential cost!
			-- PRINCIPLE: when we've already simplified an expression once, 
			-- make sure that we only inline it if it's reasonably small.

           && (not in_lam || 
			-- Outside a lambda, we want to be reasonably aggressive
			-- about inlining into multiple branches of case
			-- e.g. let x = <non-value> 
			--	in case y of { C1 -> ..x..; C2 -> ..x..; C3 -> ... } 
			-- Inlining can be a big win if C3 is the hot-spot, even if
			-- the uses in C1, C2 are not 'interesting'
			-- An example that gets worse if you add int_cxt here is 'clausify'

		(isCheapUnfolding unfolding && int_cxt))
			-- isCheap => acceptable work duplication; in_lam may be true
			-- int_cxt to prevent us inlining inside a lambda without some 
			-- good reason.  See the notes on int_cxt in preInlineUnconditionally

      IAmDead -> True	-- This happens; for example, the case_bndr during case of
			-- known constructor:  case (a,b) of x { (p,q) -> ... }
			-- Here x isn't mentioned in the RHS, so we don't want to
			-- create the (dead) let-binding  let x = (a,b) in ...

      _ -> False

-- Here's an example that we don't handle well:
--	let f = if b then Left (\x.BIG) else Right (\y.BIG)
--	in \y. ....case f of {...} ....
-- Here f is used just once, and duplicating the case work is fine (exprIsCheap).
-- But
--  - We can't preInlineUnconditionally because that woud invalidate
--    the occ info for b.
--  - We can't postInlineUnconditionally because the RHS is big, and
--    that risks exponential behaviour
--  - We can't call-site inline, because the rhs is big
-- Alas!

  where
    active = isActive (sm_phase (getMode env)) (idInlineActivation bndr)
        -- See Note [pre/postInlineUnconditionally in gentle mode]

mkLam :: SimplEnv -> [OutBndr] -> OutExpr -> SimplM OutExpr
-- mkLam tries three things
--	a) eta reduction, if that gives a trivial expression
--	b) eta expansion [only if there are some value lambdas]

mkLam _b [] body 
  = return body
mkLam _env bndrs body
  = do	{ dflags <- getDOptsSmpl
	; mkLam' dflags bndrs body }
  where
    mkLam' :: DynFlags -> [OutBndr] -> OutExpr -> SimplM OutExpr
    mkLam' dflags bndrs (Cast body co)
      | not (any bad bndrs)
	-- Note [Casts and lambdas]
      = do { lam <- mkLam' dflags bndrs body
           ; return (mkCoerce (mkPiCos bndrs co) lam) }
      where
        co_vars  = tyCoVarsOfCo co
	bad bndr = isCoVar bndr && bndr `elemVarSet` co_vars      

    mkLam' dflags bndrs body@(Lam {})
      = mkLam' dflags (bndrs ++ bndrs1) body1
      where
        (bndrs1, body1) = collectBinders body

    mkLam' dflags bndrs body
      | dopt Opt_DoEtaReduction dflags
      , Just etad_lam <- tryEtaReduce bndrs body
      = do { tick (EtaReduction (head bndrs))
	   ; return etad_lam }

      | otherwise
      = return (mkLams bndrs body)

tryEtaExpand :: SimplEnv -> OutId -> OutExpr -> SimplM (Arity, OutExpr)
-- See Note [Eta-expanding at let bindings]
tryEtaExpand env bndr rhs
  = do { dflags <- getDOptsSmpl
       ; (new_arity, new_rhs) <- try_expand dflags

       ; WARN( new_arity < old_arity || new_arity < _dmd_arity, 
               (ptext (sLit "Arity decrease:") <+> (ppr bndr <+> ppr old_arity
		<+> ppr new_arity <+> ppr _dmd_arity) $$ ppr new_rhs) )
			-- Note [Arity decrease]
         return (new_arity, new_rhs) }
  where
    try_expand dflags
      | exprIsTrivial rhs
      = return (exprArity rhs, rhs)

      | sm_eta_expand (getMode env)      -- Provided eta-expansion is on
      , let dicts_cheap = dopt Opt_DictsCheap dflags
            new_arity   = findArity dicts_cheap bndr rhs old_arity
      , new_arity > manifest_arity  	-- And the curent manifest arity isn't enough
      		    			-- See Note [Eta expansion to manifes arity]
      = do { tick (EtaExpansion bndr)
           ; return (new_arity, etaExpand new_arity rhs) }
      | otherwise
      = return (manifest_arity, rhs)

    manifest_arity = manifestArity rhs
    old_arity  = idArity bndr
    _dmd_arity = length $ fst $ splitStrictSig $ idStrictness bndr

findArity :: Bool -> Id -> CoreExpr -> Arity -> Arity
-- This implements the fixpoint loop for arity analysis
-- See Note [Arity analysis]
findArity dicts_cheap bndr rhs old_arity
  = go (exprEtaExpandArity (mk_cheap_fn dicts_cheap init_cheap_app) rhs)
       -- We always call exprEtaExpandArity once, but usually 
       -- that produces a result equal to old_arity, and then
       -- we stop right away (since arities should not decrease)
       -- Result: the common case is that there is just one iteration
  where
    go :: Arity -> Arity
    go cur_arity
      | cur_arity <= old_arity = cur_arity	
      | new_arity == cur_arity = cur_arity
      | otherwise = ASSERT( new_arity < cur_arity )
                    pprTrace "Exciting arity" 
                       (vcat [ ppr bndr <+> ppr cur_arity <+> ppr new_arity
                             , ppr rhs])
                    go new_arity
      where
        new_arity = exprEtaExpandArity (mk_cheap_fn dicts_cheap cheap_app) rhs
      
        cheap_app :: CheapAppFun
        cheap_app fn n_val_args
          | fn == bndr = n_val_args < cur_arity
          | otherwise  = isCheapApp fn n_val_args

    init_cheap_app :: CheapAppFun
    init_cheap_app fn n_val_args
      | fn == bndr = True
      | otherwise  = isCheapApp fn n_val_args
 
mk_cheap_fn :: Bool -> CheapAppFun -> CheapFun
mk_cheap_fn dicts_cheap cheap_app
  | not dicts_cheap
  = \e _     -> exprIsCheap' cheap_app e
  | otherwise
  = \e mb_ty -> exprIsCheap' cheap_app e
             || case mb_ty of
                  Nothing -> False
                  Just ty -> isDictLikeTy ty
	-- If the experimental -fdicts-cheap flag is on, we eta-expand through
	-- dictionary bindings.  This improves arities. Thereby, it also
	-- means that full laziness is less prone to floating out the
	-- application of a function to its dictionary arguments, which
	-- can thereby lose opportunities for fusion.  Example:
	-- 	foo :: Ord a => a -> ...
	--	foo = /\a \(d:Ord a). let d' = ...d... in \(x:a). ....
	--		-- So foo has arity 1
	--
	--	f = \x. foo dInt $ bar x
	--
	-- The (foo DInt) is floated out, and makes ineffective a RULE 
	--	foo (bar x) = ...
	--
	-- One could go further and make exprIsCheap reply True to any
	-- dictionary-typed expression, but that's more work.
	-- 
	-- See Note [Dictionary-like types] in TcType.lhs for why we use
  	-- isDictLikeTy here rather than isDictTy

abstractFloats :: [OutTyVar] -> SimplEnv -> OutExpr -> SimplM ([OutBind], OutExpr)
abstractFloats main_tvs body_env body
  = ASSERT( notNull body_floats )
    do	{ (subst, float_binds) <- mapAccumLM abstract empty_subst body_floats
	; return (float_binds, CoreSubst.substExpr (text "abstract_floats1") subst body) }
  where
    main_tv_set = mkVarSet main_tvs
    body_floats = getFloats body_env
    empty_subst = CoreSubst.mkEmptySubst (seInScope body_env)

    abstract :: CoreSubst.Subst -> OutBind -> SimplM (CoreSubst.Subst, OutBind)
    abstract subst (NonRec id rhs)
      = do { (poly_id, poly_app) <- mk_poly tvs_here id
	   ; let poly_rhs = mkLams tvs_here rhs'
		 subst'   = CoreSubst.extendIdSubst subst id poly_app
	   ; return (subst', (NonRec poly_id poly_rhs)) }
      where
	rhs' = CoreSubst.substExpr (text "abstract_floats2") subst rhs
	tvs_here = varSetElems (main_tv_set `intersectVarSet` exprSomeFreeVars isTyVar rhs')
	
		-- Abstract only over the type variables free in the rhs
		-- wrt which the new binding is abstracted.  But the naive
		-- approach of abstract wrt the tyvars free in the Id's type
		-- fails. Consider:
		--	/\ a b -> let t :: (a,b) = (e1, e2)
		--		      x :: a     = fst t
		--		  in ...
		-- Here, b isn't free in x's type, but we must nevertheless
		-- abstract wrt b as well, because t's type mentions b.
		-- Since t is floated too, we'd end up with the bogus:
		--	poly_t = /\ a b -> (e1, e2)
		--	poly_x = /\ a   -> fst (poly_t a *b*)
		-- So for now we adopt the even more naive approach of
		-- abstracting wrt *all* the tyvars.  We'll see if that
		-- gives rise to problems.   SLPJ June 98

    abstract subst (Rec prs)
       = do { (poly_ids, poly_apps) <- mapAndUnzipM (mk_poly tvs_here) ids
	    ; let subst' = CoreSubst.extendSubstList subst (ids `zip` poly_apps)
		  poly_rhss = [mkLams tvs_here (CoreSubst.substExpr (text "abstract_floats3") subst' rhs) 
                              | rhs <- rhss]
	    ; return (subst', Rec (poly_ids `zip` poly_rhss)) }
       where
	 (ids,rhss) = unzip prs
	 	-- For a recursive group, it's a bit of a pain to work out the minimal
		-- set of tyvars over which to abstract:
		--	/\ a b c.  let x = ...a... in
		--	 	   letrec { p = ...x...q...
		--			    q = .....p...b... } in
		--		   ...
		-- Since 'x' is abstracted over 'a', the {p,q} group must be abstracted
		-- over 'a' (because x is replaced by (poly_x a)) as well as 'b'.  
		-- Since it's a pain, we just use the whole set, which is always safe
		-- 
		-- If you ever want to be more selective, remember this bizarre case too:
		--	x::a = x
		-- Here, we must abstract 'x' over 'a'.
	 tvs_here = main_tvs

    mk_poly tvs_here var
      = do { uniq <- getUniqueM
	   ; let  poly_name = setNameUnique (idName var) uniq		-- Keep same name
		  poly_ty   = mkForAllTys tvs_here (idType var)	-- But new type of course
		  poly_id   = transferPolyIdInfo var tvs_here $ -- Note [transferPolyIdInfo] in Id.lhs
			      mkLocalId poly_name poly_ty 
	   ; return (poly_id, mkTyApps (Var poly_id) (mkTyVarTys tvs_here)) }
		-- In the olden days, it was crucial to copy the occInfo of the original var, 
		-- because we were looking at occurrence-analysed but as yet unsimplified code!
		-- In particular, we mustn't lose the loop breakers.  BUT NOW we are looking
		-- at already simplified code, so it doesn't matter
		-- 
		-- It's even right to retain single-occurrence or dead-var info:
		-- Suppose we started with  /\a -> let x = E in B
		-- where x occurs once in B. Then we transform to:
		--	let x' = /\a -> E in /\a -> let x* = x' a in B
		-- where x* has an INLINE prag on it.  Now, once x* is inlined,
		-- the occurrences of x' will be just the occurrences originally
		-- pinned on x.

prepareAlts :: OutExpr -> OutId -> [InAlt] -> SimplM ([AltCon], [InAlt])
prepareAlts scrut case_bndr' alts
  = do	{ let (alts_wo_default, maybe_deflt) = findDefault alts
	      alt_cons = [con | (con,_,_) <- alts_wo_default]
	      imposs_deflt_cons = nub (imposs_cons ++ alt_cons)
		-- "imposs_deflt_cons" are handled 
		--   EITHER by the context, 
		--   OR by a non-DEFAULT branch in this case expression.

	; default_alts <- prepareDefault case_bndr' mb_tc_app 
					 imposs_deflt_cons maybe_deflt

	; let trimmed_alts = filterOut impossible_alt alts_wo_default
	      merged_alts  = mergeAlts trimmed_alts default_alts
		-- We need the mergeAlts in case the new default_alt 
		-- has turned into a constructor alternative.
		-- The merge keeps the inner DEFAULT at the front, if there is one
		-- and interleaves the alternatives in the right order

	; return (imposs_deflt_cons, merged_alts) }
  where
    mb_tc_app = splitTyConApp_maybe (idType case_bndr')
    Just (_, inst_tys) = mb_tc_app 

    imposs_cons = case scrut of
		    Var v -> otherCons (idUnfolding v)
		    _     -> []

    impossible_alt :: CoreAlt -> Bool
    impossible_alt (con, _, _) | con `elem` imposs_cons = True
    impossible_alt (DataAlt con, _, _) = dataConCannotMatch inst_tys con
    impossible_alt _                   = False


prepareDefault :: OutId		-- Case binder; need just for its type. Note that as an
				--   OutId, it has maximum information; this is important.
				--   Test simpl013 is an example
	       -> Maybe (TyCon, [Type])	-- Type of scrutinee, decomposed
	       -> [AltCon]	-- These cons can't happen when matching the default
	       -> Maybe InExpr	-- Rhs
	       -> SimplM [InAlt]	-- Still unsimplified
					-- We use a list because it's what mergeAlts expects,

--------- Fill in known constructor -----------
prepareDefault case_bndr (Just (tycon, inst_tys)) imposs_cons (Just deflt_rhs)
  | 	-- This branch handles the case where we are 
	-- scrutinisng an algebraic data type
    isAlgTyCon tycon		-- It's a data type, tuple, or unboxed tuples.  
  , not (isNewTyCon tycon)	-- We can have a newtype, if we are just doing an eval:
				-- 	case x of { DEFAULT -> e }
				-- and we don't want to fill in a default for them!
  , Just all_cons <- tyConDataCons_maybe tycon
  , not (null all_cons)	
	-- This is a tricky corner case.  If the data type has no constructors,
	-- which GHC allows, then the case expression will have at most a default
	-- alternative.  We don't want to eliminate that alternative, because the
	-- invariant is that there's always one alternative.  It's more convenient
	-- to leave	
	--	case x of { DEFAULT -> e }     
	-- as it is, rather than transform it to
	--	error "case cant match"
	-- which would be quite legitmate.  But it's a really obscure corner, and
	-- not worth wasting code on.
  , let imposs_data_cons = [con | DataAlt con <- imposs_cons]	-- We now know it's a data type 
	impossible con   = con `elem` imposs_data_cons || dataConCannotMatch inst_tys con
  = case filterOut impossible all_cons of
	[]    -> return []	-- Eliminate the default alternative
				-- altogether if it can't match

	[con] -> 	-- It matches exactly one constructor, so fill it in
		 do { tick (FillInCaseDefault case_bndr)
                    ; us <- getUniquesM
                    ; let (ex_tvs, arg_ids) = dataConRepInstPat us con inst_tys
                    ; return [(DataAlt con, ex_tvs ++ arg_ids, deflt_rhs)] }

	_ -> return [(DEFAULT, [], deflt_rhs)]

  | debugIsOn, isAlgTyCon tycon
  , null (tyConDataCons tycon)
  , not (isFamilyTyCon tycon || isAbstractTyCon tycon)
	-- Check for no data constructors
        -- This can legitimately happen for abstract types and type families,
        -- so don't report that
  = pprTrace "prepareDefault" (ppr case_bndr <+> ppr tycon)
        $ return [(DEFAULT, [], deflt_rhs)]

--------- Catch-all cases -----------
prepareDefault _case_bndr _bndr_ty _imposs_cons (Just deflt_rhs)
  = return [(DEFAULT, [], deflt_rhs)]

prepareDefault _case_bndr _bndr_ty _imposs_cons Nothing
  = return []	-- No default branch

mkCase, mkCase1, mkCase2 
   :: DynFlags 
   -> OutExpr -> OutId
   -> [OutAlt]		-- Alternatives in standard (increasing) order
   -> SimplM OutExpr

--------------------------------------------------
--	1. Merge Nested Cases
--------------------------------------------------

mkCase dflags scrut outer_bndr ((DEFAULT, _, deflt_rhs) : outer_alts)
  | dopt Opt_CaseMerge dflags
  , Case (Var inner_scrut_var) inner_bndr _ inner_alts <- deflt_rhs
  , inner_scrut_var == outer_bndr
  = do	{ tick (CaseMerge outer_bndr)

	; let wrap_alt (con, args, rhs) = ASSERT( outer_bndr `notElem` args )
                                          (con, args, wrap_rhs rhs)
		-- Simplifier's no-shadowing invariant should ensure
		-- that outer_bndr is not shadowed by the inner patterns
              wrap_rhs rhs = Let (NonRec inner_bndr (Var outer_bndr)) rhs
		-- The let is OK even for unboxed binders, 

	      wrapped_alts | isDeadBinder inner_bndr = inner_alts
                           | otherwise               = map wrap_alt inner_alts

	      merged_alts = mergeAlts outer_alts wrapped_alts
		-- NB: mergeAlts gives priority to the left
		--	case x of 
		--	  A -> e1
		--	  DEFAULT -> case x of 
		--			A -> e2
		--			B -> e3
		-- When we merge, we must ensure that e1 takes 
		-- precedence over e2 as the value for A!  

	; mkCase1 dflags scrut outer_bndr merged_alts
	}
    	-- Warning: don't call mkCase recursively!
    	-- Firstly, there's no point, because inner alts have already had
    	-- mkCase applied to them, so they won't have a case in their default
    	-- Secondly, if you do, you get an infinite loop, because the bindCaseBndr
    	-- in munge_rhs may put a case into the DEFAULT branch!

mkCase dflags scrut bndr alts = mkCase1 dflags scrut bndr alts

--------------------------------------------------
--	2. Eliminate Identity Case
--------------------------------------------------

mkCase1 _dflags scrut case_bndr alts	-- Identity case
  | all identity_alt alts
  = do { tick (CaseIdentity case_bndr)
       ; return (re_cast scrut) }
  where
    identity_alt (con, args, rhs) = check_eq con args (de_cast rhs)

    check_eq DEFAULT       _    (Var v)   = v == case_bndr
    check_eq (LitAlt lit') _    (Lit lit) = lit == lit'
    check_eq (DataAlt con) args rhs       = rhs `cheapEqExpr` mkConApp con (arg_tys ++ varsToCoreExprs args)
					 || rhs `cheapEqExpr` Var case_bndr
    check_eq _ _ _ = False

    arg_tys = map Type (tyConAppArgs (idType case_bndr))

	-- We've seen this:
	--	case e of x { _ -> x `cast` c }
	-- And we definitely want to eliminate this case, to give
	--	e `cast` c
	-- So we throw away the cast from the RHS, and reconstruct
	-- it at the other end.  All the RHS casts must be the same
	-- if (all identity_alt alts) holds.
	-- 
	-- Don't worry about nested casts, because the simplifier combines them
    de_cast (Cast e _) = e
    de_cast e	       = e

    re_cast scrut = case head alts of
			(_,_,Cast _ co) -> Cast scrut co
			_    	        -> scrut

--------------------------------------------------
--	3. Merge Identical Alternatives
--------------------------------------------------
mkCase1 dflags scrut case_bndr ((_con1,bndrs1,rhs1) : con_alts)
  | all isDeadBinder bndrs1			-- Remember the default 
  , length filtered_alts < length con_alts	-- alternative comes first
	-- Also Note [Dead binders]
  = do	{ tick (AltMerge case_bndr)
	; mkCase2 dflags scrut case_bndr alts' }
  where
    alts' = (DEFAULT, [], rhs1) : filtered_alts
    filtered_alts	  = filter keep con_alts
    keep (_con,bndrs,rhs) = not (all isDeadBinder bndrs && rhs `cheapEqExpr` rhs1)

mkCase1 dflags scrut bndr alts = mkCase2 dflags scrut bndr alts

--------------------------------------------------
--	Catch-all
--------------------------------------------------
mkCase2 _dflags scrut bndr alts 
  = return (Case scrut bndr (coreAltsType alts) alts)