ASSERT( isId new_bndr )
WARN( new_arity < old_arity || new_arity < dmd_arity,
(ptext (sLit "Arity decrease:") <+> ppr final_id <+> ppr old_arity
- <+> ppr new_arity <+> ppr dmd_arity) $$ ppr new_rhs )
+ <+> ppr new_arity <+> ppr dmd_arity) )
-- Note [Arity decrease]
final_id `seq` -- This seq forces the Id, and hence its IdInfo,
simplExprF' env (Type ty) cont
= ASSERT( contIsRhsOrArg cont )
- do { ty' <- simplType env ty
+ do { ty' <- simplCoercion env ty
; rebuild env (Type ty') cont }
simplExprF' env (Case scrut bndr _ alts) cont
---------------------------------
simplCoercion :: SimplEnv -> InType -> SimplM OutType
+-- The InType isn't *necessarily* a coercion, but it might be
+-- (in a type application, say) and optCoercion is a no-op on types
simplCoercion env co
= do { co' <- simplType env co
; return (optCoercion co') }
| otherwise = mkCoerce co expr
rebuildCall env fun info (ApplyTo _ (Type arg_ty) se cont)
- = do { ty' <- simplType (se `setInScope` env) arg_ty
+ = do { ty' <- simplCoercion (se `setInScope` env) arg_ty
; rebuildCall env (fun `App` Type ty') info cont }
rebuildCall env fun
rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont
| all isDeadBinder (case_bndr : bndrs) -- So this is just 'seq'
- = -- For this case, see Note [Rules for seq] in MkId
+ = -- For this case, see Note [RULES for seq] in MkId
do { let rhs' = substExpr env rhs
out_args = [Type (substTy env (idType case_bndr)),
Type (exprType rhs'), scrut, rhs']
in rhs
so that 'rhs' can take advantage of the form of x'. Notice that Note
-[Case of cast] may then apply to the result.
+[Case of cast] may then apply to the result. We only do this if x is actually
+used in the rhs. There is no point in adding the cast if this is really just a
+seq and doing so would interfere with seq rules (Note [RULES for seq]), in
+particular with the one that removes casts.
This showed up in Roman's experiments. Example:
foo :: F Int -> Int -> Int
-> 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
+ | not (isDeadBinder case_bndr)
+ , 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) }