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