SimplCore.lhs 18.8 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
3 4 5 6 7 8
%
\section[SimplCore]{Driver for simplifying @Core@ programs}

\begin{code}
#include "HsVersions.h"

9
module SimplCore ( core2core ) where
10

11 12 13 14 15
import Ubiq{-uitous-}

import AnalFBWW		( analFBWW )
import Bag		( isEmptyBag, foldBag )
import BinderInfo	( BinderInfo{-instance Outputable-} )
16 17 18 19 20
import CgCompInfo	( uNFOLDING_CREATION_THRESHOLD,
			  uNFOLDING_USE_THRESHOLD,
			  uNFOLDING_OVERRIDE_THRESHOLD,
			  uNFOLDING_CON_DISCOUNT_WEIGHT
			)
21 22 23 24 25 26 27 28 29 30 31 32
import CmdLineOpts	( CoreToDo(..), SimplifierSwitch(..), switchIsOn,
			  opt_D_show_passes,
			  opt_D_simplifier_stats,
			  opt_D_verbose_core2core,
			  opt_DoCoreLinting,
			  opt_FoldrBuildOn,
			  opt_ReportWhyUnfoldingsDisallowed,
			  opt_ShowImportSpecs,
			  opt_UnfoldingCreationThreshold,
			  opt_UnfoldingOverrideThreshold,
			  opt_UnfoldingUseThreshold
			)
33
import CoreLint		( lintCoreBindings )
34 35 36
import CoreSyn
import CoreUnfold
import CoreUtils	( substCoreBindings, manifestlyWHNF )
37
import ErrUtils		( ghcExit )
38 39
import FloatIn		( floatInwards )
import FloatOut		( floatOutwards )
40 41 42 43 44 45
import FoldrBuildWW	( mkFoldrBuildWW )
import Id		( idType, toplevelishId, idWantsToBeINLINEd,
			  unfoldingUnfriendlyId,
			  nullIdEnv, addOneToIdEnv, delOneFromIdEnv,
			  lookupIdEnv, IdEnv(..),
			  GenId{-instance Outputable-}
46
			)
47
import IdInfo		( mkUnfolding )
48
import LiberateCase	( liberateCase )
49 50 51 52 53 54 55
import MagicUFs		( MagicUnfoldingFun )
import Maybes		( maybeToBool )
import Outputable	( Outputable(..){-instance * (,) -} )
import PprCore		( pprCoreBinding, GenCoreExpr{-instance Outputable-} )
import PprStyle		( PprStyle(..) )
import PprType		( GenType{-instance Outputable-}, GenTyVar{-ditto-} )
import Pretty		( ppShow, ppAboves, ppAbove, ppCat, ppStr )
56
import SAT		( doStaticArgs )
57 58
import SCCauto		( addAutoCostCentres )
import SimplMonad	( zeroSimplCount, showSimplCount, SimplCount )
59 60 61
import SimplPgm		( simplifyPgm )
import SimplVar		( leastItCouldCost )
import Specialise
62
import SpecUtils	( pprSpecErrs )
63
import StrictAnal	( saWwTopBinds )
64 65 66 67 68
import TyVar		( nullTyVarEnv, GenTyVar{-instance Eq-} )
import Unique		( Unique{-instance Eq-} )
import UniqSupply	( splitUniqSupply )
import Util		( panic{-ToDo:rm-} )

69 70 71 72
#if ! OMIT_DEFORESTER
import Deforest		( deforestProgram )
import DefUtils		( deforestable )
#endif
73 74 75

isWrapperFor = panic "SimplCore.isWrapperFor (ToDo)"
isWrapperId = panic "SimplCore.isWrapperId (ToDo)"
76 77 78 79 80 81
\end{code}

\begin{code}
core2core :: [CoreToDo]			-- spec of what core-to-core passes to do
	  -> FAST_STRING		-- module name (profiling only)
	  -> PprStyle			-- printing style (for debugging only)
82
	  -> UniqSupply		-- a name supply
83
	  -> [TyCon]			-- local data tycons and tycon specialisations
84 85
	  -> FiniteMap TyCon [(Bool, [Maybe Type])]
	  -> [CoreBinding]		-- input...
