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, CheapFun, etaExpand
15 #include "HsVersions.h"
26 import TyCon ( isRecursiveTyCon, isClassTyCon )
35 %************************************************************************
37 manifestArity and exprArity
39 %************************************************************************
41 exprArity is a cheap-and-cheerful version of exprEtaExpandArity.
42 It tells how many things the expression can be applied to before doing
43 any work. It doesn't look inside cases, lets, etc. The idea is that
44 exprEtaExpandArity will do the hard work, leaving something that's easy
45 for exprArity to grapple with. In particular, Simplify uses exprArity to
46 compute the ArityInfo for the Id.
48 Originally I thought that it was enough just to look for top-level lambdas, but
49 it isn't. I've seen this
51 foo = PrelBase.timesInt
53 We want foo to get arity 2 even though the eta-expander will leave it
54 unchanged, in the expectation that it'll be inlined. But occasionally it
55 isn't, because foo is blacklisted (used in a rule).
57 Similarly, see the ok_note check in exprEtaExpandArity. So
58 f = __inline_me (\x -> e)
59 won't be eta-expanded.
61 And in any case it seems more robust to have exprArity be a bit more intelligent.
62 But note that (\x y z -> f x y z)
63 should have arity 3, regardless of f's arity.
66 manifestArity :: CoreExpr -> Arity
67 -- ^ manifestArity sees how many leading value lambdas there are
68 manifestArity (Lam v e) | isId v = 1 + manifestArity e
69 | otherwise = manifestArity e
70 manifestArity (Note n e) | notSccNote n = manifestArity e
71 manifestArity (Cast e _) = manifestArity e
75 exprArity :: CoreExpr -> Arity
76 -- ^ An approximate, fast, version of 'exprEtaExpandArity'
79 go (Var v) = idArity v
80 go (Lam x e) | isId x = go e + 1
82 go (Note n e) | notSccNote n = go e
83 go (Cast e co) = go e `min` length (typeArity (pSnd (coercionKind co)))
84 -- Note [exprArity invariant]
85 go (App e (Type _)) = go e
86 go (App f a) | exprIsTrivial a = (go f - 1) `max` 0
87 -- See Note [exprArity for applications]
88 -- NB: coercions count as a value argument
94 typeArity :: Type -> [OneShot]
95 -- How many value arrows are visible in the type?
96 -- We look through foralls, and newtypes
97 -- See Note [exprArity invariant]
99 | Just (_, ty') <- splitForAllTy_maybe ty
102 | Just (arg,res) <- splitFunTy_maybe ty
103 = isStateHackType arg : typeArity res
105 | Just (tc,tys) <- splitTyConApp_maybe ty
106 , Just (ty', _) <- instNewTyCon_maybe tc tys
107 , not (isRecursiveTyCon tc)
108 , not (isClassTyCon tc) -- Do not eta-expand through newtype classes
109 -- See Note [Newtype classes and eta expansion]
111 -- Important to look through non-recursive newtypes, so that, eg
112 -- (f x) where f has arity 2, f :: Int -> IO ()
113 -- Here we want to get arity 1 for the result!
119 exprBotStrictness_maybe :: CoreExpr -> Maybe (Arity, StrictSig)
120 -- A cheap and cheerful function that identifies bottoming functions
121 -- and gives them a suitable strictness signatures. It's used during
123 exprBotStrictness_maybe e
124 = case getBotArity (arityType is_cheap e) of
126 Just ar -> Just (ar, mkStrictSig (mkTopDmdType (replicate ar topDmd) BotRes))
128 is_cheap _ _ = False -- Irrelevant for this purpose
131 Note [exprArity invariant]
132 ~~~~~~~~~~~~~~~~~~~~~~~~~~
133 exprArity has the following invariant:
135 * If typeArity (exprType e) = n,
136 then manifestArity (etaExpand e n) = n
138 That is, etaExpand can always expand as much as typeArity says
139 So the case analysis in etaExpand and in typeArity must match
141 * exprArity e <= typeArity (exprType e)
143 * Hence if (exprArity e) = n, then manifestArity (etaExpand e n) = n
145 That is, if exprArity says "the arity is n" then etaExpand really
146 can get "n" manifest lambdas to the top.
148 Why is this important? Because
149 - In TidyPgm we use exprArity to fix the *final arity* of
150 each top-level Id, and in
151 - In CorePrep we use etaExpand on each rhs, so that the visible lambdas
152 actually match that arity, which in turn means
153 that the StgRhs has the right number of lambdas
155 An alternative would be to do the eta-expansion in TidyPgm, at least
156 for top-level bindings, in which case we would not need the trim_arity
157 in exprArity. That is a less local change, so I'm going to leave it for today!
159 Note [Newtype classes and eta expansion]
160 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
161 We have to be careful when eta-expanding through newtypes. In general
162 it's a good idea, but annoyingly it interacts badly with the class-op
163 rule mechanism. Consider
165 class C a where { op :: a -> a }
166 instance C b => C [b] where
171 co :: forall a. (a->a) ~ C a
173 $copList :: C b -> [b] -> [b]
176 $dfList :: C b -> C [b]
177 {-# DFunUnfolding = [$copList] #-}
178 $dfList d = $copList d |> co@[b]
184 blah :: [Int] -> [Int]
185 blah = op ($dfList dCInt)
187 Now we want the built-in op/$dfList rule will fire to give
188 blah = $copList dCInt
190 But with eta-expansion 'blah' might (and in Trac #3772, which is
191 slightly more complicated, does) turn into
193 blah = op (\eta. ($dfList dCInt |> sym co) eta)
195 and now it is *much* harder for the op/$dfList rule to fire, becuase
196 exprIsConApp_maybe won't hold of the argument to op. I considered
197 trying to *make* it hold, but it's tricky and I gave up.
199 The test simplCore/should_compile/T3722 is an excellent example.
202 Note [exprArity for applications]
203 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
204 When we come to an application we check that the arg is trivial.
205 eg f (fac x) does not have arity 2,
206 even if f has arity 3!
208 * We require that is trivial rather merely cheap. Suppose f has arity 2.
210 has arity 0, because if we gave it arity 1 and then inlined f we'd get
211 let v = Just y in \w. <f-body>
212 which has arity 0. And we try to maintain the invariant that we don't
213 have arity decreases.
215 * The `max 0` is important! (\x y -> f x) has arity 2, even if f is
216 unknown, hence arity 0
219 %************************************************************************
221 Computing the "arity" of an expression
223 %************************************************************************
225 Note [Definition of arity]
226 ~~~~~~~~~~~~~~~~~~~~~~~~~~
227 The "arity" of an expression 'e' is n if
228 applying 'e' to *fewer* than n *value* arguments
231 Or, to put it another way
233 there is no work lost in duplicating the partial
234 application (e x1 .. x(n-1))
236 In the divegent case, no work is lost by duplicating because if the thing
237 is evaluated once, that's the end of the program.
239 Or, to put it another way, in any context C
241 C[ (\x1 .. xn. e x1 .. xn) ]
245 It's all a bit more subtle than it looks:
247 Note [Arity of case expressions]
248 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
249 We treat the arity of
250 case x of p -> \s -> ...
251 as 1 (or more) because for I/O ish things we really want to get that
252 \s to the top. We are prepared to evaluate x each time round the loop
253 in order to get that.
255 This isn't really right in the presence of seq. Consider
259 Can we eta-expand here? At first the answer looks like "yes of course", but
262 This should diverge! But if we eta-expand, it won't. Again, we ignore this
263 "problem", because being scrupulous would lose an important transformation for
266 1. Note [One-shot lambdas]
267 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
268 Consider one-shot lambdas
269 let x = expensive in \y z -> E
270 We want this to have arity 1 if the \y-abstraction is a 1-shot lambda.
272 3. Note [Dealing with bottom]
273 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
275 f = \x -> error "foo"
276 Here, arity 1 is fine. But if it is
280 then we want to get arity 2. Technically, this isn't quite right, because
282 should diverge, but it'll converge if we eta-expand f. Nevertheless, we
283 do so; it improves some programs significantly, and increasing convergence
284 isn't a bad thing. Hence the ABot/ATop in ArityType.
286 4. Note [Newtype arity]
287 ~~~~~~~~~~~~~~~~~~~~~~~~
288 Non-recursive newtypes are transparent, and should not get in the way.
289 We do (currently) eta-expand recursive newtypes too. So if we have, say
291 newtype T = MkT ([T] -> Int)
295 where f has arity 1. Then: etaExpandArity e = 1;
296 that is, etaExpandArity looks through the coerce.
298 When we eta-expand e to arity 1: eta_expand 1 e T
299 we want to get: coerce T (\x::[T] -> (coerce ([T]->Int) e) x)
301 HOWEVER, note that if you use coerce bogusly you can ge
303 And since negate has arity 2, you might try to eta expand. But you can't
304 decopose Int to a function type. Hence the final case in eta_expand.
306 Note [The state-transformer hack]
307 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
310 where e has arity n. Then, if we know from the context that f has
312 t1 -> ... -> tn -1-> t(n+1) -1-> ... -1-> tm -> ...
313 then we can expand the arity to m. This usage type says that
314 any application (x e1 .. en) will be applied to uniquely to (m-n) more args
315 Consider f = \x. let y = <expensive>
318 False -> \(s:RealWorld) -> e
319 where foo has arity 1. Then we want the state hack to
320 apply to foo too, so we can eta expand the case.
322 Then we expect that if f is applied to one arg, it'll be applied to two
323 (that's the hack -- we don't really know, and sometimes it's false)
324 See also Id.isOneShotBndr.
326 Note [State hack and bottoming functions]
327 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
328 It's a terrible idea to use the state hack on a bottoming function.
329 Here's what happens (Trac #2861):
334 Eta-expand, using the state hack:
336 f = \p. (\s. ((error "...") |> g1) s) |> g2
337 g1 :: IO T ~ (S -> (S,T))
338 g2 :: (S -> (S,T)) ~ IO T
342 f' = \p. \s. ((error "...") |> g1) s
343 f = f' |> (String -> g2)
345 Discard args for bottomming function
347 f' = \p. \s. ((error "...") |> g1 |> g3
348 g3 :: (S -> (S,T)) ~ (S,T)
352 f'' = \p. \s. (error "...")
353 f' = f'' |> (String -> S -> g1.g3)
355 And now we can repeat the whole loop. Aargh! The bug is in applying the
356 state hack to a function which then swallows the argument.
358 This arose in another guise in Trac #3959. Here we had
360 catch# (throw exn >> return ())
362 Note that (throw :: forall a e. Exn e => e -> a) is called with [a = IO ()].
363 After inlining (>>) we get
365 catch# (\_. throw {IO ()} exn)
367 We must *not* eta-expand to
369 catch# (\_ _. throw {...} exn)
371 because 'catch#' expects to get a (# _,_ #) after applying its argument to
372 a State#, not another function!
374 In short, we use the state hack to allow us to push let inside a lambda,
375 but not to introduce a new lambda.
380 ArityType is the result of a compositional analysis on expressions,
381 from which we can decide the real arity of the expression (extracted
382 with function exprEtaExpandArity).
384 Here is what the fields mean. If an arbitrary expression 'f' has
387 * If at = ABot n, then (f x1..xn) definitely diverges. Partial
388 applications to fewer than n args may *or may not* diverge.
390 We allow ourselves to eta-expand bottoming functions, even
391 if doing so may lose some `seq` sharing,
392 let x = <expensive> in \y. error (g x y)
393 ==> \y. let x = <expensive> in error (g x y)
395 * If at = ATop as, and n=length as,
396 then expanding 'f' to (\x1..xn. f x1 .. xn) loses no sharing,
397 assuming the calls of f respect the one-shot-ness of of
400 NB 'f' is an arbitary expression, eg (f = g e1 e2). This 'f'
401 can have ArityType as ATop, with length as > 0, only if e1 e2 are
404 * In both cases, f, (f x1), ... (f x1 ... f(n-1)) are definitely
405 really functions, or bottom, but *not* casts from a data type, in
406 at least one case branch. (If it's a function in one case branch but
407 an unsafe cast from a data type in another, the program is bogus.)
408 So eta expansion is dynamically ok; see Note [State hack and
409 bottoming functions], the part about catch#
412 f = \x\y. let v = <expensive> in
413 \s(one-shot) \t(one-shot). blah
414 'f' has ArityType [ManyShot,ManyShot,OneShot,OneShot]
415 The one-shot-ness means we can, in effect, push that
416 'let' inside the \st.
420 Then f :: AT [False,False] ATop
421 f v :: AT [False] ATop
422 f <expensive> :: AT [] ATop
424 -------------------- Main arity code ----------------------------
426 -- See Note [ArityType]
427 data ArityType = ATop [OneShot] | ABot Arity
428 -- There is always an explicit lambda
429 -- to justify the [OneShot], or the Arity
431 type OneShot = Bool -- False <=> Know nothing
432 -- True <=> Can definitely float inside this lambda
433 -- The 'True' case can arise either because a binder
434 -- is marked one-shot, or because it's a state lambda
435 -- and we have the state hack on
437 vanillaArityType :: ArityType
438 vanillaArityType = ATop [] -- Totally uninformative
440 -- ^ The Arity returned is the number of value args the [_$_]
441 -- expression can be applied to without doing much work
442 exprEtaExpandArity :: CheapFun -> CoreExpr -> Arity
443 -- exprEtaExpandArity is used when eta expanding
444 -- e ==> \xy -> e x y
445 exprEtaExpandArity cheap_fun e
446 = case (arityType cheap_fun e) of
448 | os || has_lam e -> 1 + length oss -- Note [Eta expanding thunks]
453 has_lam (Note _ e) = has_lam e
454 has_lam (Lam b e) = isId b || has_lam e
457 getBotArity :: ArityType -> Maybe Arity
458 -- Arity of a divergent function
459 getBotArity (ABot n) = Just n
460 getBotArity _ = Nothing
463 Note [Eta expanding thunks]
464 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
466 f = case y of p -> \x -> blah
467 should we eta-expand it? Well, if 'x' is a one-shot state token
468 then 'yes' because 'f' will only be applied once. But otherwise
469 we (conservatively) say no. My main reason is to avoid expanding
471 f = g d ==> f = \x. g d x
472 because that might in turn make g inline (if it has an inline pragma),
473 which we might not want. After all, INLINE pragmas say "inline only
474 when saturate" so we don't want to be too gung-ho about saturating!
477 arityLam :: Id -> ArityType -> ArityType
478 arityLam id (ATop as) = ATop (isOneShotBndr id : as)
479 arityLam _ (ABot n) = ABot (n+1)
481 floatIn :: Bool -> ArityType -> ArityType
482 -- We have something like (let x = E in b),
483 -- where b has the given arity type.
484 floatIn _ (ABot n) = ABot n
485 floatIn True (ATop as) = ATop as
486 floatIn False (ATop as) = ATop (takeWhile id as)
487 -- If E is not cheap, keep arity only for one-shots
489 arityApp :: ArityType -> Bool -> ArityType
490 -- Processing (fun arg) where at is the ArityType of fun,
491 -- Knock off an argument and behave like 'let'
492 arityApp (ABot 0) _ = ABot 0
493 arityApp (ABot n) _ = ABot (n-1)
494 arityApp (ATop []) _ = ATop []
495 arityApp (ATop (_:as)) cheap = floatIn cheap (ATop as)
497 andArityType :: ArityType -> ArityType -> ArityType -- Used for branches of a 'case'
498 andArityType (ABot n1) (ABot n2)
500 andArityType (ATop as) (ABot _) = ATop as
501 andArityType (ABot _) (ATop bs) = ATop bs
502 andArityType (ATop as) (ATop bs) = ATop (as `combine` bs)
503 where -- See Note [Combining case branches]
504 combine (a:as) (b:bs) = (a && b) : combine as bs
505 combine [] bs = take_one_shots bs
506 combine as [] = take_one_shots as
508 take_one_shots [] = []
509 take_one_shots (one_shot : as)
510 | one_shot = True : take_one_shots as
514 Note [Combining case branches]
515 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
517 go = \x. let z = go e0
520 False -> \s(one-shot). e1
522 We *really* want to eta-expand go and go2.
523 When combining the barnches of the case we have
524 ATop [] `andAT` ATop [True]
525 and we want to get ATop [True]. But if the inner
526 lambda wasn't one-shot we don't want to do this.
527 (We need a proper arity analysis to justify that.)
531 ---------------------------
532 type CheapFun = CoreExpr -> Maybe Type -> Bool
533 -- How to decide if an expression is cheap
534 -- If the Maybe is Just, the type is the type
535 -- of the expression; Nothing means "don't know"
537 arityType :: CheapFun -> CoreExpr -> ArityType
539 | Just strict_sig <- idStrictness_maybe v
540 , (ds, res) <- splitStrictSig strict_sig
541 , let arity = length ds
542 = if isBotRes res then ABot arity
543 else ATop (take arity one_shots)
545 = ATop (take (idArity v) one_shots)
547 one_shots :: [Bool] -- One-shot-ness derived from the type
548 one_shots = typeArity (idType v)
550 -- Lambdas; increase arity
551 arityType cheap_fn (Lam x e)
552 | isId x = arityLam x (arityType cheap_fn e)
553 | otherwise = arityType cheap_fn e
555 -- Applications; decrease arity, except for types
556 arityType cheap_fn (App fun (Type _))
557 = arityType cheap_fn fun
558 arityType cheap_fn (App fun arg )
559 = arityApp (arityType cheap_fn fun) (cheap_fn arg Nothing)
561 -- Case/Let; keep arity if either the expression is cheap
562 -- or it's a 1-shot lambda
563 -- The former is not really right for Haskell
564 -- f x = case x of { (a,b) -> \y. e }
566 -- f x y = case x of { (a,b) -> e }
567 -- The difference is observable using 'seq'
568 arityType cheap_fn (Case scrut bndr _ alts)
569 = floatIn (cheap_fn scrut (Just (idType bndr)))
570 (foldr1 andArityType [arityType cheap_fn rhs | (_,_,rhs) <- alts])
572 arityType cheap_fn (Let b e)
573 = floatIn (cheap_bind b) (arityType cheap_fn e)
575 cheap_bind (NonRec b e) = is_cheap (b,e)
576 cheap_bind (Rec prs) = all is_cheap prs
577 is_cheap (b,e) = cheap_fn e (Just (idType b))
579 arityType cheap_fn (Note n e)
580 | notSccNote n = arityType cheap_fn e
581 arityType cheap_fn (Cast e _) = arityType cheap_fn e
582 arityType _ _ = vanillaArityType
586 %************************************************************************
588 The main eta-expander
590 %************************************************************************
593 f = \x1..xn -> N ==> f = \x1..xn y1..ym -> N y1..ym
596 where (in both cases)
598 * The xi can include type variables
600 * The yi are all value variables
602 * N is a NORMAL FORM (i.e. no redexes anywhere)
603 wanting a suitable number of extra args.
605 The biggest reason for doing this is for cases like
611 Here we want to get the lambdas together. A good exmaple is the nofib
612 program fibheaps, which gets 25% more allocation if you don't do this
615 We may have to sandwich some coerces between the lambdas
616 to make the types work. exprEtaExpandArity looks through coerces
617 when computing arity; and etaExpand adds the coerces as necessary when
618 actually computing the expansion.
621 Note [No crap in eta-expanded code]
622 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
623 The eta expander is careful not to introduce "crap". In particular,
624 given a CoreExpr satisfying the 'CpeRhs' invariant (in CorePrep), it
625 returns a CoreExpr satisfying the same invariant. See Note [Eta
626 expansion and the CorePrep invariants] in CorePrep.
628 This means the eta-expander has to do a bit of on-the-fly
629 simplification but it's not too hard. The alernative, of relying on
630 a subsequent clean-up phase of the Simplifier to de-crapify the result,
631 means you can't really use it in CorePrep, which is painful.
633 Note [Eta expansion and SCCs]
634 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
635 Note that SCCs are not treated specially by etaExpand. If we have
636 etaExpand 2 (\x -> scc "foo" e)
637 = (\xy -> (scc "foo" e) y)
638 So the costs of evaluating 'e' (not 'e y') are attributed to "foo"
641 -- | @etaExpand n us e ty@ returns an expression with
642 -- the same meaning as @e@, but with arity @n@.
646 -- > e' = etaExpand n us e ty
648 -- We should have that:
650 -- > ty = exprType e = exprType e'
651 etaExpand :: Arity -- ^ Result should have this number of value args
652 -> CoreExpr -- ^ Expression to expand
654 -- etaExpand deals with for-alls. For example:
656 -- where E :: forall a. a -> a
658 -- (/\b. \y::a -> E b y)
660 -- It deals with coerces too, though they are now rare
661 -- so perhaps the extra code isn't worth it
663 etaExpand n orig_expr
666 -- Strip off existing lambdas and casts
667 -- Note [Eta expansion and SCCs]
669 go n (Lam v body) | isTyVar v = Lam v (go n body)
670 | otherwise = Lam v (go (n-1) body)
671 go n (Cast expr co) = Cast (go n expr) co
672 go n expr = -- pprTrace "ee" (vcat [ppr orig_expr, ppr expr, ppr etas]) $
673 etaInfoAbs etas (etaInfoApp subst' expr etas)
675 in_scope = mkInScopeSet (exprFreeVars expr)
676 (in_scope', etas) = mkEtaWW n orig_expr in_scope (exprType expr)
677 subst' = mkEmptySubst in_scope'
681 data EtaInfo = EtaVar Var -- /\a. [], [] a
683 | EtaCo Coercion -- [] |> co, [] |> (sym co)
685 instance Outputable EtaInfo where
686 ppr (EtaVar v) = ptext (sLit "EtaVar") <+> ppr v
687 ppr (EtaCo co) = ptext (sLit "EtaCo") <+> ppr co
689 pushCoercion :: Coercion -> [EtaInfo] -> [EtaInfo]
690 pushCoercion co1 (EtaCo co2 : eis)
692 | otherwise = EtaCo co : eis
694 co = co1 `mkTransCo` co2
696 pushCoercion co eis = EtaCo co : eis
699 etaInfoAbs :: [EtaInfo] -> CoreExpr -> CoreExpr
700 etaInfoAbs [] expr = expr
701 etaInfoAbs (EtaVar v : eis) expr = Lam v (etaInfoAbs eis expr)
702 etaInfoAbs (EtaCo co : eis) expr = Cast (etaInfoAbs eis expr) (mkSymCo co)
705 etaInfoApp :: Subst -> CoreExpr -> [EtaInfo] -> CoreExpr
706 -- (etaInfoApp s e eis) returns something equivalent to
707 -- ((substExpr s e) `appliedto` eis)
709 etaInfoApp subst (Lam v1 e) (EtaVar v2 : eis)
710 = etaInfoApp (CoreSubst.extendSubstWithVar subst v1 v2) e eis
712 etaInfoApp subst (Cast e co1) eis
713 = etaInfoApp subst e (pushCoercion co' eis)
715 co' = CoreSubst.substCo subst co1
717 etaInfoApp subst (Case e b _ alts) eis
718 = Case (subst_expr subst e) b1 (coreAltsType alts') alts'
720 (subst1, b1) = substBndr subst b
721 alts' = map subst_alt alts
722 subst_alt (con, bs, rhs) = (con, bs', etaInfoApp subst2 rhs eis)
724 (subst2,bs') = substBndrs subst1 bs
726 etaInfoApp subst (Let b e) eis
727 = Let b' (etaInfoApp subst' e eis)
729 (subst', b') = subst_bind subst b
731 etaInfoApp subst (Note note e) eis
732 = Note note (etaInfoApp subst e eis)
734 etaInfoApp subst e eis
735 = go (subst_expr subst e) eis
738 go e (EtaVar v : eis) = go (App e (varToCoreExpr v)) eis
739 go e (EtaCo co : eis) = go (Cast e co) eis
742 mkEtaWW :: Arity -> CoreExpr -> InScopeSet -> Type
743 -> (InScopeSet, [EtaInfo])
744 -- EtaInfo contains fresh variables,
745 -- not free in the incoming CoreExpr
746 -- Outgoing InScopeSet includes the EtaInfo vars
747 -- and the original free vars
749 mkEtaWW orig_n orig_expr in_scope orig_ty
750 = go orig_n empty_subst orig_ty []
752 empty_subst = TvSubst in_scope emptyTvSubstEnv
754 go n subst ty eis -- See Note [exprArity invariant]
756 = (getTvInScope subst, reverse eis)
758 | Just (tv,ty') <- splitForAllTy_maybe ty
759 , let (subst', tv') = Type.substTyVarBndr subst tv
760 -- Avoid free vars of the original expression
761 = go n subst' ty' (EtaVar tv' : eis)
763 | Just (arg_ty, res_ty) <- splitFunTy_maybe ty
764 , let (subst', eta_id') = freshEtaId n subst arg_ty
765 -- Avoid free vars of the original expression
766 = go (n-1) subst' res_ty (EtaVar eta_id' : eis)
768 | Just(ty',co) <- splitNewTypeRepCo_maybe ty
770 -- newtype T = MkT ([T] -> Int)
771 -- Consider eta-expanding this
774 -- coerce T (\x::[T] -> (coerce ([T]->Int) e) x)
775 go n subst ty' (EtaCo co : eis)
777 | otherwise -- We have an expression of arity > 0,
778 -- but its type isn't a function.
779 = WARN( True, (ppr orig_n <+> ppr orig_ty) $$ ppr orig_expr )
780 (getTvInScope subst, reverse eis)
781 -- This *can* legitmately happen:
782 -- e.g. coerce Int (\x. x) Essentially the programmer is
783 -- playing fast and loose with types (Happy does this a lot).
784 -- So we simply decline to eta-expand. Otherwise we'd end up
785 -- with an explicit lambda having a non-function type
789 -- Avoiding unnecessary substitution; use short-cutting versions
791 subst_expr :: Subst -> CoreExpr -> CoreExpr
792 subst_expr = substExprSC (text "CoreArity:substExpr")
794 subst_bind :: Subst -> CoreBind -> (Subst, CoreBind)
795 subst_bind = substBindSC
799 freshEtaId :: Int -> TvSubst -> Type -> (TvSubst, Id)
800 -- Make a fresh Id, with specified type (after applying substitution)
801 -- It should be "fresh" in the sense that it's not in the in-scope set
802 -- of the TvSubstEnv; and it should itself then be added to the in-scope
803 -- set of the TvSubstEnv
805 -- The Int is just a reasonable starting point for generating a unique;
806 -- it does not necessarily have to be unique itself.
807 freshEtaId n subst ty
810 ty' = Type.substTy subst ty
811 eta_id' = uniqAway (getTvInScope subst) $
812 mkSysLocal (fsLit "eta") (mkBuiltinUnique n) ty'
813 subst' = extendTvInScope subst eta_id'