- go_bind :: Subst -> Var -> CoreExpr -> Either Subst CoreExpr
- -- (go_bind subst old_var old_rhs)
- -- either extends subst with (old_var -> new_rhs)
- -- or return new_rhs for a binding new_var = new_rhs
- go_bind subst b r
- | Type ty <- r
- , isTyVar b -- let a::* = TYPE ty in <body>
- = Left (extendTvSubst subst b (substTy subst ty))
-
- | isId b -- let x = e in <body>
- , safe_to_inline (idOccInfo b) || exprIsTrivial r'
- , isAlwaysActive (idInlineActivation b) -- Note [Inline prag in simplOpt]
- = Left (extendIdSubst subst b r')
-
- | otherwise
- = Right r'
- where
- r' = go subst r
+ -- go_lam tries eta reduction
+ go_lam bs' subst (Lam b e)
+ = go_lam (b':bs') subst' e
+ where
+ (subst', b') = subst_opt_bndr subst b
+ go_lam bs' subst e
+ | Just etad_e <- tryEtaReduce bs e' = etad_e
+ | otherwise = mkLams bs e'
+ where
+ bs = reverse bs'
+ e' = simple_opt_expr subst e
+
+----------------------
+simple_opt_bind :: Subst -> CoreBind -> (Subst, Maybe CoreBind)
+simple_opt_bind subst (Rec prs)
+ = (subst'', Just (Rec (reverse rev_prs')))
+ where
+ (subst', bndrs') = subst_opt_bndrs subst (map fst prs)
+ (subst'', rev_prs') = foldl do_pr (subst', []) (prs `zip` bndrs')
+ do_pr (subst, prs) ((b,r), b') = case simple_opt_pair subst b r of
+ Left subst' -> (subst', prs)
+ Right r' -> (subst, (b2,r'):prs)
+ where
+ b2 = add_info subst b b'
+
+simple_opt_bind subst (NonRec b r)
+ = case simple_opt_pair subst b r of
+ Left ext_subst -> (ext_subst, Nothing)
+ Right r' -> (subst', Just (NonRec b2 r'))
+ where
+ (subst', b') = subst_opt_bndr subst b
+ b2 = add_info subst' b b'
+
+----------------------
+simple_opt_pair :: Subst -> InVar -> InExpr -> Either Subst OutExpr
+ -- (simple_opt_pair subst in_var in_rhs)
+ -- either extends subst with (in_var -> out_rhs)
+ -- or return out_rhs for a binding out_var = out_rhs
+simple_opt_pair subst b r
+ | Type ty <- r -- let a::* = TYPE ty in <body>
+ = ASSERT( isTyCoVar b )
+ Left (extendTvSubst subst b (substTy subst ty))
+
+ | isId b -- let x = e in <body>
+ , safe_to_inline (idOccInfo b)
+ , isAlwaysActive (idInlineActivation b) -- Note [Inline prag in simplOpt]
+ , not (isStableUnfolding (idUnfolding b))
+ , not (isExportedId b)
+ = Left (extendIdSubst subst b r')
+
+ | otherwise
+ = Right r'
+ where
+ r' = simple_opt_expr subst r