86
	  -> IO
87
	      ([CoreBinding],	-- results: program, plus...
88 89 90
	       IdEnv UnfoldingDetails,	--  unfoldings to be exported from here
	      SpecialiseData)		--  specialisation data

91
core2core core_todos module_name ppr_style us local_tycons tycon_specs binds
92
  = if null core_todos then -- very rare, I suspect...
93
	-- well, we still must do some renumbering
94
	return (
95 96 97
	(substCoreBindings nullIdEnv nullTyVarEnv binds us,
	 nullIdEnv,
	 init_specdata)
98 99 100
	)
    else
	(if do_verbose_core2core then
101 102
	    hPutStr stderr "VERBOSE CORE-TO-CORE:\n"
	 else return ()) >>
103 104 105 106 107

	-- better do the main business
	foldl_mn do_core_pass
		(binds, us, nullIdEnv, init_specdata, zeroSimplCount)
		core_todos
108
		>>= \ (processed_binds, _, inline_env, spec_data, simpl_stats) ->
109

110
	(if  opt_D_simplifier_stats
111 112 113 114 115 116 117 118 119
	 then hPutStr stderr ("\nSimplifier Stats:\n")
		>>
	      hPutStr stderr (showSimplCount simpl_stats)
		>>
	      hPutStr stderr "\n"
	 else return ()
	) >>

	return (processed_binds, inline_env, spec_data)
120 121 122
  where
    init_specdata = initSpecData local_tycons tycon_specs

123
    do_verbose_core2core = opt_D_verbose_core2core
124

125
    lib_case_threshold	-- ToDo: HACK HACK HACK : FIX ME FIX ME FIX ME
126
			-- Use 4x a known threshold
127
      = case opt_UnfoldingOverrideThreshold of
128 129 130 131
	  Nothing -> 4 * uNFOLDING_USE_THRESHOLD
	  Just xx -> 4 * xx

    -------------
132
    core_linter = if opt_DoCoreLinting
133 134 135 136 137 138 139 140 141 142
		  then lintCoreBindings ppr_style
		  else ( \ whodunnit spec_done binds -> binds )

    --------------
    do_core_pass info@(binds, us, inline_env, spec_data, simpl_stats) to_do
      = let
	    (us1, us2) = splitUniqSupply us
    	in
    	case to_do of
	  CoreDoSimplify simpl_sw_chkr
143
	    -> _scc_ "CoreSimplify"
144
	       begin_pass ("Simplify" ++ if switchIsOn simpl_sw_chkr SimplDoFoldrBuild
145
					 then " (foldr/build)" else "") >>
146
	       case (simplifyPgm binds simpl_sw_chkr simpl_stats us1) of
147
		 (p, it_cnt, simpl_stats2)
148
		   -> end_pass False us2 p inline_env spec_data simpl_stats2
149
			       ("Simplify (" ++ show it_cnt ++ ")"
150 151
				 ++ if switchIsOn simpl_sw_chkr SimplDoFoldrBuild
				    then " foldr/build" else "")
152 153

	  CoreDoFoldrBuildWorkerWrapper
154
	    -> _scc_ "CoreDoFoldrBuildWorkerWrapper"
155
	       begin_pass "FBWW" >>
156
	       case (mkFoldrBuildWW us1 binds) of { binds2 ->
157
	       end_pass False us2 binds2 inline_env spec_data simpl_stats "FBWW" }
158 159

	  CoreDoFoldrBuildWWAnal
160
	    -> _scc_ "CoreDoFoldrBuildWWAnal"
161
	       begin_pass "AnalFBWW" >>
162
	       case (analFBWW binds) of { binds2 ->
163
	       end_pass False us2 binds2 inline_env spec_data simpl_stats "AnalFBWW" }
164 165

	  CoreLiberateCase
166
	    -> _scc_ "LiberateCase"
167
	       begin_pass "LiberateCase" >>
168
	       case (liberateCase lib_case_threshold binds) of { binds2 ->
169
	       end_pass False us2 binds2 inline_env spec_data simpl_stats "LiberateCase" }
170 171

	  CoreDoCalcInlinings1	-- avoid inlinings w/ cost-centres
172
	    -> _scc_ "CoreInlinings1"
