-Let to case
-~~~~~~~~~~~
-
-Given a type generate the case alternatives
-
- C a b -> C a b
-
-if there's one constructor, or
-
- x -> x
-
-if there's many, or if it's a primitive type.
-
-
-\begin{code}
-mkIdentityAlts
- :: Type -- type of RHS
- -> DemandInfo -- Appropriate demand info
- -> SmplM InAlts -- result
-
-mkIdentityAlts rhs_ty demand_info
- = case (maybeAppDataTyConExpandingDicts rhs_ty) of
- Just (tycon, ty_args, [data_con]) -> -- algebraic type suitable for unpacking
- let
- inst_con_arg_tys = dataConArgTys data_con ty_args
- in
- newIds inst_con_arg_tys `thenSmpl` \ new_bindees ->
- let
- new_binders = [ (b, bad_occ_info) | b <- new_bindees ]
- in
- returnSmpl (
- AlgAlts
- [(data_con, new_binders, mkCon data_con [] ty_args (map VarArg new_bindees))]
- NoDefault
- )
-
- _ -> panic "mkIdentityAlts" -- Should never happen; only called for single-constructor types
- where
- bad_occ_info = ManyOcc 0 -- Non-committal!
-
-
-{- SHOULD NEVER HAPPEN
- | isPrimType rhs_ty
- = newId rhs_ty `thenSmpl` \ binder ->
- let
- binder_w_info = binder `addIdDemandInfo` demand_info
- -- It's occasionally really worth adding the right demand info. Consider
- -- let x = E in B
- -- where x is sure to be demanded in B
- -- We will transform to:
- -- case E of x -> B
- -- Now suppose that E simplifies to just y; we get
- -- case y of x -> B
- -- Because x is sure to be demanded, we can eliminate the case
- -- even if pedantic-bottoms is on; but we need to have the right
- -- demand-info on the default branch of the case. That's what
- -- we are doing here.
- in
- returnSmpl (PrimAlts [] (BindDefault (binder, bad_occ_info) (Var binder)))
--}
-\end{code}
-