ghc/compiler/simplCore/SimplCore.lhs

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