-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.
-
-
-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}
-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)
-
-
- improve_case_bndr env scrut case_bndr
- -- See Note [no-case-of-case]
- -- | switchIsOn (getSwitchChecker env) NoCaseOfCase
- -- = (env, case_bndr)
-
- | otherwise -- Failed try; see Note [Suppressing the case binder-swap]
- -- not (isEvaldUnfolding (idUnfolding v))
- = case scrut of
- Var v -> (modifyInScope env1 v case_bndr', case_bndr')
- -- Note about using modifyInScope for v here
- -- We could extend the substitution instead, but it would be
- -- a hack because then the substitution wouldn't be idempotent
- -- any more (v is an OutId). And this does just as well.
-
- Cast (Var v) co -> (addBinderUnfolding env1 v rhs, case_bndr')
- where
- rhs = Cast (Var case_bndr') (mkSymCoercion co)
-
- _ -> (env, case_bndr)
- where
- case_bndr' = zapOccInfo case_bndr
- env1 = modifyInScope env case_bndr case_bndr'
-
-
-zapOccInfo :: InId -> InId -- See Note [zapOccInfo]
-zapOccInfo b = b `setIdOccInfo` NoOccInfo
-\end{code}
-
-
-simplAlts does two things:
-
-1. Eliminate alternatives that cannot match, including the
- DEFAULT alternative.
-
-2. If the DEFAULT alternative can match only one possible constructor,
- then make that constructor explicit.
- e.g.
- case e of x { DEFAULT -> rhs }
- ===>
- case e of x { (a,b) -> rhs }
- where the type is a single constructor type. This gives better code
- when rhs also scrutinises x or e.
-
-Here "cannot match" includes knowledge from GADTs
-
-It's a good idea do do this stuff before simplifying the alternatives, to
-avoid simplifying alternatives we know can't happen, and to come up with
-the list of constructors that are handled, to put into the IdInfo of the
-case binder, for use when simplifying the alternatives.
-
-Eliminating the default alternative in (1) isn't so obvious, but it can
-happen:
-
-data Colour = Red | Green | Blue
-
-f x = case x of
- Red -> ..
- Green -> ..
- DEFAULT -> h x
-
-h y = case y of
- Blue -> ..
- DEFAULT -> [ case y of ... ]
-
-If we inline h into f, the default case of the inlined h can't happen.
-If we don't notice this, we may end up filtering out *all* the cases
-of the inner case y, which give us nowhere to go!
-