2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 Arity and ete expansion
9 -- | Arit and eta expansion
11 manifestArity, exprArity, exprBotStrictness_maybe,
12 exprEtaExpandArity, etaExpand
15 #include "HsVersions.h"
26 import TyCon ( isRecursiveTyCon, isClassTyCon )
27 import TcType ( isDictLikeTy )
36 %************************************************************************
38 manifestArity and exprArity
40 %************************************************************************
42 exprArity is a cheap-and-cheerful version of exprEtaExpandArity.
43 It tells how many things the expression can be applied to before doing
44 any work. It doesn't look inside cases, lets, etc. The idea is that
45 exprEtaExpandArity will do the hard work, leaving something that's easy
46 for exprArity to grapple with. In particular, Simplify uses exprArity to
47 compute the ArityInfo for the Id.
49 Originally I thought that it was enough just to look for top-level lambdas, but
50 it isn't. I've seen this
52 foo = PrelBase.timesInt
54 We want foo to get arity 2 even though the eta-expander will leave it
55 unchanged, in the expectation that it'll be inlined. But occasionally it
56 isn't, because foo is blacklisted (used in a rule).
58 Similarly, see the ok_note check in exprEtaExpandArity. So
59 f = __inline_me (\x -> e)
60 won't be eta-expanded.
62 And in any case it seems more robust to have exprArity be a bit more intelligent.
63 But note that (\x y z -> f x y z)
64 should have arity 3, regardless of f's arity.
67 manifestArity :: CoreExpr -> Arity
68 -- ^ manifestArity sees how many leading value lambdas there are
69 manifestArity (Lam v e) | isId v = 1 + manifestArity e
70 | otherwise = manifestArity e
71 manifestArity (Note n e) | notSccNote n = manifestArity e
72 manifestArity (Cast e _) = manifestArity e
76 exprArity :: CoreExpr -> Arity
77 -- ^ An approximate, fast, version of 'exprEtaExpandArity'
80 go (Var v) = idArity v
81 go (Lam x e) | isId x = go e + 1
83 go (Note n e) | notSccNote n = go e
84 go (Cast e co) = go e `min` length (typeArity (snd (coercionKind co)))
85 -- Note [exprArity invariant]
86 go (App e (Type _)) = go e
87 go (App f a) | exprIsTrivial a = (go f - 1) `max` 0
88 -- See Note [exprArity for applications]
93 typeArity :: Type -> [OneShot]
94 -- How many value arrows are visible in the type?
95 -- We look through foralls, and newtypes
96 -- See Note [exprArity invariant]
98 | Just (_, ty') <- splitForAllTy_maybe ty
101 | Just (arg,res) <- splitFunTy_maybe ty
102 = isStateHackType arg : typeArity res
104 | Just (tc,tys) <- splitTyConApp_maybe ty
105 , Just (ty', _) <- instNewTyCon_maybe tc tys
106 , not (isRecursiveTyCon tc)
107 , not (isClassTyCon tc) -- Do not eta-expand through newtype classes
108 -- See Note [Newtype classes and eta expansion]
110 -- Important to look through non-recursive newtypes, so that, eg
111 -- (f x) where f has arity 2, f :: Int -> IO ()
112 -- Here we want to get arity 1 for the result!
118 exprBotStrictness_maybe :: CoreExpr -> Maybe (Arity, StrictSig)
119 -- A cheap and cheerful function that identifies bottoming functions
120 -- and gives them a suitable strictness signatures. It's used during
122 exprBotStrictness_maybe e
123 = case getBotArity (arityType False e) of
125 Just ar -> Just (ar, mkStrictSig (mkTopDmdType (replicate ar topDmd) BotRes))
128 Note [exprArity invariant]
129 ~~~~~~~~~~~~~~~~~~~~~~~~~~
130 exprArity has the following invariant:
132 * If typeArity (exprType e) = n,
133 then manifestArity (etaExpand e n) = n
135 That is, etaExpand can always expand as much as typeArity says
136 So the case analysis in etaExpand and in typeArity must match
138 * exprArity e <= typeArity (exprType e)
140 * Hence if (exprArity e) = n, then manifestArity (etaExpand e n) = n
142 That is, if exprArity says "the arity is n" then etaExpand really
143 can get "n" manifest lambdas to the top.
145 Why is this important? Because
146 - In TidyPgm we use exprArity to fix the *final arity* of
147 each top-level Id, and in
148 - In CorePrep we use etaExpand on each rhs, so that the visible lambdas
149 actually match that arity, which in turn means
150 that the StgRhs has the right number of lambdas
152 An alternative would be to do the eta-expansion in TidyPgm, at least
153 for top-level bindings, in which case we would not need the trim_arity
154 in exprArity. That is a less local change, so I'm going to leave it for today!
156 Note [Newtype classes and eta expansion]
157 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
158 We have to be careful when eta-expanding through newtypes. In general
159 it's a good idea, but annoyingly it interacts badly with the class-op
160 rule mechanism. Consider
162 class C a where { op :: a -> a }
163 instance C b => C [b] where
168 co :: forall a. (a->a) ~ C a
170 $copList :: C b -> [b] -> [b]
173 $dfList :: C b -> C [b]
174 {-# DFunUnfolding = [$copList] #-}
175 $dfList d = $copList d |> co@[b]
181 blah :: [Int] -> [Int]
182 blah = op ($dfList dCInt)
184 Now we want the built-in op/$dfList rule will fire to give
185 blah = $copList dCInt
187 But with eta-expansion 'blah' might (and in Trac #3772, which is
188 slightly more complicated, does) turn into
190 blah = op (\eta. ($dfList dCInt |> sym co) eta)
192 and now it is *much* harder for the op/$dfList rule to fire, becuase
193 exprIsConApp_maybe won't hold of the argument to op. I considered
194 trying to *make* it hold, but it's tricky and I gave up.
196 The test simplCore/should_compile/T3722 is an excellent example.
199 Note [exprArity for applications]
200 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
201 When we come to an application we check that the arg is trivial.
202 eg f (fac x) does not have arity 2,
203 even if f has arity 3!
205 * We require that is trivial rather merely cheap. Suppose f has arity 2.
207 has arity 0, because if we gave it arity 1 and then inlined f we'd get
208 let v = Just y in \w. <f-body>
209 which has arity 0. And we try to maintain the invariant that we don't
210 have arity decreases.
212 * The `max 0` is important! (\x y -> f x) has arity 2, even if f is
213 unknown, hence arity 0
216 %************************************************************************
218 Computing the "arity" of an expression
220 %************************************************************************
222 Note [Definition of arity]
223 ~~~~~~~~~~~~~~~~~~~~~~~~~~
224 The "arity" of an expression 'e' is n if
225 applying 'e' to *fewer* than n *value* arguments
228 Or, to put it another way
230 there is no work lost in duplicating the partial
231 application (e x1 .. x(n-1))
233 In the divegent case, no work is lost by duplicating because if the thing
234 is evaluated once, that's the end of the program.
236 Or, to put it another way, in any context C
238 C[ (\x1 .. xn. e x1 .. xn) ]
242 It's all a bit more subtle than it looks:
244 Note [Arity of case expressions]
245 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
246 We treat the arity of
247 case x of p -> \s -> ...
248 as 1 (or more) because for I/O ish things we really want to get that
249 \s to the top. We are prepared to evaluate x each time round the loop
250 in order to get that.
252 This isn't really right in the presence of seq. Consider
256 Can we eta-expand here? At first the answer looks like "yes of course", but
259 This should diverge! But if we eta-expand, it won't. Again, we ignore this
260 "problem", because being scrupulous would lose an important transformation for
263 1. Note [One-shot lambdas]
264 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
265 Consider one-shot lambdas
266 let x = expensive in \y z -> E
267 We want this to have arity 1 if the \y-abstraction is a 1-shot lambda.
269 3. Note [Dealing with bottom]
270 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
272 f = \x -> error "foo"
273 Here, arity 1 is fine. But if it is
277 then we want to get arity 2. Technically, this isn't quite right, because
279 should diverge, but it'll converge if we eta-expand f. Nevertheless, we
280 do so; it improves some programs significantly, and increasing convergence
281 isn't a bad thing. Hence the ABot/ATop in ArityType.
283 4. Note [Newtype arity]
284 ~~~~~~~~~~~~~~~~~~~~~~~~
285 Non-recursive newtypes are transparent, and should not get in the way.
286 We do (currently) eta-expand recursive newtypes too. So if we have, say
288 newtype T = MkT ([T] -> Int)
292 where f has arity 1. Then: etaExpandArity e = 1;
293 that is, etaExpandArity looks through the coerce.
295 When we eta-expand e to arity 1: eta_expand 1 e T
296 we want to get: coerce T (\x::[T] -> (coerce ([T]->Int) e) x)
298 HOWEVER, note that if you use coerce bogusly you can ge
300 And since negate has arity 2, you might try to eta expand. But you can't
301 decopose Int to a function type. Hence the final case in eta_expand.
303 Note [The state-transformer hack]
304 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
307 where e has arity n. Then, if we know from the context that f has
309 t1 -> ... -> tn -1-> t(n+1) -1-> ... -1-> tm -> ...
310 then we can expand the arity to m. This usage type says that
311 any application (x e1 .. en) will be applied to uniquely to (m-n) more args
312 Consider f = \x. let y = <expensive>
315 False -> \(s:RealWorld) -> e
316 where foo has arity 1. Then we want the state hack to
317 apply to foo too, so we can eta expand the case.
319 Then we expect that if f is applied to one arg, it'll be applied to two
320 (that's the hack -- we don't really know, and sometimes it's false)
321 See also Id.isOneShotBndr.
323 Note [State hack and bottoming functions]
324 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
325 It's a terrible idea to use the state hack on a bottoming function.
326 Here's what happens (Trac #2861):
331 Eta-expand, using the state hack:
333 f = \p. (\s. ((error "...") |> g1) s) |> g2
334 g1 :: IO T ~ (S -> (S,T))
335 g2 :: (S -> (S,T)) ~ IO T
339 f' = \p. \s. ((error "...") |> g1) s
340 f = f' |> (String -> g2)
342 Discard args for bottomming function
344 f' = \p. \s. ((error "...") |> g1 |> g3
345 g3 :: (S -> (S,T)) ~ (S,T)
349 f'' = \p. \s. (error "...")
350 f' = f'' |> (String -> S -> g1.g3)
352 And now we can repeat the whole loop. Aargh! The bug is in applying the
353 state hack to a function which then swallows the argument.
355 This arose in another guise in Trac #3959. Here we had
357 catch# (throw exn >> return ())
359 Note that (throw :: forall a e. Exn e => e -> a) is called with [a = IO ()].
360 After inlining (>>) we get
362 catch# (\_. throw {IO ()} exn)
364 We must *not* eta-expand to
366 catch# (\_ _. throw {...} exn)
368 because 'catch#' expects to get a (# _,_ #) after applying its argument to
369 a State#, not another function!
371 In short, we use the state hack to allow us to push let inside a lambda,
372 but not to introduce a new lambda.
377 ArityType is the result of a compositional analysis on expressions,
378 from which we can decide the real arity of the expression (extracted
379 with function getArity).
381 Here is what the fields mean. If e has ArityType
382 (AT as r), where n = length as,
385 * If r is ABot then (e x1..xn) definitely diverges
386 Partial applications may or may not diverge
388 * If r is ACheap then (e x1..x(n-1)) is cheap,
389 including any nested sub-expressions inside e
390 (say e is (f e1 e2) then e1,e2 are cheap too)
392 * e, (e x1), ... (e x1 ... x(n-1)) are definitely really
393 functions, or bottom, not casts from a data type
394 So eta expansion is dynamically ok;
395 see Note [State hack and bottoming functions],
396 the part about catch#
398 We regard ABot as stronger than ACheap; ie if ABot holds
399 we don't bother about ACheap
402 Then f :: AT [False,False] ACheap
403 f v :: AT [False] ACheap
404 f <expensive> :: AT [False] ATop
405 Note the ArityRes flag tells whether the whole expression is cheap.
406 Note also that having a non-empty 'as' doesn't mean it has that
407 arity; see (f <expensive>) which does not have arity 1!
409 The key function getArity extracts the arity (which in turn guides
410 eta-expansion) from ArityType.
411 * If the term is cheap or diverges we can certainly eta expand it
412 e.g. (f x) where x has arity 2
414 * If its a function whose first arg is one-shot (probably via the
415 state hack) we can eta expand it
416 e.g. (getChar <expensive>)
418 -------------------- Main arity code ----------------------------
420 -- See Note [ArityType]
421 data ArityType = AT [OneShot] ArityRes
422 -- There is always an explicit lambda
423 -- to justify the [OneShot]
425 type OneShot = Bool -- False <=> Know nothing
426 -- True <=> Can definitely float inside this lambda
427 -- The 'True' case can arise either because a binder
428 -- is marked one-shot, or because it's a state lambda
429 -- and we have the state hack on
431 data ArityRes = ATop | ACheap | ABot
433 vanillaArityType :: ArityType
434 vanillaArityType = AT [] ATop -- Totally uninformative
436 -- ^ The Arity returned is the number of value args the [_$_]
437 -- expression can be applied to without doing much work
438 exprEtaExpandArity :: DynFlags -> CoreExpr -> Arity
439 -- exprEtaExpandArity is used when eta expanding
440 -- e ==> \xy -> e x y
441 exprEtaExpandArity dflags e
442 = case (arityType dicts_cheap e) of
443 AT (a:as) res | want_eta a res -> 1 + length as
446 want_eta one_shot ATop = one_shot
449 dicts_cheap = dopt Opt_DictsCheap dflags
451 getBotArity :: ArityType -> Maybe Arity
452 -- Arity of a divergent function
453 getBotArity (AT as ABot) = Just (length as)
454 getBotArity _ = Nothing
456 arityLam :: Id -> ArityType -> ArityType
457 arityLam id (AT as r) = AT (isOneShotBndr id : as) r
459 floatIn :: Bool -> ArityType -> ArityType
460 -- We have something like (let x = E in b),
461 -- where b has the given arity type.
462 floatIn c (AT as r) = AT as (extendArityRes r c)
464 arityApp :: ArityType -> CoreExpr -> ArityType
465 -- Processing (fun arg) where at is the ArityType of fun,
466 arityApp (AT [] r) arg = AT [] (extendArityRes r (exprIsCheap arg))
467 arityApp (AT (_:as) r) arg = AT as (extendArityRes r (exprIsCheap arg))
469 extendArityRes :: ArityRes -> Bool -> ArityRes
470 extendArityRes ABot _ = ABot
471 extendArityRes ACheap True = ACheap
472 extendArityRes _ _ = ATop
474 andArityType :: ArityType -> ArityType -> ArityType -- Used for branches of a 'case'
475 andArityType (AT as1 r1) (AT as2 r2)
476 = AT (go_as as1 as2) (go_r r1 r2)
478 go_r ABot ABot = ABot
479 go_r ABot ACheap = ACheap
480 go_r ACheap ABot = ACheap
481 go_r ACheap ACheap = ACheap
484 go_as (os1:as1) (os2:as2) = (os1 || os2) : go_as as1 as2
491 ---------------------------
492 arityType :: Bool -> CoreExpr -> ArityType
494 | Just strict_sig <- idStrictness_maybe v
495 , (ds, res) <- splitStrictSig strict_sig
496 = mk_arity (length ds) res
498 = mk_arity (idArity v) TopRes
501 mk_arity id_arity res
502 | isBotRes res = AT (take id_arity one_shots) ABot
503 | id_arity>0 = AT (take id_arity one_shots) ACheap
504 | otherwise = AT [] ATop
506 one_shots = typeArity (idType v)
508 -- Lambdas; increase arity
509 arityType dicts_cheap (Lam x e)
510 | isId x = arityLam x (arityType dicts_cheap e)
511 | otherwise = arityType dicts_cheap e
513 -- Applications; decrease arity
514 arityType dicts_cheap (App fun (Type _))
515 = arityType dicts_cheap fun
516 arityType dicts_cheap (App fun arg )
517 = arityApp (arityType dicts_cheap fun) arg
519 -- Case/Let; keep arity if either the expression is cheap
520 -- or it's a 1-shot lambda
521 -- The former is not really right for Haskell
522 -- f x = case x of { (a,b) -> \y. e }
524 -- f x y = case x of { (a,b) -> e }
525 -- The difference is observable using 'seq'
526 arityType dicts_cheap (Case scrut _ _ alts)
527 = floatIn (exprIsCheap scrut)
528 (foldr1 andArityType [arityType dicts_cheap rhs | (_,_,rhs) <- alts])
530 arityType dicts_cheap (Let b e)
531 = floatIn (cheap_bind b) (arityType dicts_cheap e)
533 cheap_bind (NonRec b e) = is_cheap (b,e)
534 cheap_bind (Rec prs) = all is_cheap prs
535 is_cheap (b,e) = (dicts_cheap && isDictLikeTy (idType b))
537 -- If the experimental -fdicts-cheap flag is on, we eta-expand through
538 -- dictionary bindings. This improves arities. Thereby, it also
539 -- means that full laziness is less prone to floating out the
540 -- application of a function to its dictionary arguments, which
541 -- can thereby lose opportunities for fusion. Example:
542 -- foo :: Ord a => a -> ...
543 -- foo = /\a \(d:Ord a). let d' = ...d... in \(x:a). ....
544 -- -- So foo has arity 1
546 -- f = \x. foo dInt $ bar x
548 -- The (foo DInt) is floated out, and makes ineffective a RULE
551 -- One could go further and make exprIsCheap reply True to any
552 -- dictionary-typed expression, but that's more work.
554 -- See Note [Dictionary-like types] in TcType.lhs for why we use
555 -- isDictLikeTy here rather than isDictTy
557 arityType dicts_cheap (Note n e)
558 | notSccNote n = arityType dicts_cheap e
559 arityType dicts_cheap (Cast e _) = arityType dicts_cheap e
560 arityType _ _ = vanillaArityType
564 %************************************************************************
566 The main eta-expander
568 %************************************************************************
571 f = \x1..xn -> N ==> f = \x1..xn y1..ym -> N y1..ym
574 where (in both cases)
576 * The xi can include type variables
578 * The yi are all value variables
580 * N is a NORMAL FORM (i.e. no redexes anywhere)
581 wanting a suitable number of extra args.
583 The biggest reason for doing this is for cases like
589 Here we want to get the lambdas together. A good exmaple is the nofib
590 program fibheaps, which gets 25% more allocation if you don't do this
593 We may have to sandwich some coerces between the lambdas
594 to make the types work. exprEtaExpandArity looks through coerces
595 when computing arity; and etaExpand adds the coerces as necessary when
596 actually computing the expansion.
599 Note [No crap in eta-expanded code]
600 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
601 The eta expander is careful not to introduce "crap". In particular,
602 given a CoreExpr satisfying the 'CpeRhs' invariant (in CorePrep), it
603 returns a CoreExpr satisfying the same invariant. See Note [Eta
604 expansion and the CorePrep invariants] in CorePrep.
606 This means the eta-expander has to do a bit of on-the-fly
607 simplification but it's not too hard. The alernative, of relying on
608 a subsequent clean-up phase of the Simplifier to de-crapify the result,
609 means you can't really use it in CorePrep, which is painful.
611 Note [Eta expansion and SCCs]
612 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
613 Note that SCCs are not treated specially by etaExpand. If we have
614 etaExpand 2 (\x -> scc "foo" e)
615 = (\xy -> (scc "foo" e) y)
616 So the costs of evaluating 'e' (not 'e y') are attributed to "foo"
619 -- | @etaExpand n us e ty@ returns an expression with
620 -- the same meaning as @e@, but with arity @n@.
624 -- > e' = etaExpand n us e ty
626 -- We should have that:
628 -- > ty = exprType e = exprType e'
629 etaExpand :: Arity -- ^ Result should have this number of value args
630 -> CoreExpr -- ^ Expression to expand
632 -- etaExpand deals with for-alls. For example:
634 -- where E :: forall a. a -> a
636 -- (/\b. \y::a -> E b y)
638 -- It deals with coerces too, though they are now rare
639 -- so perhaps the extra code isn't worth it
641 etaExpand n orig_expr
644 -- Strip off existing lambdas and casts
645 -- Note [Eta expansion and SCCs]
647 go n (Lam v body) | isTyCoVar v = Lam v (go n body)
648 | otherwise = Lam v (go (n-1) body)
649 go n (Cast expr co) = Cast (go n expr) co
650 go n expr = -- pprTrace "ee" (vcat [ppr orig_expr, ppr expr, ppr etas]) $
651 etaInfoAbs etas (etaInfoApp subst' expr etas)
653 in_scope = mkInScopeSet (exprFreeVars expr)
654 (in_scope', etas) = mkEtaWW n in_scope (exprType expr)
655 subst' = mkEmptySubst in_scope'
659 data EtaInfo = EtaVar Var -- /\a. [], [] a
661 | EtaCo Coercion -- [] |> co, [] |> (sym co)
663 instance Outputable EtaInfo where
664 ppr (EtaVar v) = ptext (sLit "EtaVar") <+> ppr v
665 ppr (EtaCo co) = ptext (sLit "EtaCo") <+> ppr co
667 pushCoercion :: Coercion -> [EtaInfo] -> [EtaInfo]
668 pushCoercion co1 (EtaCo co2 : eis)
669 | isIdentityCoercion co = eis
670 | otherwise = EtaCo co : eis
672 co = co1 `mkTransCoercion` co2
674 pushCoercion co eis = EtaCo co : eis
677 etaInfoAbs :: [EtaInfo] -> CoreExpr -> CoreExpr
678 etaInfoAbs [] expr = expr
679 etaInfoAbs (EtaVar v : eis) expr = Lam v (etaInfoAbs eis expr)
680 etaInfoAbs (EtaCo co : eis) expr = Cast (etaInfoAbs eis expr) (mkSymCoercion co)
683 etaInfoApp :: Subst -> CoreExpr -> [EtaInfo] -> CoreExpr
684 -- (etaInfoApp s e eis) returns something equivalent to
685 -- ((substExpr s e) `appliedto` eis)
687 etaInfoApp subst (Lam v1 e) (EtaVar v2 : eis)
688 = etaInfoApp subst' e eis
690 subst' | isTyCoVar v1 = CoreSubst.extendTvSubst subst v1 (mkTyVarTy v2)
691 | otherwise = CoreSubst.extendIdSubst subst v1 (Var v2)
693 etaInfoApp subst (Cast e co1) eis
694 = etaInfoApp subst e (pushCoercion co' eis)
696 co' = CoreSubst.substTy subst co1
698 etaInfoApp subst (Case e b _ alts) eis
699 = Case (subst_expr subst e) b1 (coreAltsType alts') alts'
701 (subst1, b1) = substBndr subst b
702 alts' = map subst_alt alts
703 subst_alt (con, bs, rhs) = (con, bs', etaInfoApp subst2 rhs eis)
705 (subst2,bs') = substBndrs subst1 bs
707 etaInfoApp subst (Let b e) eis
708 = Let b' (etaInfoApp subst' e eis)
710 (subst', b') = subst_bind subst b
712 etaInfoApp subst (Note note e) eis
713 = Note note (etaInfoApp subst e eis)
715 etaInfoApp subst e eis
716 = go (subst_expr subst e) eis
719 go e (EtaVar v : eis) = go (App e (varToCoreExpr v)) eis
720 go e (EtaCo co : eis) = go (Cast e co) eis
723 mkEtaWW :: Arity -> InScopeSet -> Type
724 -> (InScopeSet, [EtaInfo])
725 -- EtaInfo contains fresh variables,
726 -- not free in the incoming CoreExpr
727 -- Outgoing InScopeSet includes the EtaInfo vars
728 -- and the original free vars
730 mkEtaWW orig_n in_scope orig_ty
731 = go orig_n empty_subst orig_ty []
733 empty_subst = mkTvSubst in_scope emptyTvSubstEnv
735 go n subst ty eis -- See Note [exprArity invariant]
737 = (getTvInScope subst, reverse eis)
739 | Just (tv,ty') <- splitForAllTy_maybe ty
740 , let (subst', tv') = substTyVarBndr subst tv
741 -- Avoid free vars of the original expression
742 = go n subst' ty' (EtaVar tv' : eis)
744 | Just (arg_ty, res_ty) <- splitFunTy_maybe ty
745 , let (subst', eta_id') = freshEtaId n subst arg_ty
746 -- Avoid free vars of the original expression
747 = go (n-1) subst' res_ty (EtaVar eta_id' : eis)
749 | Just(ty',co) <- splitNewTypeRepCo_maybe ty
751 -- newtype T = MkT ([T] -> Int)
752 -- Consider eta-expanding this
755 -- coerce T (\x::[T] -> (coerce ([T]->Int) e) x)
756 go n subst ty' (EtaCo (Type.substTy subst co) : eis)
758 | otherwise -- We have an expression of arity > 0,
759 -- but its type isn't a function.
760 = WARN( True, ppr orig_n <+> ppr orig_ty )
761 (getTvInScope subst, reverse eis)
762 -- This *can* legitmately happen:
763 -- e.g. coerce Int (\x. x) Essentially the programmer is
764 -- playing fast and loose with types (Happy does this a lot).
765 -- So we simply decline to eta-expand. Otherwise we'd end up
766 -- with an explicit lambda having a non-function type
770 -- Avoiding unnecessary substitution; use short-cutting versions
772 subst_expr :: Subst -> CoreExpr -> CoreExpr
773 subst_expr = substExprSC (text "CoreArity:substExpr")
775 subst_bind :: Subst -> CoreBind -> (Subst, CoreBind)
776 subst_bind = substBindSC
780 freshEtaId :: Int -> TvSubst -> Type -> (TvSubst, Id)
781 -- Make a fresh Id, with specified type (after applying substitution)
782 -- It should be "fresh" in the sense that it's not in the in-scope set
783 -- of the TvSubstEnv; and it should itself then be added to the in-scope
784 -- set of the TvSubstEnv
786 -- The Int is just a reasonable starting point for generating a unique;
787 -- it does not necessarily have to be unique itself.
788 freshEtaId n subst ty
791 ty' = Type.substTy subst ty
792 eta_id' = uniqAway (getTvInScope subst) $
793 mkSysLocal (fsLit "eta") (mkBuiltinUnique n) ty'
794 subst' = extendTvInScope subst eta_id'