CoreArity.hs 42.6 KB
 Austin Seipp committed Dec 03, 2014 1 2 3 4 {- (c) The University of Glasgow 2006 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998  simonpj@microsoft.com committed Jan 13, 2009 5   Simon Peyton Jones committed Sep 26, 2014 6  Arity and eta expansion  Austin Seipp committed Dec 03, 2014 7 -}  simonpj@microsoft.com committed Jan 13, 2009 8   Herbert Valerio Riedel committed May 15, 2014 9 {-# LANGUAGE CPP #-}  Simon Peyton Jones committed Sep 26, 2014 10 11  -- | Arity and eta expansion  simonpj@microsoft.com committed Jan 13, 2009 12 module CoreArity (  Simon Peyton Jones committed Mar 17, 2017 13  manifestArity, joinRhsArity, exprArity, typeArity,  lukemaurer committed Feb 01, 2017 14  exprEtaExpandArity, findRhsArity, CheapFun, etaExpand,  Simon Peyton Jones committed Mar 17, 2017 15 16  etaExpandToJoinPoint, etaExpandToJoinPointRule, exprBotStrictness_maybe  simonpj@microsoft.com committed Jan 13, 2009 17 18 19 20 21 22 23  ) where #include "HsVersions.h" import CoreSyn import CoreFVs import CoreUtils  simonpj@microsoft.com committed Dec 24, 2009 24 import CoreSubst  simonpj@microsoft.com committed Nov 19, 2009 25 import Demand  simonpj@microsoft.com committed Jan 13, 2009 26 27 28 29 import Var import VarEnv import Id import Type  Simon Peyton Jones committed Sep 26, 2014 30 import TyCon ( initRecTc, checkRecTc )  simonpj@microsoft.com committed Jan 13, 2009 31 32 33 import Coercion import BasicTypes import Unique  ian@well-typed.com committed Oct 16, 2012 34 import DynFlags ( DynFlags, GeneralFlag(..), gopt )  simonpj@microsoft.com committed Jan 13, 2009 35 36 import Outputable import FastString  37 import Pair  Simon Peyton Jones committed Nov 12, 2013 38 import Util ( debugIsOn )  simonpj@microsoft.com committed Jan 13, 2009 39   Austin Seipp committed Dec 03, 2014 40 41 42 {- ************************************************************************ * *  simonpj@microsoft.com committed Jan 13, 2009 43  manifestArity and exprArity  Austin Seipp committed Dec 03, 2014 44 45 * * ************************************************************************  simonpj@microsoft.com committed Jan 13, 2009 46 47 48 49 50 51  exprArity is a cheap-and-cheerful version of exprEtaExpandArity. It tells how many things the expression can be applied to before doing any work. It doesn't look inside cases, lets, etc. The idea is that exprEtaExpandArity will do the hard work, leaving something that's easy for exprArity to grapple with. In particular, Simplify uses exprArity to  Simon Peyton Jones committed Sep 26, 2014 52 compute the ArityInfo for the Id.  simonpj@microsoft.com committed Jan 13, 2009 53 54 55 56  Originally I thought that it was enough just to look for top-level lambdas, but it isn't. I've seen this  Simon Peyton Jones committed Sep 26, 2014 57  foo = PrelBase.timesInt  simonpj@microsoft.com committed Jan 13, 2009 58 59 60  We want foo to get arity 2 even though the eta-expander will leave it unchanged, in the expectation that it'll be inlined. But occasionally it  Simon Peyton Jones committed Sep 26, 2014 61 isn't, because foo is blacklisted (used in a rule).  simonpj@microsoft.com committed Jan 13, 2009 62   Simon Peyton Jones committed Sep 26, 2014 63 64 Similarly, see the ok_note check in exprEtaExpandArity. So f = __inline_me (\x -> e)  simonpj@microsoft.com committed Jan 13, 2009 65 66 67 won't be eta-expanded. And in any case it seems more robust to have exprArity be a bit more intelligent.  Simon Peyton Jones committed Sep 26, 2014 68 But note that (\x y z -> f x y z)  simonpj@microsoft.com committed Jan 13, 2009 69 should have arity 3, regardless of f's arity.  Austin Seipp committed Dec 03, 2014 70 -}  simonpj@microsoft.com committed Jan 13, 2009 71 72  manifestArity :: CoreExpr -> Arity  Simon Peyton Jones committed Apr 24, 2014 73 74 -- ^ manifestArity sees how many leading value lambdas there are, -- after looking through casts  Simon Peyton Jones committed Sep 26, 2014 75 76 manifestArity (Lam v e) | isId v = 1 + manifestArity e | otherwise = manifestArity e  Simon Marlow committed Nov 02, 2011 77 manifestArity (Tick t e) | not (tickishIsCode t) = manifestArity e  Simon Peyton Jones committed Sep 26, 2014 78 79 manifestArity (Cast e _) = manifestArity e manifestArity _ = 0  simonpj@microsoft.com committed Jan 13, 2009 80   Simon Peyton Jones committed Mar 17, 2017 81 82 83 84 85 86 87 88 joinRhsArity :: CoreExpr -> JoinArity -- Join points are supposed to have manifestly-visible -- lambdas at the top: no ticks, no casts, nothing -- Moreover, type lambdas count in JoinArity joinRhsArity (Lam _ e) = 1 + joinRhsArity e joinRhsArity _ = 0  simonpj@microsoft.com committed Sep 24, 2010 89 ---------------  simonpj@microsoft.com committed Jan 13, 2009 90 91 92 93 exprArity :: CoreExpr -> Arity -- ^ An approximate, fast, version of 'exprEtaExpandArity' exprArity e = go e where  Simon Peyton Jones committed Sep 26, 2014 94 95 96  go (Var v) = idArity v go (Lam x e) | isId x = go e + 1 | otherwise = go e  Simon Marlow committed Nov 02, 2011 97  go (Tick t e) | not (tickishIsCode t) = go e  Simon Peyton Jones committed Jun 06, 2013 98  go (Cast e co) = trim_arity (go e) (pSnd (coercionKind co))  99  -- Note [exprArity invariant]  simonpj@microsoft.com committed Dec 24, 2009 100 101 102  go (App e (Type _)) = go e go (App f a) | exprIsTrivial a = (go f - 1) max 0 -- See Note [exprArity for applications]  Simon Peyton Jones committed Sep 26, 2014 103  -- NB: coercions count as a value argument  104   Simon Peyton Jones committed Sep 26, 2014 105  go _ = 0  simonpj@microsoft.com committed Aug 13, 2010 106   Simon Peyton Jones committed Jun 06, 2013 107 108  trim_arity :: Arity -> Type -> Arity trim_arity arity ty = arity min length (typeArity ty)  simonpj@microsoft.com committed Aug 13, 2010 109   simonpj@microsoft.com committed Sep 24, 2010 110 ---------------  Simon Peyton Jones committed Dec 12, 2013 111 typeArity :: Type -> [OneShotInfo]  simonpj@microsoft.com committed Aug 13, 2010 112 113 114 -- How many value arrows are visible in the type? -- We look through foralls, and newtypes -- See Note [exprArity invariant]  Simon Peyton Jones committed Sep 26, 2014 115 typeArity ty  Simon Peyton Jones committed Jun 06, 2013 116 117  = go initRecTc ty where  Simon Peyton Jones committed Sep 26, 2014 118  go rec_nts ty  Simon Peyton Jones committed Jun 15, 2016 119 120 121 122 123  | Just (_, ty') <- splitForAllTy_maybe ty = go rec_nts ty' | Just (arg,res) <- splitFunTy_maybe ty = typeOneShot arg : go rec_nts res  Simon Peyton Jones committed Apr 22, 2015 124   Simon Peyton Jones committed Sep 26, 2014 125  | Just (tc,tys) <- splitTyConApp_maybe ty  Simon Peyton Jones committed Jun 06, 2013 126 127 128  , Just (ty', _) <- instNewTyCon_maybe tc tys , Just rec_nts' <- checkRecTc rec_nts tc -- See Note [Expanding newtypes] -- in TyCon  Simon Peyton Jones committed Sep 26, 2014 129 130 -- , not (isClassTyCon tc) -- Do not eta-expand through newtype classes -- -- See Note [Newtype classes and eta expansion]  Simon Peyton Jones committed Jun 06, 2013 131 132 -- (no longer required) = go rec_nts' ty'  Simon Peyton Jones committed Sep 26, 2014 133 134 135  -- Important to look through non-recursive newtypes, so that, eg -- (f x) where f has arity 2, f :: Int -> IO () -- Here we want to get arity 1 for the result!  Simon Peyton Jones committed Jun 06, 2013 136 137 138  -- -- AND through a layer of recursive newtypes -- e.g. newtype Stream m a b = Stream (m (Either b (a, Stream m a b)))  simonpj@microsoft.com committed Aug 13, 2010 139   Simon Peyton Jones committed Jun 06, 2013 140 141  | otherwise = []  simonpj@microsoft.com committed Sep 24, 2010 142 143 144 145 146 147 148  --------------- exprBotStrictness_maybe :: CoreExpr -> Maybe (Arity, StrictSig) -- A cheap and cheerful function that identifies bottoming functions -- and gives them a suitable strictness signatures. It's used during -- float-out exprBotStrictness_maybe e  Simon Peyton Jones committed Nov 16, 2011 149  = case getBotArity (arityType env e) of  Simon Peyton Jones committed Sep 26, 2014 150 151  Nothing -> Nothing Just ar -> Just (ar, sig ar)  simonpj@microsoft.com committed Dec 21, 2010 152  where  Joachim Breitner committed Feb 17, 2014 153  env = AE { ae_ped_bot = True, ae_cheap_fn = \ _ _ -> False }  Simon Peyton Jones committed Jan 07, 2016 154  sig ar = mkClosedStrictSig (replicate ar topDmd) exnRes  Simon Peyton Jones committed Nov 16, 2011 155  -- For this purpose we can be very simple  Simon Peyton Jones committed Jan 07, 2016 156  -- exnRes is a bit less aggressive than botRes  simonpj@microsoft.com committed Jan 13, 2009 157   Austin Seipp committed Dec 03, 2014 158 {-  simonpj@microsoft.com committed Sep 24, 2010 159 160 161 162 Note [exprArity invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~ exprArity has the following invariant:  Simon Peyton Jones committed Nov 09, 2011 163 164  (1) If typeArity (exprType e) = n, then manifestArity (etaExpand e n) = n  Simon Peyton Jones committed Sep 26, 2014 165   Simon Peyton Jones committed Nov 09, 2011 166 167  That is, etaExpand can always expand as much as typeArity says So the case analysis in etaExpand and in typeArity must match  Simon Peyton Jones committed Sep 26, 2014 168 169  (2) exprArity e <= typeArity (exprType e)  simonpj@microsoft.com committed Sep 24, 2010 170   Simon Peyton Jones committed Nov 09, 2011 171  (3) Hence if (exprArity e) = n, then manifestArity (etaExpand e n) = n  simonpj@microsoft.com committed Sep 24, 2010 172   Simon Peyton Jones committed Sep 26, 2014 173  That is, if exprArity says "the arity is n" then etaExpand really  Simon Peyton Jones committed Nov 09, 2011 174  can get "n" manifest lambdas to the top.  simonpj@microsoft.com committed Sep 24, 2010 175   Simon Peyton Jones committed Sep 26, 2014 176 177 Why is this important? Because - In TidyPgm we use exprArity to fix the *final arity* of  simonpj@microsoft.com committed Sep 24, 2010 178 179 180 181 182 183 184 185 186  each top-level Id, and in - In CorePrep we use etaExpand on each rhs, so that the visible lambdas actually match that arity, which in turn means that the StgRhs has the right number of lambdas An alternative would be to do the eta-expansion in TidyPgm, at least for top-level bindings, in which case we would not need the trim_arity in exprArity. That is a less local change, so I'm going to leave it for today!  simonpj@microsoft.com committed Aug 13, 2010 187 188 Note [Newtype classes and eta expansion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  Gabor Greif committed Oct 08, 2013 189  NB: this nasty special case is no longer required, because  Simon Peyton Jones committed Jun 06, 2013 190 191 192 193  for newtype classes we don't use the class-op rule mechanism at all. See Note [Single-method classes] in TcInstDcls. SLPJ May 2013 -------- Old out of date comments, just for interest -----------  simonpj@microsoft.com committed Aug 13, 2010 194 We have to be careful when eta-expanding through newtypes. In general  Simon Peyton Jones committed Sep 26, 2014 195 it's a good idea, but annoyingly it interacts badly with the class-op  simonpj@microsoft.com committed Aug 13, 2010 196 rule mechanism. Consider  Simon Peyton Jones committed Sep 26, 2014 197   simonpj@microsoft.com committed Aug 13, 2010 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214  class C a where { op :: a -> a } instance C b => C [b] where op x = ... These translate to co :: forall a. (a->a) ~ C a $copList :: C b -> [b] -> [b]$copList d x = ... $dfList :: C b -> C [b] {-# DFunUnfolding = [$copList] #-} $dfList d =$copList d |> co@[b] Now suppose we have:  Simon Peyton Jones committed Sep 26, 2014 215  dCInt :: C Int  simonpj@microsoft.com committed Aug 13, 2010 216 217 218 219 220 221 222 223 224 225 226 227  blah :: [Int] -> [Int] blah = op ($dfList dCInt) Now we want the built-in op/$dfList rule will fire to give blah = $copList dCInt But with eta-expansion 'blah' might (and in Trac #3772, which is slightly more complicated, does) turn into blah = op (\eta. ($dfList dCInt |> sym co) eta)  Gabor Greif committed Jan 30, 2013 228 and now it is *much* harder for the op/$dfList rule to fire, because  simonpj@microsoft.com committed Aug 13, 2010 229 230 231 232 exprIsConApp_maybe won't hold of the argument to op. I considered trying to *make* it hold, but it's tricky and I gave up. The test simplCore/should_compile/T3722 is an excellent example.  Simon Peyton Jones committed Jun 06, 2013 233 -------- End of old out of date comments, just for interest -----------  simonpj@microsoft.com committed Aug 13, 2010 234 235   simonpj@microsoft.com committed Dec 24, 2009 236 237 238 Note [exprArity for applications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we come to an application we check that the arg is trivial.  Simon Peyton Jones committed Sep 26, 2014 239  eg f (fac x) does not have arity 2,  simonpj@microsoft.com committed Dec 24, 2009 240 241 242 243 244 245 246 247 248 249 250 251 252  even if f has arity 3! * We require that is trivial rather merely cheap. Suppose f has arity 2. Then f (Just y) has arity 0, because if we gave it arity 1 and then inlined f we'd get let v = Just y in \w. which has arity 0. And we try to maintain the invariant that we don't have arity decreases. * The max 0 is important! (\x y -> f x) has arity 2, even if f is unknown, hence arity 0  Austin Seipp committed Dec 03, 2014 253 254 ************************************************************************ * *  Simon Peyton Jones committed Sep 26, 2014 255  Computing the "arity" of an expression  Austin Seipp committed Dec 03, 2014 256 257 * * ************************************************************************  simonpj@microsoft.com committed Jan 13, 2009 258   simonpj@microsoft.com committed Apr 03, 2009 259 260 261 262 263 Note [Definition of arity] ~~~~~~~~~~~~~~~~~~~~~~~~~~ The "arity" of an expression 'e' is n if applying 'e' to *fewer* than n *value* arguments converges rapidly  simonpj@microsoft.com committed Jan 13, 2009 264   simonpj@microsoft.com committed Apr 03, 2009 265 Or, to put it another way  simonpj@microsoft.com committed Jan 13, 2009 266   simonpj@microsoft.com committed Apr 03, 2009 267 268  there is no work lost in duplicating the partial application (e x1 .. x(n-1))  simonpj@microsoft.com committed Jan 13, 2009 269   simonpj@microsoft.com committed Apr 03, 2009 270 271 In the divegent case, no work is lost by duplicating because if the thing is evaluated once, that's the end of the program.  simonpj@microsoft.com committed Jan 13, 2009 272   simonpj@microsoft.com committed Apr 03, 2009 273 Or, to put it another way, in any context C  simonpj@microsoft.com committed Jan 13, 2009 274   simonpj@microsoft.com committed Apr 03, 2009 275 276 277  C[ (\x1 .. xn. e x1 .. xn) ] is as efficient as C[ e ]  simonpj@microsoft.com committed Jan 13, 2009 278   simonpj@microsoft.com committed Apr 03, 2009 279 It's all a bit more subtle than it looks:  simonpj@microsoft.com committed Jan 13, 2009 280   Simon Peyton Jones committed Nov 11, 2011 281 282 283 Note [One-shot lambdas] ~~~~~~~~~~~~~~~~~~~~~~~ Consider one-shot lambdas  Simon Peyton Jones committed Sep 26, 2014 284  let x = expensive in \y z -> E  Simon Peyton Jones committed Nov 11, 2011 285 286 287 288 289 290 291 292 293 294 295 296 297 We want this to have arity 1 if the \y-abstraction is a 1-shot lambda. Note [Dealing with bottom] ~~~~~~~~~~~~~~~~~~~~~~~~~~ A Big Deal with computing arities is expressions like f = \x -> case x of True -> \s -> e1 False -> \s -> e2 This happens all the time when f :: Bool -> IO () In this case we do eta-expand, in order to get that \s to the top, and give f arity 2.  simonpj@microsoft.com committed Jan 13, 2009 298   simonpj@microsoft.com committed Apr 03, 2009 299 This isn't really right in the presence of seq. Consider  Simon Peyton Jones committed Sep 26, 2014 300  (f bot) seq 1  simonpj@microsoft.com committed Jan 13, 2009 301   Simon Peyton Jones committed Nov 11, 2011 302 This should diverge! But if we eta-expand, it won't. We ignore this  Simon Peyton Jones committed Nov 16, 2011 303 "problem" (unless -fpedantic-bottoms is on), because being scrupulous  Simon Peyton Jones committed Sep 26, 2014 304 would lose an important transformation for many programs. (See  Simon Peyton Jones committed Nov 16, 2011 305 Trac #5587 for an example.)  simonpj@microsoft.com committed Jan 13, 2009 306   Simon Peyton Jones committed Nov 11, 2011 307 Consider also  Simon Peyton Jones committed Sep 26, 2014 308  f = \x -> error "foo"  simonpj@microsoft.com committed Apr 03, 2009 309 Here, arity 1 is fine. But if it is  Simon Peyton Jones committed Sep 26, 2014 310 311 312  f = \x -> case x of True -> error "foo" False -> \y -> x+y  simonpj@microsoft.com committed Apr 03, 2009 313 then we want to get arity 2. Technically, this isn't quite right, because  Simon Peyton Jones committed Sep 26, 2014 314  (f True) seq 1  simonpj@microsoft.com committed Apr 03, 2009 315 316 317 318 should diverge, but it'll converge if we eta-expand f. Nevertheless, we do so; it improves some programs significantly, and increasing convergence isn't a bad thing. Hence the ABot/ATop in ArityType.  Simon Peyton Jones committed Nov 11, 2011 319 320 321 So these two transformations aren't always the Right Thing, and we have several tickets reporting unexpected bahaviour resulting from this transformation. So we try to limit it as much as possible:  Simon Peyton Jones committed Oct 21, 2011 322   Simon Peyton Jones committed Nov 11, 2011 323 324 325  (1) Do NOT move a lambda outside a known-bottom case expression case undefined of { (a,b) -> \y -> e } This showed up in Trac #5557  Simon Peyton Jones committed Oct 21, 2011 326   Simon Peyton Jones committed Sep 26, 2014 327  (2) Do NOT move a lambda outside a case if all the branches of  Simon Peyton Jones committed Nov 11, 2011 328 329  the case are known to return bottom. case x of { (a,b) -> \y -> error "urk" }  Simon Peyton Jones committed Sep 26, 2014 330 331  This case is less important, but the idea is that if the fn is going to diverge eventually anyway then getting the best arity  Simon Peyton Jones committed Nov 11, 2011 332  isn't an issue, so we might as well play safe  Simon Peyton Jones committed Oct 21, 2011 333   Simon Peyton Jones committed Mar 11, 2014 334  (3) Do NOT move a lambda outside a case unless  Simon Peyton Jones committed Nov 11, 2011 335  (a) The scrutinee is ok-for-speculation, or  Simon Peyton Jones committed Mar 11, 2014 336 337  (b) more liberally: the scrutinee is cheap (e.g. a variable), and -fpedantic-bottoms is not enforced (see Trac #2915 for an example)  Simon Peyton Jones committed Nov 11, 2011 338 339  Of course both (1) and (2) are readily defeated by disguising the bottoms.  Simon Peyton Jones committed Oct 21, 2011 340   simonpj@microsoft.com committed Apr 03, 2009 341 342 4. Note [Newtype arity] ~~~~~~~~~~~~~~~~~~~~~~~~  simonpj@microsoft.com committed Jan 13, 2009 343 344 345 Non-recursive newtypes are transparent, and should not get in the way. We do (currently) eta-expand recursive newtypes too. So if we have, say  Simon Peyton Jones committed Sep 26, 2014 346  newtype T = MkT ([T] -> Int)  simonpj@microsoft.com committed Jan 13, 2009 347 348  Suppose we have  Simon Peyton Jones committed Sep 26, 2014 349 350  e = coerce T f where f has arity 1. Then: etaExpandArity e = 1;  simonpj@microsoft.com committed Jan 13, 2009 351 352 353 that is, etaExpandArity looks through the coerce. When we eta-expand e to arity 1: eta_expand 1 e T  Simon Peyton Jones committed Sep 26, 2014 354 we want to get: coerce T (\x::[T] -> (coerce ([T]->Int) e) x)  simonpj@microsoft.com committed Jan 13, 2009 355   simonpj@microsoft.com committed Apr 03, 2009 356  HOWEVER, note that if you use coerce bogusly you can ge  Simon Peyton Jones committed Sep 26, 2014 357  coerce Int negate  simonpj@microsoft.com committed Apr 03, 2009 358 359  And since negate has arity 2, you might try to eta expand. But you can't decopose Int to a function type. Hence the final case in eta_expand.  Simon Peyton Jones committed Sep 26, 2014 360   simonpj@microsoft.com committed Dec 24, 2009 361 362 Note [The state-transformer hack] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  Simon Peyton Jones committed Sep 26, 2014 363 364 Suppose we have f = e  simonpj@microsoft.com committed Dec 24, 2009 365 366 where e has arity n. Then, if we know from the context that f has a usage type like  Simon Peyton Jones committed Sep 26, 2014 367  t1 -> ... -> tn -1-> t(n+1) -1-> ... -1-> tm -> ...  simonpj@microsoft.com committed Dec 24, 2009 368 369 then we can expand the arity to m. This usage type says that any application (x e1 .. en) will be applied to uniquely to (m-n) more args  Simon Peyton Jones committed Sep 26, 2014 370 371 372 373 Consider f = \x. let y = in case x of True -> foo False -> \(s:RealWorld) -> e  simonpj@microsoft.com committed Dec 24, 2009 374 375 376 377 378 379 380 where foo has arity 1. Then we want the state hack to apply to foo too, so we can eta expand the case. Then we expect that if f is applied to one arg, it'll be applied to two (that's the hack -- we don't really know, and sometimes it's false) See also Id.isOneShotBndr.  simonpj@microsoft.com committed Apr 03, 2009 381 382 383 384 385 386 387 388 389 Note [State hack and bottoming functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's a terrible idea to use the state hack on a bottoming function. Here's what happens (Trac #2861): f :: String -> IO T f = \p. error "..." Eta-expand, using the state hack:  simonpj@microsoft.com committed Jan 13, 2009 390   simonpj@microsoft.com committed Apr 03, 2009 391 392 393  f = \p. (\s. ((error "...") |> g1) s) |> g2 g1 :: IO T ~ (S -> (S,T)) g2 :: (S -> (S,T)) ~ IO T  simonpj@microsoft.com committed Jan 13, 2009 394   simonpj@microsoft.com committed Apr 03, 2009 395 Extrude the g2  simonpj@microsoft.com committed Jan 13, 2009 396   simonpj@microsoft.com committed Apr 03, 2009 397 398  f' = \p. \s. ((error "...") |> g1) s f = f' |> (String -> g2)  simonpj@microsoft.com committed Jan 13, 2009 399   simonpj@microsoft.com committed Apr 03, 2009 400 Discard args for bottomming function  simonpj@microsoft.com committed Jan 13, 2009 401   simonpj@microsoft.com committed Apr 03, 2009 402 403  f' = \p. \s. ((error "...") |> g1 |> g3 g3 :: (S -> (S,T)) ~ (S,T)  simonpj@microsoft.com committed Jan 13, 2009 404   simonpj@microsoft.com committed Apr 03, 2009 405 406 407 408 409 410 411 412 Extrude g1.g3 f'' = \p. \s. (error "...") f' = f'' |> (String -> S -> g1.g3) And now we can repeat the whole loop. Aargh! The bug is in applying the state hack to a function which then swallows the argument.  simonpj@microsoft.com committed Aug 13, 2010 413 414 415 416 417 This arose in another guise in Trac #3959. Here we had catch# (throw exn >> return ()) Note that (throw :: forall a e. Exn e => e -> a) is called with [a = IO ()].  Simon Peyton Jones committed Sep 26, 2014 418 After inlining (>>) we get  simonpj@microsoft.com committed Aug 13, 2010 419 420 421  catch# (\_. throw {IO ()} exn)  Simon Peyton Jones committed Sep 26, 2014 422 We must *not* eta-expand to  simonpj@microsoft.com committed Aug 13, 2010 423 424 425 426  catch# (\_ _. throw {...} exn) because 'catch#' expects to get a (# _,_ #) after applying its argument to  Simon Peyton Jones committed Sep 26, 2014 427 a State#, not another function!  simonpj@microsoft.com committed Aug 13, 2010 428 429 430 431 432 433 434 435 436  In short, we use the state hack to allow us to push let inside a lambda, but not to introduce a new lambda. Note [ArityType] ~~~~~~~~~~~~~~~~ ArityType is the result of a compositional analysis on expressions, from which we can decide the real arity of the expression (extracted  simonpj@microsoft.com committed Oct 27, 2010 437 with function exprEtaExpandArity).  simonpj@microsoft.com committed Aug 13, 2010 438   Simon Peyton Jones committed Sep 26, 2014 439 Here is what the fields mean. If an arbitrary expression 'f' has  simonpj@microsoft.com committed Oct 27, 2010 440 ArityType 'at', then  simonpj@microsoft.com committed Aug 13, 2010 441   simonpj@microsoft.com committed Oct 27, 2010 442 443  * If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge.  simonpj@microsoft.com committed Aug 13, 2010 444   simonpj@microsoft.com committed Oct 27, 2010 445  We allow ourselves to eta-expand bottoming functions, even  Simon Peyton Jones committed Sep 26, 2014 446  if doing so may lose some seq sharing,  simonpj@microsoft.com committed Oct 27, 2010 447 448  let x = in \y. error (g x y) ==> \y. let x = in error (g x y)  simonpj@microsoft.com committed Aug 13, 2010 449   Simon Peyton Jones committed Sep 26, 2014 450 451  * If at = ATop as, and n=length as, then expanding 'f' to (\x1..xn. f x1 .. xn) loses no sharing,  Javran Cheng committed Mar 02, 2015 452  assuming the calls of f respect the one-shot-ness of  Simon Peyton Jones committed Sep 26, 2014 453  its definition.  simonpj@microsoft.com committed Oct 27, 2010 454   Herbert Valerio Riedel committed Dec 17, 2015 455  NB 'f' is an arbitrary expression, eg (f = g e1 e2). This 'f'  Simon Peyton Jones committed Sep 26, 2014 456  can have ArityType as ATop, with length as > 0, only if e1 e2 are  simonpj@microsoft.com committed Oct 27, 2010 457 458 459 460 461 462 463 464 465  themselves. * In both cases, f, (f x1), ... (f x1 ... f(n-1)) are definitely really functions, or bottom, but *not* casts from a data type, in at least one case branch. (If it's a function in one case branch but an unsafe cast from a data type in another, the program is bogus.) So eta expansion is dynamically ok; see Note [State hack and bottoming functions], the part about catch#  Simon Peyton Jones committed Sep 26, 2014 466 467 Example: f = \x\y. let v = in  simonpj@microsoft.com committed Oct 27, 2010 468 469 470 471  \s(one-shot) \t(one-shot). blah 'f' has ArityType [ManyShot,ManyShot,OneShot,OneShot] The one-shot-ness means we can, in effect, push that 'let' inside the \st.  simonpj@microsoft.com committed Aug 13, 2010 472 473 474  Suppose f = \xy. x+y  simonpj@microsoft.com committed Oct 27, 2010 475 Then f :: AT [False,False] ATop  Simon Peyton Jones committed Sep 26, 2014 476 477  f v :: AT [False] ATop f :: AT [] ATop  simonpj@microsoft.com committed Apr 03, 2009 478 479  -------------------- Main arity code ----------------------------  Austin Seipp committed Dec 03, 2014 480 481 -}  simonpj@microsoft.com committed Aug 13, 2010 482 -- See Note [ArityType]  Simon Peyton Jones committed Dec 12, 2013 483 data ArityType = ATop [OneShotInfo] | ABot Arity  simonpj@microsoft.com committed Aug 13, 2010 484  -- There is always an explicit lambda  simonpj@microsoft.com committed Oct 27, 2010 485  -- to justify the [OneShot], or the Arity  simonpj@microsoft.com committed Aug 13, 2010 486   simonpj@microsoft.com committed Apr 03, 2009 487 vanillaArityType :: ArityType  Simon Peyton Jones committed Sep 26, 2014 488 vanillaArityType = ATop [] -- Totally uninformative  simonpj@microsoft.com committed Apr 03, 2009 489   Simon Marlow committed Nov 02, 2011 490 -- ^ The Arity returned is the number of value args the  simonpj@microsoft.com committed Aug 13, 2010 491 -- expression can be applied to without doing much work  Simon Peyton Jones committed Nov 12, 2013 492 exprEtaExpandArity :: DynFlags -> CoreExpr -> Arity  simonpj@microsoft.com committed Aug 13, 2010 493 -- exprEtaExpandArity is used when eta expanding  Simon Peyton Jones committed Sep 26, 2014 494 -- e ==> \xy -> e x y  Simon Peyton Jones committed Nov 12, 2013 495 exprEtaExpandArity dflags e  Simon Peyton Jones committed Nov 16, 2011 496  = case (arityType env e) of  Simon Peyton Jones committed Nov 12, 2013 497 498  ATop oss -> length oss ABot n -> n  simonpj@microsoft.com committed Aug 13, 2010 499  where  Joachim Breitner committed Feb 17, 2014 500  env = AE { ae_cheap_fn = mk_cheap_fn dflags isCheapApp  ian@well-typed.com committed Oct 16, 2012 501  , ae_ped_bot = gopt Opt_PedanticBottoms dflags }  Simon Peyton Jones committed Nov 16, 2011 502   simonpj@microsoft.com committed Aug 13, 2010 503 504 getBotArity :: ArityType -> Maybe Arity -- Arity of a divergent function  simonpj@microsoft.com committed Oct 27, 2010 505 506 getBotArity (ABot n) = Just n getBotArity _ = Nothing  Simon Peyton Jones committed Nov 16, 2011 507   Simon Marlow committed Jan 16, 2012 508 mk_cheap_fn :: DynFlags -> CheapAppFun -> CheapFun  Simon Peyton Jones committed Nov 16, 2011 509 mk_cheap_fn dflags cheap_app  ian@well-typed.com committed Oct 16, 2012 510  | not (gopt Opt_DictsCheap dflags)  Simon Peyton Jones committed Jan 20, 2017 511  = \e _ -> exprIsOk cheap_app e  Simon Peyton Jones committed Nov 16, 2011 512  | otherwise  Simon Peyton Jones committed Jan 20, 2017 513  = \e mb_ty -> exprIsOk cheap_app e  Simon Peyton Jones committed Nov 16, 2011 514 515 516  || case mb_ty of Nothing -> False Just ty -> isDictLikeTy ty  Simon Peyton Jones committed Nov 12, 2013 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542  ---------------------- findRhsArity :: DynFlags -> Id -> CoreExpr -> Arity -> Arity -- This implements the fixpoint loop for arity analysis -- See Note [Arity analysis] findRhsArity dflags bndr rhs old_arity = go (rhsEtaExpandArity dflags init_cheap_app rhs) -- We always call exprEtaExpandArity once, but usually -- that produces a result equal to old_arity, and then -- we stop right away (since arities should not decrease) -- Result: the common case is that there is just one iteration where init_cheap_app :: CheapAppFun init_cheap_app fn n_val_args | fn == bndr = True -- On the first pass, this binder gets infinite arity | otherwise = isCheapApp fn n_val_args go :: Arity -> Arity go cur_arity | cur_arity <= old_arity = cur_arity | new_arity == cur_arity = cur_arity | otherwise = ASSERT( new_arity < cur_arity ) #ifdef DEBUG pprTrace "Exciting arity" (vcat [ ppr bndr <+> ppr cur_arity <+> ppr new_arity  Simon Peyton Jones committed Dec 12, 2013 543  , ppr rhs])  Simon Peyton Jones committed Nov 12, 2013 544 545 546 547 548 549 550 551 552 553 554 555 556 557 #endif go new_arity where new_arity = rhsEtaExpandArity dflags cheap_app rhs cheap_app :: CheapAppFun cheap_app fn n_val_args | fn == bndr = n_val_args < cur_arity | otherwise = isCheapApp fn n_val_args -- ^ The Arity returned is the number of value args the -- expression can be applied to without doing much work rhsEtaExpandArity :: DynFlags -> CheapAppFun -> CoreExpr -> Arity -- exprEtaExpandArity is used when eta expanding  Simon Peyton Jones committed Sep 26, 2014 558 -- e ==> \xy -> e x y  Simon Peyton Jones committed Nov 12, 2013 559 560 561 rhsEtaExpandArity dflags cheap_app e = case (arityType env e) of ATop (os:oss)  Simon Peyton Jones committed Sep 26, 2014 562  | isOneShotInfo os || has_lam e -> 1 + length oss  Simon Peyton Jones committed Dec 12, 2013 563 564  -- Don't expand PAPs/thunks -- Note [Eta expanding thunks]  Simon Peyton Jones committed Nov 12, 2013 565 566 567 568  | otherwise -> 0 ATop [] -> 0 ABot n -> n where  Joachim Breitner committed Feb 17, 2014 569  env = AE { ae_cheap_fn = mk_cheap_fn dflags cheap_app  Simon Peyton Jones committed Nov 12, 2013 570 571 572 573 574  , ae_ped_bot = gopt Opt_PedanticBottoms dflags } has_lam (Tick _ e) = has_lam e has_lam (Lam b e) = isId b || has_lam e has_lam _ = False  simonpj@microsoft.com committed Oct 27, 2010 575   Austin Seipp committed Dec 03, 2014 576 {-  Simon Peyton Jones committed Nov 12, 2013 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 Note [Arity analysis] ~~~~~~~~~~~~~~~~~~~~~ The motivating example for arity analysis is this: f = \x. let g = f (x+1) in \y. ...g... What arity does f have? Really it should have arity 2, but a naive look at the RHS won't see that. You need a fixpoint analysis which says it has arity "infinity" the first time round. This example happens a lot; it first showed up in Andy Gill's thesis, fifteen years ago! It also shows up in the code for 'rnf' on lists in Trac #4138. The analysis is easy to achieve because exprEtaExpandArity takes an argument type CheapFun = CoreExpr -> Maybe Type -> Bool used to decide if an expression is cheap enough to push inside a lambda. And exprIsCheap' in turn takes an argument type CheapAppFun = Id -> Int -> Bool which tells when an application is cheap. This makes it easy to write the analysis loop. The analysis is cheap-and-cheerful because it doesn't deal with mutual recursion. But the self-recursive case is the important one.  Simon Peyton Jones committed Nov 16, 2011 605 606 607 608 609 610 611 Note [Eta expanding through dictionaries] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If the experimental -fdicts-cheap flag is on, we eta-expand through dictionary bindings. This improves arities. Thereby, it also means that full laziness is less prone to floating out the application of a function to its dictionary arguments, which can thereby lose opportunities for fusion. Example:  Simon Peyton Jones committed Sep 26, 2014 612  foo :: Ord a => a -> ...  Simon Peyton Jones committed Nov 16, 2011 613  foo = /\a \(d:Ord a). let d' = ...d... in \(x:a). ....  Simon Peyton Jones committed Sep 26, 2014 614  -- So foo has arity 1  Simon Peyton Jones committed Nov 16, 2011 615 616 617  f = \x. foo dInt$ bar x  Simon Peyton Jones committed Sep 26, 2014 618 The (foo DInt) is floated out, and makes ineffective a RULE  Simon Peyton Jones committed Nov 16, 2011 619 620 621 622 623  foo (bar x) = ... One could go further and make exprIsCheap reply True to any dictionary-typed expression, but that's more work.  rodlogic committed Feb 09, 2015 624 See Note [Dictionary-like types] in TcType.hs for why we use  Simon Peyton Jones committed Nov 16, 2011 625 626 isDictLikeTy here rather than isDictTy  simonpj@microsoft.com committed Oct 27, 2010 627 628 Note [Eta expanding thunks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~  Simon Peyton Jones committed Nov 12, 2013 629 630 631 632 633 We don't eta-expand * Trivial RHSs x = y * PAPs x = map g * Thunks f = case y of p -> \x -> blah  simonpj@microsoft.com committed Oct 27, 2010 634 635 When we see f = case y of p -> \x -> blah  Simon Peyton Jones committed Sep 26, 2014 636 should we eta-expand it? Well, if 'x' is a one-shot state token  simonpj@microsoft.com committed Oct 27, 2010 637 638 639 then 'yes' because 'f' will only be applied once. But otherwise we (conservatively) say no. My main reason is to avoid expanding PAPSs  Simon Peyton Jones committed Sep 26, 2014 640 641  f = g d ==> f = \x. g d x because that might in turn make g inline (if it has an inline pragma),  simonpj@microsoft.com committed Oct 27, 2010 642 which we might not want. After all, INLINE pragmas say "inline only  Simon Peyton Jones committed Jun 06, 2013 643 when saturated" so we don't want to be too gung-ho about saturating!  Austin Seipp committed Dec 03, 2014 644 -}  simonpj@microsoft.com committed Apr 03, 2009 645   simonpj@microsoft.com committed Aug 13, 2010 646 arityLam :: Id -> ArityType -> ArityType  Joachim Breitner committed Apr 27, 2016 647 arityLam id (ATop as) = ATop (idStateHackOneShotInfo id : as)  simonpj@microsoft.com committed Oct 27, 2010 648 arityLam _ (ABot n) = ABot (n+1)  simonpj@microsoft.com committed Aug 13, 2010 649 650  floatIn :: Bool -> ArityType -> ArityType  Simon Peyton Jones committed Dec 12, 2013 651 652 -- We have something like (let x = E in b), -- where b has the given arity type.  simonpj@microsoft.com committed Oct 27, 2010 653 654 floatIn _ (ABot n) = ABot n floatIn True (ATop as) = ATop as  Simon Peyton Jones committed Dec 12, 2013 655 floatIn False (ATop as) = ATop (takeWhile isOneShotInfo as)  simonpj@microsoft.com committed Oct 27, 2010 656  -- If E is not cheap, keep arity only for one-shots  simonpj@microsoft.com committed Aug 13, 2010 657   simonpj@microsoft.com committed Dec 21, 2010 658 arityApp :: ArityType -> Bool -> ArityType  simonpj@microsoft.com committed Aug 13, 2010 659 -- Processing (fun arg) where at is the ArityType of fun,  simonpj@microsoft.com committed Oct 27, 2010 660 -- Knock off an argument and behave like 'let'  simonpj@microsoft.com committed Dec 21, 2010 661 662 663 664 arityApp (ABot 0) _ = ABot 0 arityApp (ABot n) _ = ABot (n-1) arityApp (ATop []) _ = ATop [] arityApp (ATop (_:as)) cheap = floatIn cheap (ATop as)  simonpj@microsoft.com committed Aug 13, 2010 665 666  andArityType :: ArityType -> ArityType -> ArityType -- Used for branches of a 'case'  Simon Peyton Jones committed Dec 23, 2016 667 andArityType (ABot n1) (ABot n2) = ABot (n1 max n2) -- Note [ABot branches: use max]  simonpj@microsoft.com committed Oct 27, 2010 668 669 670 andArityType (ATop as) (ABot _) = ATop as andArityType (ABot _) (ATop bs) = ATop bs andArityType (ATop as) (ATop bs) = ATop (as combine bs)  Simon Peyton Jones committed Sep 26, 2014 671  where -- See Note [Combining case branches]  Simon Peyton Jones committed Dec 12, 2013 672 673 674  combine (a:as) (b:bs) = (a bestOneShot b) : combine as bs combine [] bs = takeWhile isOneShotInfo bs combine as [] = takeWhile isOneShotInfo as  simonpj@microsoft.com committed Dec 24, 2009 675   Simon Peyton Jones committed Dec 23, 2016 676 677 678 679 680 681 682 683 684 {- Note [ABot branches: use max] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider case x of True -> \x. error "urk" False -> \xy. error "urk2" Remember: ABot n means "if you apply to n args, it'll definitely diverge". So we need (ABot 2) for the whole thing, the /max/ of the ABot arities.  simonpj@microsoft.com committed Oct 27, 2010 685 686 Note [Combining case branches] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  Simon Peyton Jones committed Dec 12, 2013 687 Consider  simonpj@microsoft.com committed Oct 27, 2010 688 689 690 691 692  go = \x. let z = go e0 go2 = \x. case x of True -> z False -> \s(one-shot). e1 in go2 x  Simon Peyton Jones committed Dec 12, 2013 693 We *really* want to eta-expand go and go2.  simonpj@microsoft.com committed Oct 27, 2010 694 When combining the barnches of the case we have  Simon Peyton Jones committed Dec 12, 2013 695 696  ATop [] andAT ATop [OneShotLam] and we want to get ATop [OneShotLam]. But if the inner  simonpj@microsoft.com committed Oct 27, 2010 697 698 699 lambda wasn't one-shot we don't want to do this. (We need a proper arity analysis to justify that.)  Simon Peyton Jones committed Dec 12, 2013 700 701 So we combine the best of the two branches, on the (slightly dodgy) basis that if we know one branch is one-shot, then they all must be.  Austin Seipp committed Dec 03, 2014 702 -}  simonpj@microsoft.com committed Dec 24, 2009 703   simonpj@microsoft.com committed Apr 03, 2009 704 ---------------------------  simonpj@microsoft.com committed Dec 21, 2010 705 type CheapFun = CoreExpr -> Maybe Type -> Bool  Simon Peyton Jones committed Sep 26, 2014 706 707 708  -- How to decide if an expression is cheap -- If the Maybe is Just, the type is the type -- of the expression; Nothing means "don't know"  simonpj@microsoft.com committed Dec 21, 2010 709   Simon Peyton Jones committed Sep 26, 2014 710 data ArityEnv  Joachim Breitner committed Feb 17, 2014 711  = AE { ae_cheap_fn :: CheapFun  Simon Peyton Jones committed Nov 16, 2011 712 713  , ae_ped_bot :: Bool -- True <=> be pedantic about bottoms }  Simon Marlow committed Nov 02, 2011 714   Simon Peyton Jones committed Nov 16, 2011 715 716 717 718 arityType :: ArityEnv -> CoreExpr -> ArityType arityType env (Cast e co) = case arityType env e of  Simon Peyton Jones committed Nov 09, 2011 719 720 721 722 723  ATop os -> ATop (take co_arity os) ABot n -> ABot (n min co_arity) where co_arity = length (typeArity (pSnd (coercionKind co))) -- See Note [exprArity invariant] (2); must be true of  Simon Peyton Jones committed Sep 09, 2011 724 725 726  -- arityType too, since that is how we compute the arity -- of variables, and they in turn affect result of exprArity -- Trac #5441 is a nice demo  Simon Peyton Jones committed Nov 09, 2011 727 728  -- However, do make sure that ATop -> ATop and ABot -> ABot! -- Casts don't affect that part. Getting this wrong provoked #5475  Simon Peyton Jones committed Sep 09, 2011 729   Simon Peyton Jones committed Nov 16, 2011 730 arityType _ (Var v)  Simon Peyton Jones committed Jan 17, 2013 731  | strict_sig <- idStrictness v  Joachim Breitner committed Mar 29, 2016 732  , not $isTopSig strict_sig  simonpj@microsoft.com committed Apr 03, 2009 733  , (ds, res) <- splitStrictSig strict_sig  simonpj@microsoft.com committed Oct 27, 2010 734 735 736  , let arity = length ds = if isBotRes res then ABot arity else ATop (take arity one_shots)  simonpj@microsoft.com committed Apr 03, 2009 737  | otherwise  simonpj@microsoft.com committed Oct 27, 2010 738  = ATop (take (idArity v) one_shots)  simonpj@microsoft.com committed Aug 13, 2010 739  where  Simon Peyton Jones committed Sep 26, 2014 740  one_shots :: [OneShotInfo] -- One-shot-ness derived from the type  simonpj@microsoft.com committed Aug 13, 2010 741  one_shots = typeArity (idType v)  simonpj@microsoft.com committed Jan 13, 2009 742   Simon Peyton Jones committed Sep 26, 2014 743  -- Lambdas; increase arity  Simon Peyton Jones committed Nov 16, 2011 744 arityType env (Lam x e)  Joachim Breitner committed Feb 17, 2014 745  | isId x = arityLam x (arityType env e)  Simon Peyton Jones committed Nov 16, 2011 746  | otherwise = arityType env e  simonpj@microsoft.com committed Jan 13, 2009 747   Simon Peyton Jones committed Sep 26, 2014 748  -- Applications; decrease arity, except for types  Simon Peyton Jones committed Nov 16, 2011 749 750 751 arityType env (App fun (Type _)) = arityType env fun arityType env (App fun arg )  Joachim Breitner committed Feb 17, 2014 752  = arityApp (arityType env fun) (ae_cheap_fn env arg Nothing)  simonpj@microsoft.com committed Apr 03, 2009 753   Simon Peyton Jones committed Sep 26, 2014 754 755 756 757 758 759 760 761  -- Case/Let; keep arity if either the expression is cheap -- or it's a 1-shot lambda -- The former is not really right for Haskell -- f x = case x of { (a,b) -> \y. e } -- ===> -- f x y = case x of { (a,b) -> e } -- The difference is observable using 'seq' --  Simon Peyton Jones committed Nov 16, 2011 762 arityType env (Case scrut _ _ alts)  Simon Peyton Jones committed May 02, 2012 763  | exprIsBottom scrut || null alts  Simon Peyton Jones committed Oct 21, 2011 764  = ABot 0 -- Do not eta expand  Simon Peyton Jones committed Nov 11, 2011 765  -- See Note [Dealing with bottom (1)]  Simon Peyton Jones committed Oct 21, 2011 766 767  | otherwise = case alts_type of  Simon Peyton Jones committed Sep 26, 2014 768 769 770  ABot n | n>0 -> ATop [] -- Don't eta expand | otherwise -> ABot 0 -- if RHS is bottomming -- See Note [Dealing with bottom (2)]  Simon Peyton Jones committed Nov 11, 2011 771   Simon Peyton Jones committed Mar 11, 2014 772  ATop as | not (ae_ped_bot env) -- See Note [Dealing with bottom (3)]  Joachim Breitner committed Feb 17, 2014 773  , ae_cheap_fn env scrut Nothing -> ATop as  Simon Peyton Jones committed Mar 11, 2014 774 775  | exprOkForSpeculation scrut -> ATop as | otherwise -> ATop (takeWhile isOneShotInfo as)  Simon Peyton Jones committed Oct 21, 2011 776  where  Simon Peyton Jones committed Nov 16, 2011 777  alts_type = foldr1 andArityType [arityType env rhs | (_,_,rhs) <- alts]  simonpj@microsoft.com committed Apr 03, 2009 778   Simon Peyton Jones committed Sep 26, 2014 779 arityType env (Let b e)  Simon Peyton Jones committed Nov 16, 2011 780  = floatIn (cheap_bind b) (arityType env e)  simonpj@microsoft.com committed Jan 13, 2009 781 782 783  where cheap_bind (NonRec b e) = is_cheap (b,e) cheap_bind (Rec prs) = all is_cheap prs  Simon Peyton Jones committed Nov 16, 2011 784  is_cheap (b,e) = ae_cheap_fn env e (Just (idType b))  simonpj@microsoft.com committed Dec 21, 2010 785   Simon Peyton Jones committed Nov 16, 2011 786 787 arityType env (Tick t e) | not (tickishIsCode t) = arityType env e  Simon Marlow committed Nov 02, 2011 788   Simon Peyton Jones committed Nov 16, 2011 789 arityType _ _ = vanillaArityType  Simon Peyton Jones committed Sep 26, 2014 790   Austin Seipp committed Dec 03, 2014 791 {-  eir@cis.upenn.edu committed Dec 11, 2015 792 793 %************************************************************************ %* *  Simon Peyton Jones committed Sep 26, 2014 794  The main eta-expander  eir@cis.upenn.edu committed Dec 11, 2015 795 796 %* * %************************************************************************  simonpj@microsoft.com committed Jan 13, 2009 797   simonpj@microsoft.com committed Sep 24, 2010 798 799 We go for: f = \x1..xn -> N ==> f = \x1..xn y1..ym -> N y1..ym  Simon Peyton Jones committed Sep 26, 2014 800  (n >= 0)  simonpj@microsoft.com committed Sep 24, 2010 801   Simon Peyton Jones committed Sep 26, 2014 802 where (in both cases)  simonpj@microsoft.com committed Sep 24, 2010 803   Simon Peyton Jones committed Sep 26, 2014 804  * The xi can include type variables  simonpj@microsoft.com committed Sep 24, 2010 805   Simon Peyton Jones committed Sep 26, 2014 806  * The yi are all value variables  simonpj@microsoft.com committed Sep 24, 2010 807   Simon Peyton Jones committed Sep 26, 2014 808 809  * N is a NORMAL FORM (i.e. no redexes anywhere) wanting a suitable number of extra args.  simonpj@microsoft.com committed Sep 24, 2010 810 811 812  The biggest reason for doing this is for cases like  Simon Peyton Jones committed Sep 26, 2014 813 814 815  f = \x -> case x of True -> \y -> e1 False -> \y -> e2  simonpj@microsoft.com committed Sep 24, 2010 816   Simon Peyton Jones committed Jun 06, 2013 817 Here we want to get the lambdas together. A good example is the nofib  simonpj@microsoft.com committed Sep 24, 2010 818 819 820 821 822 823 824 825 826 827 828 829 830 831 program fibheaps, which gets 25% more allocation if you don't do this eta-expansion. We may have to sandwich some coerces between the lambdas to make the types work. exprEtaExpandArity looks through coerces when computing arity; and etaExpand adds the coerces as necessary when actually computing the expansion. Note [No crap in eta-expanded code] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The eta expander is careful not to introduce "crap". In particular, given a CoreExpr satisfying the 'CpeRhs' invariant (in CorePrep), it returns a CoreExpr satisfying the same invariant. See Note [Eta expansion and the CorePrep invariants] in CorePrep.  simonpj@microsoft.com committed Jan 13, 2009 832 833  This means the eta-expander has to do a bit of on-the-fly  Simon Peyton Jones committed Sep 26, 2014 834 simplification but it's not too hard. The alernative, of relying on  simonpj@microsoft.com committed Jan 13, 2009 835 836 837 a subsequent clean-up phase of the Simplifier to de-crapify the result, means you can't really use it in CorePrep, which is painful.  simonpj@microsoft.com committed Oct 29, 2009 838 839 840 Note [Eta expansion and SCCs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Note that SCCs are not treated specially by etaExpand. If we have  Simon Peyton Jones committed Sep 26, 2014 841 842  etaExpand 2 (\x -> scc "foo" e) = (\xy -> (scc "foo" e) y)  simonpj@microsoft.com committed Oct 29, 2009 843 So the costs of evaluating 'e' (not 'e y') are attributed to "foo"  Peter Wortmann committed Dec 16, 2014 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859  Note [Eta expansion and source notes] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CorePrep puts floatable ticks outside of value applications, but not type applications. As a result we might be trying to eta-expand an expression like (src<...> v) @a which we want to lead to code like \x -> src<...> v @a x This means that we need to look through type applications and be ready to re-add floats on the top.  Austin Seipp committed Dec 03, 2014 860 -}  simonpj@microsoft.com committed Oct 29, 2009 861   Edward Z. Yang committed Jun 08, 2016 862 -- | @etaExpand n e@ returns an expression with  simonpj@microsoft.com committed Jan 13, 2009 863 864 865 866 -- the same meaning as @e@, but with arity @n@. -- -- Given: --  Edward Z. Yang committed Jun 08, 2016 867 -- > e' = etaExpand n e  simonpj@microsoft.com committed Jan 13, 2009 868 869 870 871 -- -- We should have that: -- -- > ty = exprType e = exprType e'  Simon Peyton Jones committed Sep 26, 2014 872 873 874 etaExpand :: Arity -- ^ Result should have this number of value args -> CoreExpr -- ^ Expression to expand -> CoreExpr  Ömer Sinan Ağacan committed Jul 21, 2016 875 876 877 -- etaExpand arity e = res -- Then 'res' has at least 'arity' lambdas at the top --  simonpj@microsoft.com committed Jan 13, 2009 878 -- etaExpand deals with for-alls. For example:  Simon Peyton Jones committed Sep 26, 2014 879 -- etaExpand 1 E  simonpj@microsoft.com committed Jan 13, 2009 880 881 -- where E :: forall a. a -> a -- would return  Simon Peyton Jones committed Sep 26, 2014 882 -- (/\b. \y::a -> E b y)  simonpj@microsoft.com committed Jan 13, 2009 883 884 885 886 887 888 889 -- -- It deals with coerces too, though they are now rare -- so perhaps the extra code isn't worth it etaExpand n orig_expr = go n orig_expr where  simonpj@microsoft.com committed Dec 24, 2009 890  -- Strip off existing lambdas and casts  simonpj@microsoft.com committed Apr 03, 2009 891  -- Note [Eta expansion and SCCs]  simonpj@microsoft.com committed Jan 13, 2009 892  go 0 expr = expr  893  go n (Lam v body) | isTyVar v = Lam v (go n body)  Simon Peyton Jones committed Sep 26, 2014 894  | otherwise = Lam v (go (n-1) body)  Peter Wortmann committed Dec 16, 2014 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909  go n (Cast expr co) = Cast (go n expr) co go n expr = -- pprTrace "ee" (vcat [ppr orig_expr, ppr expr, ppr etas])$ retick \$ etaInfoAbs etas (etaInfoApp subst' sexpr etas) where in_scope = mkInScopeSet (exprFreeVars expr) (in_scope', etas) = mkEtaWW n orig_expr in_scope (exprType expr) subst' = mkEmptySubst in_scope' -- Find ticks behind type apps. -- See Note [Eta expansion and source notes] (expr', args) = collectArgs expr (ticks, expr'') = stripTicksTop tickishFloatable expr' sexpr = foldl App expr'' args retick expr = foldr mkTick expr ticks  simonpj@microsoft.com committed Jan 13, 2009 910   Simon Peyton Jones committed Sep 26, 2014 911  -- Wrapper Unwrapper  simonpj@microsoft.com committed Jan 13, 2009 912 --------------