ghc/compiler/simplCore/SimplCore.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[SimplCore]{Driver for simplifying @Core@ programs}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module SimplCore (
  10         core2core,
  11
  12         IdEnv(..),
  13         UnfoldingDetails,
  14         SpecialiseData(..),
  15         UniqFM, Unique, Bag
  16     ) where
  17
  18 IMPORT_Trace
  19 import Outputable
  20 import Pretty
  21
  22 import PlainCore
  23
  24 import AbsUniType       ( getTyConDataCons, alpha_ty, alpha_tyvar, beta_ty, beta_tyvar )
  25 --SAVE:import ArityAnal ( arityAnalProgram )
  26 import Bag
  27 import BinderInfo       ( BinderInfo) -- instances only
  28 import CgCompInfo       ( uNFOLDING_CREATION_THRESHOLD,
  29                           uNFOLDING_USE_THRESHOLD,
  30                           uNFOLDING_OVERRIDE_THRESHOLD,
  31                           uNFOLDING_CON_DISCOUNT_WEIGHT
  32                         )
  33 import CmdLineOpts
  34 import CoreLint         ( lintCoreBindings )
  35 import FloatIn          ( floatInwards )
  36 import FloatOut         ( floatOutwards )
  37 import Id               ( getIdUnfolding,
  38                           getIdUniType, toplevelishId,
  39                           idWantsToBeINLINEd,
  40                           unfoldingUnfriendlyId, isWrapperId,
  41                           mkTemplateLocals
  42                           IF_ATTACK_PRAGMAS(COMMA getIdStrictness)
  43                         )
  44 import IdEnv
  45 import IdInfo
  46 import LiberateCase     ( liberateCase )
  47 import MainMonad
  48 import Maybes
  49 import SAT              ( doStaticArgs )
  50 import SCCauto
  51 import SimplEnv         ( UnfoldingGuidance(..), SwitchChecker(..) ) -- instances
  52 --ANDY:
  53 --import SimplHaskell   ( coreToHaskell )
  54 import SimplMonad       ( zeroSimplCount, showSimplCount, TickType, SimplCount )
  55 import SimplPgm         ( simplifyPgm )
  56 import SimplVar         ( leastItCouldCost )
  57 import Specialise
  58 import SpecTyFuns       ( pprSpecErrs )
  59 import StrictAnal       ( saWwTopBinds )
  60 #if ! OMIT_FOLDR_BUILD
  61 import FoldrBuildWW
  62 import AnalFBWW
  63 #endif
  64 #if ! OMIT_DEFORESTER
  65 import Deforest         ( deforestProgram )
  66 import DefUtils         ( deforestable )
  67 #endif
  68 import TyVarEnv         ( nullTyVarEnv )
  69 import SplitUniq
  70 import Unique
  71 import Util
  72 \end{code}
  73
  74 \begin{code}
  75 core2core :: [CoreToDo]                 -- spec of what core-to-core passes to do
  76           -> (GlobalSwitch->SwitchResult)-- "global" command-line info lookup fn
  77           -> FAST_STRING                -- module name (profiling only)
  78           -> PprStyle                   -- printing style (for debugging only)
  79           -> SplitUniqSupply            -- a name supply
  80           -> [TyCon]                    -- local data tycons and tycon specialisations
  81           -> FiniteMap TyCon [(Bool, [Maybe UniType])]
  82           -> [PlainCoreBinding]         -- input...
  83           -> MainIO
  84               ([PlainCoreBinding],      -- results: program, plus...
  85                IdEnv UnfoldingDetails,  --  unfoldings to be exported from here
  86               SpecialiseData)           --  specialisation data
  87
  88 core2core core_todos sw_chkr module_name ppr_style us local_tycons tycon_specs binds
  89   = BSCC("Core2Core")
  90     if null core_todos then -- very rare, I suspect...
  91         -- well, we still must do some renumbering
  92         returnMn (
  93         (snd (instCoreBindings (mkUniqueSupplyGrimily us) binds), nullIdEnv, init_specdata)
  94         )
  95     else
  96         (if do_verbose_core2core then
  97             writeMn stderr "VERBOSE CORE-TO-CORE:\n"
  98          else returnMn ()) `thenMn_`
  99
 100         -- better do the main business
 101         foldl_mn do_core_pass
 102                 (binds, us, nullIdEnv, init_specdata, zeroSimplCount)
 103                 core_todos
 104                 `thenMn` \ (processed_binds, _, inline_env, spec_data, simpl_stats) ->
 105
 106         (if  switch_is_on D_simplifier_stats
 107          then writeMn stderr ("\nSimplifier Stats:\n")
 108                 `thenMn_`
 109               writeMn stderr (showSimplCount simpl_stats)
 110                 `thenMn_`
 111               writeMn stderr "\n"
 112          else returnMn ()
 113         ) `thenMn_`
 114
 115         returnMn (processed_binds, inline_env, spec_data)
 116     ESCC
 117   where
 118     init_specdata = initSpecData local_tycons tycon_specs
 119
 120     switch_is_on = switchIsOn sw_chkr
 121
 122     do_verbose_core2core = switch_is_on D_verbose_core2core
 123
 124     lib_case_threshold  -- ToDo: HACK HACK HACK : FIX ME FIX ME FIX ME
 125                         -- Use 4x a known threshold
 126       = case (intSwitchSet sw_chkr UnfoldingOverrideThreshold) of
 127           Nothing -> 4 * uNFOLDING_USE_THRESHOLD
 128           Just xx -> 4 * xx
 129
 130     -------------
 131     core_linter = if switch_is_on DoCoreLinting
 132                   then lintCoreBindings ppr_style
 133                   else ( \ whodunnit spec_done binds -> binds )
 134
 135     --------------
 136     do_core_pass info@(binds, us, inline_env, spec_data, simpl_stats) to_do
 137       = let
 138             (us1, us2) = splitUniqSupply us
 139         in
 140         case to_do of
 141           CoreDoSimplify simpl_sw_chkr
 142             -> BSCC("CoreSimplify")
 143                begin_pass ("Simplify" ++ if switchIsOn simpl_sw_chkr SimplDoFoldrBuild
 144                                          then " (foldr/build)" else "") `thenMn_`
 145                case (simplifyPgm binds sw_chkr simpl_sw_chkr simpl_stats us1) of
 146                  (p, it_cnt, simpl_stats2)
 147                    -> end_pass False us2 p inline_env spec_data simpl_stats2
 148                                ("Simplify (" ++ show it_cnt ++ ")"
 149                                  ++ if switchIsOn simpl_sw_chkr SimplDoFoldrBuild
 150                                     then " foldr/build" else "")
 151                ESCC
 152
 153           CoreDoFoldrBuildWorkerWrapper
 154 #if OMIT_FOLDR_BUILD
 155             -> error "ERROR: CoreDoFoldrBuildWorkerWrapper: not built into compiler\n"
 156 #else
 157             -> BSCC("CoreDoFoldrBuildWorkerWrapper")
 158                begin_pass "FBWW" `thenMn_`
 159                case (mkFoldrBuildWW switch_is_on us1 binds) of { binds2 ->
 160                end_pass False us2 binds2 inline_env spec_data simpl_stats "FBWW"
 161                } ESCC
 162 #endif
 163
 164           CoreDoFoldrBuildWWAnal
 165 #if OMIT_FOLDR_BUILD
 166             -> error "ERROR: CoreDoFoldrBuildWWAnal: not built into compiler\n"
 167 #else
 168             -> BSCC("CoreDoFoldrBuildWWAnal")
 169                begin_pass "AnalFBWW" `thenMn_`
 170                case (analFBWW switch_is_on binds) of { binds2 ->
 171                end_pass False us2 binds2 inline_env spec_data simpl_stats "AnalFBWW"
 172                } ESCC
 173 #endif
 174
 175           CoreLiberateCase
 176             -> BSCC("LiberateCase")
 177                begin_pass "LiberateCase" `thenMn_`
 178                case (liberateCase lib_case_threshold binds) of { binds2 ->
 179                end_pass False us2 binds2 inline_env spec_data simpl_stats "LiberateCase"
 180                } ESCC
 181
 182           CoreDoCalcInlinings1  -- avoid inlinings w/ cost-centres
 183             -> BSCC("CoreInlinings1")
 184                begin_pass "CalcInlinings" `thenMn_`
 185                case (calcInlinings False sw_chkr inline_env binds) of { inline_env2 ->
 186                end_pass False us2 binds inline_env2 spec_data simpl_stats "CalcInlinings"
 187                } ESCC
 188
 189           CoreDoCalcInlinings2  -- allow inlinings w/ cost-centres
 190             -> BSCC("CoreInlinings2")
 191                begin_pass "CalcInlinings" `thenMn_`
 192                case (calcInlinings True sw_chkr inline_env binds) of { inline_env2 ->
 193                end_pass False us2 binds inline_env2 spec_data simpl_stats "CalcInlinings"
 194                } ESCC
 195
 196           CoreDoFloatInwards
 197             -> BSCC("FloatInwards")
 198                begin_pass "FloatIn" `thenMn_`
 199                case (floatInwards binds) of { binds2 ->
 200                end_pass False us2 binds2 inline_env spec_data simpl_stats "FloatIn"
 201                } ESCC
 202
 203           CoreDoFullLaziness
 204             -> BSCC("CoreFloating")
 205                begin_pass "FloatOut" `thenMn_`
 206                case (floatOutwards switch_is_on us1 binds) of { binds2 ->
 207                end_pass False us2 binds2 inline_env spec_data simpl_stats "FloatOut"
 208                } ESCC
 209
 210           CoreDoStaticArgs
 211             -> BSCC("CoreStaticArgs")
 212                begin_pass "StaticArgs" `thenMn_`
 213                case (doStaticArgs binds us1) of { binds2 ->
 214                end_pass False us2 binds2 inline_env spec_data simpl_stats "StaticArgs"
 215                 -- Binds really should be dependency-analysed for static-
 216                 -- arg transformation... Not to worry, they probably are.
 217                 -- (I don't think it *dies* if they aren't [WDP 94/04/15])
 218                } ESCC
 219
 220           CoreDoStrictness
 221             -> BSCC("CoreStranal")
 222                begin_pass "StrAnal" `thenMn_`
 223                case (saWwTopBinds us1 switch_is_on binds) of { binds2 ->
 224                end_pass False us2 binds2 inline_env spec_data simpl_stats "StrAnal"
 225                } ESCC
 226
 227           CoreDoSpecialising
 228             -> BSCC("Specialise")
 229                begin_pass "Specialise" `thenMn_`
 230                case (specProgram switch_is_on us1 binds spec_data) of {
 231                  (p, spec_data2@(SpecData _ spec_noerrs _ _ _
 232                                           spec_errs spec_warn spec_tyerrs)) ->
 233
 234                    -- if we got errors, we die straight away
 235                    (if not spec_noerrs ||
 236                        (switch_is_on ShowImportSpecs && not (isEmptyBag spec_warn)) then
 237                         writeMn stderr (ppShow 1000 {-pprCols-}
 238                             (pprSpecErrs module_name spec_errs spec_warn spec_tyerrs))
 239                         `thenMn_` writeMn stderr "\n"
 240                     else
 241                         returnMn ()) `thenMn_`
 242
 243                    (if not spec_noerrs then -- Stop here if specialisation errors occured
 244                         exitMn 1
 245                    else
 246                         returnMn ()) `thenMn_`
 247
 248                    end_pass False us2 p inline_env spec_data2 simpl_stats "Specialise"
 249                }
 250                ESCC
 251
 252           CoreDoDeforest
 253 #if OMIT_DEFORESTER
 254             -> error "ERROR: CoreDoDeforest: not built into compiler\n"
 255 #else
 256             -> BSCC("Deforestation")
 257                begin_pass "Deforestation" `thenMn_`
 258                case (deforestProgram sw_chkr binds us1) of { binds2 ->
 259                end_pass False us2 binds2 inline_env spec_data simpl_stats "Deforestation"
 260                }
 261                ESCC
 262 #endif
 263
 264           CoreDoAutoCostCentres
 265             -> BSCC("AutoSCCs")
 266                begin_pass "AutoSCCs" `thenMn_`
 267                case (addAutoCostCentres sw_chkr module_name binds) of { binds2 ->
 268                end_pass False us2 binds2 inline_env spec_data simpl_stats "AutoSCCs"
 269                }
 270                ESCC
 271
 272           CoreDoPrintCore       -- print result of last pass
 273             -> end_pass True us2 binds inline_env spec_data simpl_stats "Print"
 274
 275
 276     -------------------------------------------------
 277
 278     begin_pass
 279       = if switch_is_on D_show_passes
 280         then \ what -> writeMn stderr ("*** Core2Core: "++what++"\n")
 281         else \ what -> returnMn ()
 282
 283     end_pass print us2 binds2 inline_env2
 284              spec_data2@(SpecData spec_done _ _ _ _ _ _ _)
 285              simpl_stats2 what
 286       = -- report verbosely, if required
 287         (if (do_verbose_core2core && not print) ||
 288             (print && not do_verbose_core2core)
 289          then
 290             writeMn stderr ("\n*** "++what++":\n")
 291                 `thenMn_`
 292             writeMn stderr (ppShow 1000
 293                 (ppAboves (map (pprPlainCoreBinding ppr_style) binds2)))
 294                 `thenMn_`
 295             writeMn stderr "\n"
 296          else
 297             returnMn ()) `thenMn_`
 298         let
 299             linted_binds = core_linter what spec_done binds2
 300         in
 301         returnMn
 302         (linted_binds,  -- processed binds, possibly run thru CoreLint
 303          us2,           -- UniqueSupply for the next guy
 304          inline_env2,   -- possibly-updated inline env
 305          spec_data2,    -- possibly-updated specialisation info
 306          simpl_stats2   -- accumulated simplifier stats
 307         )
 308
 309 -- here so it can be inlined...
 310 foldl_mn f z []     = returnMn z
 311 foldl_mn f z (x:xs) = f z x     `thenMn` \ zz ->
 312                      foldl_mn f zz xs
 313 \end{code}
 314
 315 --- ToDo: maybe move elsewhere ---
 316
 317 For top-level, exported binders that either (a)~have been INLINEd by
 318 the programmer or (b)~are sufficiently ``simple'' that they should be
 319 inlined, we want to record this info in a suitable IdEnv.
 320
 321 But: if something has a ``wrapper unfolding,'' we do NOT automatically
 322 give it a regular unfolding (exception below).  We usually assume its
 323 worker will get a ``regular'' unfolding.  We can then treat these two
 324 levels of unfolding separately (we tend to be very friendly towards
 325 wrapper unfoldings, for example), giving more fine-tuned control.
 326
 327 The exception is: If the ``regular unfolding'' mentions no other
 328 global Ids (i.e., it's all PrimOps and cases and local Ids) then we
 329 assume it must be really good and we take it anyway.
 330
 331 We also need to check that everything in the RHS (values and types)
 332 will be visible on the other side of an interface, too.
 333
 334 \begin{code}
 335 calcInlinings :: Bool   -- True => inlinings with _scc_s are OK
 336               -> (GlobalSwitch -> SwitchResult)
 337               -> IdEnv UnfoldingDetails
 338               -> [PlainCoreBinding]
 339               -> IdEnv UnfoldingDetails
 340
 341 calcInlinings scc_s_OK sw_chkr inline_env_so_far top_binds
 342   = let
 343         result = foldl calci inline_env_so_far top_binds
 344     in
 345     --pprTrace "inline env:\n" (ppAboves (map pp_item (getIdEnvMapping result)))
 346     result
 347   where
 348     pp_item (binder, details)
 349       = ppCat [ppr PprDebug binder, ppStr "=>", pp_det details]
 350       where
 351         pp_det NoUnfoldingDetails   = ppStr "_N_"
 352         pp_det (IWantToBeINLINEd _) = ppStr "INLINE"
 353         pp_det (GeneralForm _ _ expr guide)
 354           = ppAbove (ppr PprDebug guide) (ppr PprDebug expr)
 355         pp_det other                = ppStr "???"
 356
 357     ------------
 358     switch_is_on = switchIsOn sw_chkr
 359
 360     my_trace =  if (switch_is_on ReportWhyUnfoldingsDisallowed)
 361                 then trace
 362                 else \ msg stuff -> stuff
 363
 364     (unfolding_creation_threshold, explicit_creation_threshold)
 365       = case (intSwitchSet sw_chkr UnfoldingCreationThreshold) of
 366           Nothing -> (uNFOLDING_CREATION_THRESHOLD, False)
 367           Just xx -> (xx, True)
 368
 369     unfold_use_threshold
 370       = case (intSwitchSet sw_chkr UnfoldingUseThreshold) of
 371           Nothing -> uNFOLDING_USE_THRESHOLD
 372           Just xx -> xx
 373
 374     unfold_override_threshold
 375       = case (intSwitchSet sw_chkr UnfoldingOverrideThreshold) of
 376           Nothing -> uNFOLDING_OVERRIDE_THRESHOLD
 377           Just xx -> xx
 378
 379     con_discount_weight = uNFOLDING_CON_DISCOUNT_WEIGHT
 380
 381     calci inline_env (CoRec pairs)
 382       = foldl (calc True{-recursive-}) inline_env pairs
 383
 384     calci inline_env bind@(CoNonRec binder rhs)
 385       = calc False{-not recursive-} inline_env (binder, rhs)
 386
 387     ---------------------------------------
 388
 389     calc is_recursive inline_env (binder, rhs)
 390       | not (toplevelishId binder)
 391       = --pprTrace "giving up on not top-level:" (ppr PprDebug binder)
 392         ignominious_defeat
 393
 394       | rhs_mentions_an_unmentionable
 395       || (not explicit_INLINE_requested
 396           && (rhs_looks_like_a_caf || guidance_says_don't || guidance_size_too_big))
 397       = let
 398             my_my_trace
 399               = if explicit_INLINE_requested
 400                 && not (isWrapperId binder) -- these always claim to be INLINEd
 401                 && not have_inlining_already
 402                 then trace                  -- we'd better have a look...
 403                 else my_trace
 404
 405             which = if scc_s_OK then " (late):" else " (early):"
 406         in
 407         --pprTrace "giving up on size:" (ppCat [ppr PprDebug binder, ppr PprDebug
 408         --      [rhs_mentions_an_unmentionable, explicit_INLINE_requested,
 409         --       rhs_looks_like_a_caf, guidance_says_don't, guidance_size_too_big]]) (
 410         my_my_trace ("unfolding disallowed for"++which++(ppShow 80 (ppr PprDebug binder))) (
 411         ignominious_defeat
 412         )
 413         --)
 414
 415       | rhs `isWrapperFor` binder
 416         -- Don't add an explicit "unfolding"; let the worker/wrapper
 417         -- stuff do its thing.  INLINE things don't get w/w'd, so
 418         -- they will be OK.
 419       = --pprTrace "giving up on isWrapperFor:" (ppr PprDebug binder)
 420         ignominious_defeat
 421
 422 #if ! OMIT_DEFORESTER
 423         -- For the deforester: bypass the barbed wire for recursive
 424         -- functions that want to be inlined and are tagged deforestable
 425         -- by the user, allowing these things to be communicated
 426         -- across module boundaries.
 427
 428       | is_recursive &&
 429         explicit_INLINE_requested &&
 430         deforestable binder &&
 431         scc_s_OK                        -- hack, only get them in
 432                                         -- calc_inlinings2
 433       = glorious_success UnfoldAlways
 434 #endif
 435
 436       | is_recursive && not rhs_looks_like_a_data_val
 437         -- The only recursive defns we are prepared to tolerate at the
 438         -- moment is top-level very-obviously-a-data-value ones.
 439         -- We *need* these for dictionaries to be exported!
 440       = --pprTrace "giving up on rec:" (ppr PprDebug binder)
 441         ignominious_defeat
 442
 443         -- Not really interested unless it's exported, but doing it
 444         -- this way (not worrying about export-ness) gets us all the
 445         -- workers/specs, etc., too; which we will need for generating
 446         -- interfaces.  We are also not interested if this binder is
 447         -- in the environment we already have (perhaps from a previous
 448         -- run of calcInlinings -- "earlier" is presumed to mean
 449         -- "better").
 450
 451       | explicit_INLINE_requested
 452       = glorious_success UnfoldAlways
 453
 454       | otherwise
 455       = glorious_success guidance
 456
 457       where
 458         guidance
 459           = calcUnfoldingGuidance scc_s_OK max_out_threshold rhs
 460           where
 461             max_out_threshold = if explicit_INLINE_requested
 462                                 then 100000 -- you asked for it, you got it
 463                                 else unfolding_creation_threshold
 464
 465         guidance_size
 466           = case guidance of
 467               UnfoldAlways                -> 0 -- *extremely* small
 468               EssentialUnfolding          -> 0 -- ditto
 469               UnfoldIfGoodArgs _ _ _ size -> size
 470
 471         guidance_says_don't = case guidance of { UnfoldNever -> True; _ -> False }
 472
 473         guidance_size_too_big
 474             -- Does the guidance suggest that this unfolding will
 475             -- be of no use *no matter* the arguments given to it?
 476             -- Could be more sophisticated...
 477           = case guidance of
 478               UnfoldAlways       -> False
 479               EssentialUnfolding -> False
 480               UnfoldIfGoodArgs _ no_val_args arg_info_vec size
 481
 482                 -> if explicit_creation_threshold then
 483                       False     -- user set threshold; don't second-guess...
 484
 485                    else if no_val_args == 0 && rhs_looks_like_a_data_val then
 486                       False     -- we'd like a top-level data constr to be
 487                                 -- visible even if it is never unfolded
 488                    else
 489                       let
 490                           cost
 491                             = leastItCouldCost con_discount_weight size no_val_args
 492                                 arg_info_vec rhs_arg_tys
 493                       in
 494 --                    (if (unfold_use_threshold < cost) then (pprTrace "cost:" (ppInt cost)) else \x->x ) (
 495                       unfold_use_threshold < cost
 496 --                    )
 497
 498
 499         rhs_looks_like_a_caf = not (manifestlyWHNF rhs)
 500
 501         rhs_looks_like_a_data_val
 502           = case digForLambdas rhs of
 503               (_, [], CoCon _ _ _) -> True
 504               other                -> False
 505
 506         rhs_arg_tys
 507           = case digForLambdas rhs of
 508               (_, val_binders, _) -> map getIdUniType val_binders
 509
 510         (mentioned_ids, _, _, mentions_litlit)
 511           = mentionedInUnfolding (\x -> x) rhs
 512
 513         rhs_mentions_an_unmentionable
 514           = --pprTrace "mentions:" (ppCat [ppr PprDebug binder, ppr PprDebug [(i,unfoldingUnfriendlyId i) | i <- mentioned_ids ]]) (
 515             any unfoldingUnfriendlyId mentioned_ids
 516             || mentions_litlit
 517             --)
 518             -- ToDo: probably need to chk tycons/classes...
 519
 520         mentions_no_other_ids = null mentioned_ids
 521
 522         explicit_INLINE_requested
 523             -- did it come from a user {-# INLINE ... #-}?
 524             -- (Warning: must avoid including wrappers.)
 525           = idWantsToBeINLINEd binder
 526             && not (rhs `isWrapperFor` binder)
 527
 528         have_inlining_already = maybeToBool (lookupIdEnv inline_env binder)
 529
 530         ignominious_defeat = inline_env  -- just give back what we got
 531
 532         {-
 533             "glorious_success" is ours if we've found a suitable unfolding.
 534
 535             But we check for a couple of fine points.
 536
 537             (1) If this Id already has an inlining in the inline_env,
 538                 we don't automatically take it -- the earlier one is
 539                 "likely" to be better.
 540
 541                 But if the new one doesn't mention any other global
 542                 Ids, and it's pretty small (< UnfoldingOverrideThreshold),
 543                 then we take the chance that the new one *is* better.
 544
 545             (2) If we have an Id w/ a worker/wrapper split (with
 546                 an unfolding for the wrapper), we tend to want to keep
 547                 it -- and *nuke* any inlining that we conjured up
 548                 earlier.
 549
 550                 But, again, if this unfolding doesn't mention any
 551                 other global Ids (and small enough), then it is
 552                 probably better than the worker/wrappery, so we take
 553                 it.
 554         -}
 555         glorious_success guidance
 556           = let
 557                 new_env = addOneToIdEnv inline_env binder (mkUnfolding guidance rhs)
 558
 559                 foldr_building = switch_is_on FoldrBuildOn
 560             in
 561             if (not have_inlining_already) then
 562                 -- Not in env: we take it no matter what
 563                 -- NB: we could check for worker/wrapper-ness,
 564                 -- but the truth is we probably haven't run
 565                 -- the strictness analyser yet.
 566                 new_env
 567
 568             else if explicit_INLINE_requested then
 569                 -- If it was a user INLINE, then we know it's already
 570                 -- in the inline_env; we stick with what we already
 571                 -- have.
 572                 --pprTrace "giving up on INLINE:" (ppr PprDebug binder)
 573                 ignominious_defeat
 574
 575             else if isWrapperId binder then
 576                 -- It's in the env, but we have since worker-wrapperised;
 577                 -- we either take this new one (because it's so good),
 578                 -- or we *undo* the one in the inline_env, so the
 579                 -- wrapper-inlining will take over.
 580
 581                 if mentions_no_other_ids {- *** && size <= unfold_override_threshold -} then
 582                     new_env
 583                 else
 584                     delOneFromIdEnv inline_env binder
 585
 586             else
 587                 -- It's in the env, nothing to do w/ worker wrapper;
 588                 -- we'll take it if it is better.
 589
 590                 if not foldr_building   -- ANDY hates us... (see below)
 591                 && mentions_no_other_ids
 592                 && guidance_size <= unfold_override_threshold then
 593                     new_env
 594                 else
 595                     --pprTrace "giving up on final hurdle:" (ppCat [ppr PprDebug binder, ppInt guidance_size, ppInt unfold_override_threshold])
 596                     ignominious_defeat -- and at the last hurdle, too!
 597 \end{code}
 598
 599 ANDY, on the hatred of the check above; why obliterate it?  Consider
 600
 601  head xs = foldr (\ x _ -> x) (_|_) xs
 602
 603 This then is exported via a pragma. However,
 604 *if* you include the extra code above, you will
 605 export the non-foldr/build version.