173
	       begin_pass "CalcInlinings" >>
174
	       case (calcInlinings False inline_env binds) of { inline_env2 ->
175
	       end_pass False us2 binds inline_env2 spec_data simpl_stats "CalcInlinings" }
176 177

	  CoreDoCalcInlinings2  -- allow inlinings w/ cost-centres
178
	    -> _scc_ "CoreInlinings2"
179
	       begin_pass "CalcInlinings" >>
180
	       case (calcInlinings True inline_env binds) of { inline_env2 ->
181
	       end_pass False us2 binds inline_env2 spec_data simpl_stats "CalcInlinings" }
182 183

	  CoreDoFloatInwards
184
	    -> _scc_ "FloatInwards"
185
	       begin_pass "FloatIn" >>
186
	       case (floatInwards binds) of { binds2 ->
187
	       end_pass False us2 binds2 inline_env spec_data simpl_stats "FloatIn" }
188 189

	  CoreDoFullLaziness
190
	    -> _scc_ "CoreFloating"
191
	       begin_pass "FloatOut" >>
192
	       case (floatOutwards us1 binds) of { binds2 ->
193
	       end_pass False us2 binds2 inline_env spec_data simpl_stats "FloatOut" }
194 195

	  CoreDoStaticArgs
196
	    -> _scc_ "CoreStaticArgs"
197
	       begin_pass "StaticArgs" >>
198
	       case (doStaticArgs binds us1) of { binds2 ->
199
	       end_pass False us2 binds2 inline_env spec_data simpl_stats "StaticArgs" }
200 201 202 203 204
		-- Binds really should be dependency-analysed for static-
		-- arg transformation... Not to worry, they probably are.
		-- (I don't think it *dies* if they aren't [WDP 94/04/15])

	  CoreDoStrictness
205
	    -> _scc_ "CoreStranal"
206
	       begin_pass "StrAnal" >>
207
	       case (saWwTopBinds us1 binds) of { binds2 ->
208
	       end_pass False us2 binds2 inline_env spec_data simpl_stats "StrAnal" }
209 210

	  CoreDoSpecialising
211
	    -> _scc_ "Specialise"
212
	       begin_pass "Specialise" >>
213
	       case (specProgram us1 binds spec_data) of {
214 215 216 217
		 (p, spec_data2@(SpecData _ spec_noerrs _ _ _
					  spec_errs spec_warn spec_tyerrs)) ->

		   -- if we got errors, we die straight away
218
		   (if not spec_noerrs ||
219
		       (opt_ShowImportSpecs && not (isEmptyBag spec_warn)) then
220
			hPutStr stderr (ppShow 1000 {-pprCols-}
221
			    (pprSpecErrs module_name spec_errs spec_warn spec_tyerrs))
222
			>> hPutStr stderr "\n"
223
		    else
224
			return ()) >>
225 226

		   (if not spec_noerrs then -- Stop here if specialisation errors occured
227
			ghcExit 1
228
		   else
229
			return ()) >>
230

231
		   end_pass False us2 p inline_env spec_data2 simpl_stats "Specialise"
232 233
	       }

234
	  CoreDoDeforest
235 236 237
#if OMIT_DEFORESTER
	    -> error "ERROR: CoreDoDeforest: not built into compiler\n"
#else
238
	    -> _scc_ "Deforestation"
239
	       begin_pass "Deforestation" >>
240
	       case (deforestProgram binds us1) of { binds2 ->
241
	       end_pass False us2 binds2 inline_env spec_data simpl_stats "Deforestation" }
242
#endif
243

244
	  CoreDoAutoCostCentres
245
	    -> _scc_ "AutoSCCs"
246
	       begin_pass "AutoSCCs" >>
247
	       case (addAutoCostCentres module_name binds) of { binds2 ->
248
	       end_pass False us2 binds2 inline_env spec_data simpl_stats "AutoSCCs" }
249

250
	  CoreDoPrintCore	-- print result of last pass
251 252 253
	    -> end_pass True us2 binds inline_env spec_data simpl_stats "Print"


254 255
    -------------------------------------------------

256
    begin_pass
257
      = if opt_D_show_passes
