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