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