258 259
	then \ what -> hPutStr stderr ("*** Core2Core: "++what++"\n")
	else \ what -> return ()
260 261

    end_pass print us2 binds2 inline_env2
262 263 264
	     spec_data2@(SpecData spec_done _ _ _ _ _ _ _)
	     simpl_stats2 what
      = -- report verbosely, if required
265
	(if (do_verbose_core2core && not print) ||
266 267
	    (print && not do_verbose_core2core)
	 then
268 269 270
	    hPutStr stderr ("\n*** "++what++":\n")
		>>
	    hPutStr stderr (ppShow 1000
271
		(ppAboves (map (pprCoreBinding ppr_style) binds2)))
272 273
		>>
	    hPutStr stderr "\n"
274
	 else
275
	    return ()) >>
276 277 278
	let
	    linted_binds = core_linter what spec_done binds2
	in
279
	return
280 281 282 283 284 285 286 287
	(linted_binds,	-- processed binds, possibly run thru CoreLint
	 us2,		-- UniqueSupply for the next guy
	 inline_env2,	-- possibly-updated inline env
	 spec_data2,	-- possibly-updated specialisation info
	 simpl_stats2	-- accumulated simplifier stats
	)

-- here so it can be inlined...
288 289
foldl_mn f z []     = return z
foldl_mn f z (x:xs) = f z x	>>= \ zz ->
290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314
		     foldl_mn f zz xs
\end{code}

--- ToDo: maybe move elsewhere ---

For top-level, exported binders that either (a)~have been INLINEd by
the programmer or (b)~are sufficiently ``simple'' that they should be
inlined, we want to record this info in a suitable IdEnv.

But: if something has a ``wrapper unfolding,'' we do NOT automatically
give it a regular unfolding (exception below).  We usually assume its
worker will get a ``regular'' unfolding.  We can then treat these two
levels of unfolding separately (we tend to be very friendly towards
wrapper unfoldings, for example), giving more fine-tuned control.

