- -- Substitute dicts in the LHS args, so that there
- -- aren't any lets getting in the way
- -- Note that we substitute the function too; we might have this as
- -- a LHS: let f71 = M.f Int in f71
- go env (Let (NonRec dict rhs) body)
- = go (extendVarEnv env dict (simpleSubst env rhs)) body
- go env body
- = case collectArgs (simpleSubst env body) of
- (Var fn, args) -> Just (fn, args)
- _ -> Nothing
-
-simpleSubst :: IdEnv CoreExpr -> CoreExpr -> CoreExpr
--- Similar to CoreSubst.substExpr, except that
--- (a) Takes no account of capture; at this point there is no shadowing
--- (b) Can have a GlobalId (imported) in its domain
--- (c) Ids only; no types are substituted
--- (d) Does not insist (as does CoreSubst.lookupIdSubst) that the
--- in-scope set mentions all LocalIds mentioned in the argument of the subst
---
--- (b) and (d) are the reasons we can't use CoreSubst
---
--- (I had a note that (b) is "no longer relevant", and indeed it doesn't
--- look relevant here. Perhaps there was another caller of simpleSubst.)
-
-simpleSubst subst expr
- = go expr
- where
- go (Var v) = lookupVarEnv subst v `orElse` Var v
- go (Cast e co) = Cast (go e) co
- go (Type ty) = Type ty
- go (Lit lit) = Lit lit
- go (App fun arg) = App (go fun) (go arg)
- go (Note note e) = Note note (go e)
- go (Lam bndr body) = Lam bndr (go body)
- go (Let (NonRec bndr rhs) body) = Let (NonRec bndr (go rhs)) (go body)
- go (Let (Rec pairs) body) = Let (Rec (mapSnd go pairs)) (go body)
- go (Case scrut bndr ty alts) = Case (go scrut) bndr ty
- [(c,bs,go r) | (c,bs,r) <- alts]
-
-addInlinePrags :: [LPrag] -> Id -> CoreExpr -> (Id,CoreExpr)
-addInlinePrags prags bndr rhs
- = case [inl | L _ (InlinePrag inl) <- prags] of
- [] -> (bndr, rhs)
- (inl:_) -> addInlineInfo inl bndr rhs
-
-addInlineInfo :: InlineSpec -> Id -> CoreExpr -> (Id,CoreExpr)
-addInlineInfo (Inline phase is_inline) bndr rhs
- = (attach_phase bndr phase, wrap_inline is_inline rhs)
- where
- attach_phase bndr phase
- | isAlwaysActive phase = bndr -- Default phase
- | otherwise = bndr `setInlinePragma` phase
-
- wrap_inline True body = mkInlineMe body
- wrap_inline False body = body
+ (bndrs, body) = collectBinders (simpleOptExpr lhs)
+ -- simpleOptExpr occurrence-analyses and simplifies the lhs
+ -- and thereby
+ -- (a) identifies unused binders: Note [Unused spec binders]
+ -- (b) sorts dict bindings into NonRecs
+ -- so they can be inlined by 'decomp'
+ -- (c) substitute trivial lets so that they don't get in the way
+ -- Note that we substitute the function too; we might
+ -- have this as a LHS: let f71 = M.f Int in f71
+ -- NB: tcSimplifyRuleLhs is very careful not to generate complicated
+ -- dictionary expressions that we might have to match