\begin{code}
module SimplUtils (
- mkLam, mkCase, mkDataConAlt,
+ mkLam, mkCase,
-- Inlining,
preInlineUnconditionally, postInlineUnconditionally, activeInline, activeRule,
where
args = reverse acc
hole_ty = applyTypeToArgs (Var fun) (idType fun)
- [substExpr se arg | (arg,se,_) <- args]
+ [substExpr_mb se arg | (arg,se,_) <- args]
+ substExpr_mb Nothing arg = arg
+ substExpr_mb (Just se) arg = substExpr se arg
----------------------------
vanilla_stricts, computed_stricts :: [Bool]
-- Make a data-constructor alternative to replace the DEFAULT case
-- NB: there's something a bit bogus here, because we put OutTypes into an InAlt
mkDataConAlt con inst_tys rhs
- = do { tv_uniqs <- getUniquesSmpl
+ = ASSERT(not (isNewTyCon (dataConTyCon con)))
+ do { tv_uniqs <- getUniquesSmpl
; arg_uniqs <- getUniquesSmpl
; let tv_bndrs = zipWith mk_tv_bndr (dataConExTyVars con) tv_uniqs
arg_tys = dataConInstArgTys con (inst_tys ++ mkTyVarTys tv_bndrs)
| isNewTyCon (dataConTyCon con)
= wrapNewTypeBody (dataConTyCon con) arg_tys (varToCoreExpr $ head args)
| otherwise
- = pprTrace "mkCase1" (ppr con) $ mkConApp con (arg_ty_exprs ++ varsToCoreExprs args)
+ = mkConApp con (arg_ty_exprs ++ varsToCoreExprs args)
identity_rhs (LitAlt lit) _ = Lit lit
identity_rhs DEFAULT _ = Var case_bndr