The exception is: If the ``regular unfolding'' mentions no other
global Ids (i.e., it's all PrimOps and cases and local Ids) then we
assume it must be really good and we take it anyway.

We also need to check that everything in the RHS (values and types)
will be visible on the other side of an interface, too.

\begin{code}
calcInlinings :: Bool	-- True => inlinings with _scc_s are OK
	      -> IdEnv UnfoldingDetails
315
	      -> [CoreBinding]
316 317
	      -> IdEnv UnfoldingDetails

318
calcInlinings scc_s_OK inline_env_so_far top_binds
319 320 321 322 323 324 325 326 327 328
  = let
	result = foldl calci inline_env_so_far top_binds
    in
    --pprTrace "inline env:\n" (ppAboves (map pp_item (getIdEnvMapping result)))
    result
  where
    pp_item (binder, details)
      = ppCat [ppr PprDebug binder, ppStr "=>", pp_det details]
      where
    	pp_det NoUnfoldingDetails   = ppStr "_N_"
329
--LATER:	pp_det (IWantToBeINLINEd _) = ppStr "INLINE"
330
    	pp_det (GenForm _ _ expr guide)
331 332 333 334
    	  = ppAbove (ppr PprDebug guide) (ppr PprDebug expr)
    	pp_det other	    	    = ppStr "???"

    ------------
335
    my_trace =  if opt_ReportWhyUnfoldingsDisallowed
336 337 338 339
		then trace
		else \ msg stuff -> stuff

    (unfolding_creation_threshold, explicit_creation_threshold)
340
      = case opt_UnfoldingCreationThreshold of
341 342 343 344
    	  Nothing -> (uNFOLDING_CREATION_THRESHOLD, False)
	  Just xx -> (xx, True)

    unfold_use_threshold
345
      = case opt_UnfoldingUseThreshold of
346 347 348 349
	  Nothing -> uNFOLDING_USE_THRESHOLD
	  Just xx -> xx

    unfold_override_threshold
350
      = case opt_UnfoldingOverrideThreshold of
351 352 353 354 355
	  Nothing -> uNFOLDING_OVERRIDE_THRESHOLD
	  Just xx -> xx

    con_discount_weight = uNFOLDING_CON_DISCOUNT_WEIGHT

356
    calci inline_env (Rec pairs)
357 358
      = foldl (calc True{-recursive-}) inline_env pairs

359
    calci inline_env bind@(NonRec binder rhs)
360 361 362 363 364 365 366
      = calc False{-not recursive-} inline_env (binder, rhs)

    ---------------------------------------

    calc is_recursive inline_env (binder, rhs)
      | not (toplevelishId binder)
      = --pprTrace "giving up on not top-level:" (ppr PprDebug binder)
367
	ignominious_defeat
368 369 370

      | rhs_mentions_an_unmentionable
      || (not explicit_INLINE_requested
371
	  && (rhs_looks_like_a_caf || guidance_says_don't || guidance_size_too_big))
372 373 374 375 376
      = let
	    my_my_trace
	      = if explicit_INLINE_requested
		&& not (isWrapperId binder) -- these always claim to be INLINEd
		&& not have_inlining_already
377
		then trace  		    -- we'd better have a look...
378 379 380 381 382 383 384 385 386 387 388 389
		else my_trace

	    which = if scc_s_OK then " (late):" else " (early):"
    	in
	my_my_trace ("unfolding disallowed for"++which++(ppShow 80 (ppr PprDebug binder))) (
	ignominious_defeat
	)

      | rhs `isWrapperFor` binder
	-- Don't add an explicit "unfolding"; let the worker/wrapper
	-- stuff do its thing.  INLINE things don't get w/w'd, so
	-- they will be OK.
390
      = ignominious_defeat
391 392

#if ! OMIT_DEFORESTER
393
	-- For the deforester: bypass the barbed wire for recursive
394 395 396 397
	-- functions that want to be inlined and are tagged deforestable
	-- by the user, allowing these things to be communicated
	-- across module boundaries.

398 399
      | is_recursive &&
	explicit_INLINE_requested &&
400
	deforestable binder &&
401
	scc_s_OK			-- hack, only get them in
402 403
					-- calc_inlinings2
      = glorious_success UnfoldAlways
404
#endif
405

406
      | is_recursive && not rhs_looks_like_a_data_val
407 408 409 410 411 412
	-- The only recursive defns we are prepared to tolerate at the
	-- moment is top-level very-obviously-a-data-value ones.
	-- We *need* these for dictionaries to be exported!
      = --pprTrace "giving up on rec:" (ppr PprDebug binder)
    	ignominious_defeat

413
	-- Not really interested unless it's exported, but doing it
414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440
	-- this way (not worrying about export-ness) gets us all the
	-- workers/specs, etc., too; which we will need for generating
	-- interfaces.  We are also not interested if this binder is
	-- in the environment we already have (perhaps from a previous
	-- run of calcInlinings -- "earlier" is presumed to mean
	-- "better").

      | explicit_INLINE_requested
      = glorious_success UnfoldAlways

      | otherwise
      = glorious_success guidance

      where
	guidance
	  = calcUnfoldingGuidance scc_s_OK max_out_threshold rhs
	  where
    	    max_out_threshold = if explicit_INLINE_requested
				then 100000 -- you asked for it, you got it
				else unfolding_creation_threshold

	guidance_size
	  = case guidance of
	      UnfoldAlways  	    	  -> 0 -- *extremely* small
	      EssentialUnfolding    	  -> 0 -- ditto
	      UnfoldIfGoodArgs _ _ _ size -> size

441 442 443
	guidance_says_don't = case guidance of { UnfoldNever -> True; _ -> False }

	guidance_size_too_big
444 445 446 447 448 449 450 451
	    -- Does the guidance suggest that this unfolding will
	    -- be of no use *no matter* the arguments given to it?
	    -- Could be more sophisticated...
	  = case guidance of
	      UnfoldAlways  	 -> False
	      EssentialUnfolding -> False
	      UnfoldIfGoodArgs _ no_val_args arg_info_vec size

452
		-> if explicit_creation_threshold then
453
		      False 	-- user set threshold; don't second-guess...
454

455 456 457
		   else if no_val_args == 0 && rhs_looks_like_a_data_val then
		      False	-- we'd like a top-level data constr to be
				-- visible even if it is never unfolded
458 459 460 461 462 463 464 465 466
		   else
		      let
			  cost
			    = leastItCouldCost con_discount_weight size no_val_args
				arg_info_vec rhs_arg_tys
		      in
--		      (if (unfold_use_threshold < cost) then (pprTrace "cost:" (ppInt cost)) else \x->x ) (
		      unfold_use_threshold < cost
--		      )
467

468

469 470 471
	rhs_looks_like_a_caf = not (manifestlyWHNF rhs)

	rhs_looks_like_a_data_val
472
	  = case (collectBinders rhs) of
473 474
	      (_, _, [], Con _ _) -> True
	      other		  -> False
475

476
	rhs_arg_tys
477
	  = case (collectBinders rhs) of
478
	      (_, _, val_binders, _) -> map idType val_binders
479 480 481 482 483

	(mentioned_ids, _, _, mentions_litlit)
	  = mentionedInUnfolding (\x -> x) rhs

	rhs_mentions_an_unmentionable
484
	  = foldBag (||) unfoldingUnfriendlyId False mentioned_ids
485 486 487
	    || mentions_litlit
	    -- ToDo: probably need to chk tycons/classes...

488
	mentions_no_other_ids = isEmptyBag mentioned_ids
489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526

	explicit_INLINE_requested
	    -- did it come from a user {-# INLINE ... #-}?
	    -- (Warning: must avoid including wrappers.)
	  = idWantsToBeINLINEd binder
	    && not (rhs `isWrapperFor` binder)

	have_inlining_already = maybeToBool (lookupIdEnv inline_env binder)

	ignominious_defeat = inline_env  -- just give back what we got

	{-
	    "glorious_success" is ours if we've found a suitable unfolding.

	    But we check for a couple of fine points.

	    (1) If this Id already has an inlining in the inline_env,
		we don't automatically take it -- the earlier one is
		"likely" to be better.

		But if the new one doesn't mention any other global
		Ids, and it's pretty small (< UnfoldingOverrideThreshold),
		then we take the chance that the new one *is* better.

	    (2) If we have an Id w/ a worker/wrapper split (with
		an unfolding for the wrapper), we tend to want to keep
		it -- and *nuke* any inlining that we conjured up
		earlier.

		But, again, if this unfolding doesn't mention any
		other global Ids (and small enough), then it is
		probably better than the worker/wrappery, so we take
		it.
	-}
	glorious_success guidance
	  = let
		new_env = addOneToIdEnv inline_env binder (mkUnfolding guidance rhs)

527
		foldr_building = opt_FoldrBuildOn
528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566
	    in
	    if (not have_inlining_already) then
		-- Not in env: we take it no matter what
		-- NB: we could check for worker/wrapper-ness,
		-- but the truth is we probably haven't run
		-- the strictness analyser yet.
		new_env

	    else if explicit_INLINE_requested then
		-- If it was a user INLINE, then we know it's already
		-- in the inline_env; we stick with what we already
		-- have.
		--pprTrace "giving up on INLINE:" (ppr PprDebug binder)
		ignominious_defeat

	    else if isWrapperId binder then
		-- It's in the env, but we have since worker-wrapperised;
		-- we either take this new one (because it's so good),
		-- or we *undo* the one in the inline_env, so the
		-- wrapper-inlining will take over.

		if mentions_no_other_ids {- *** && size <= unfold_override_threshold -} then
		    new_env
		else
		    delOneFromIdEnv inline_env binder

	    else
		-- It's in the env, nothing to do w/ worker wrapper;
		-- we'll take it if it is better.

		if not foldr_building	-- ANDY hates us... (see below)
		&& mentions_no_other_ids
		&& guidance_size <= unfold_override_threshold then
		    new_env
		else
		    --pprTrace "giving up on final hurdle:" (ppCat [ppr PprDebug binder, ppInt guidance_size, ppInt unfold_override_threshold])
		    ignominious_defeat -- and at the last hurdle, too!
\end{code}

567
ANDY, on the hatred of the check above; why obliterate it?  Consider
568 569 570 571 572 573

 head xs = foldr (\ x _ -> x) (_|_) xs

This then is exported via a pragma. However,
*if* you include the extra code above, you will
export the non-foldr/build version.