-simplifyPgm :: (SimplifierSwitch -> SwitchResult)
- -> UniqSupply
- -> [CoreBind] -- Input
- -> IO [CoreBind] -- New bindings
-
-simplifyPgm sw_chkr us binds
- = do {
- beginPass "Simplify";
-
- (termination_msg, it_count, counts, binds') <- iteration us 1 zeroSimplCount binds;
-
- dumpIfSet opt_D_simplifier_stats "Simplifier statistics"
- (vcat [text termination_msg <+> text "after" <+> ppr it_count <+> text "iterations",
- text "",
- pprSimplCount counts]);
-
- endPass "Simplify"
- (opt_D_verbose_core2core && not opt_D_dump_simpl_iterations)
- binds'
- }
- where
- max_iterations = getSimplIntSwitch sw_chkr MaxSimplifierIterations
- simpl_switch_is_on = switchIsOn sw_chkr
-
- core_iter_dump binds | opt_D_verbose_core2core = pprCoreBindings binds
- | otherwise = empty
-
- iteration us iteration_no counts binds
- = do {
- -- Occurrence analysis
- let { tagged_binds = _scc_ "OccAnal" occurAnalyseBinds simpl_switch_is_on binds };
- dumpIfSet opt_D_dump_occur_anal "Occurrence analysis"
- (pprCoreBindings tagged_binds);
-
- -- Simplify
- let { (binds', counts') = initSmpl sw_chkr us1 (simplTopBinds tagged_binds);
- all_counts = counts `plusSimplCount` counts'
- } ;
-
- -- Stop if nothing happened; don't dump output
- if isZeroSimplCount counts' then
- return ("Simplifier reached fixed point", iteration_no, all_counts, binds')
- else do {
-
- -- Dump the result of this iteration
- dumpIfSet opt_D_dump_simpl_iterations
- ("Simplifier iteration " ++ show iteration_no
- ++ " out of " ++ show max_iterations)
- (vcat[pprSimplCount counts',
- text "",
- core_iter_dump binds']) ;
-
- -- Stop if we've run out of iterations
- if iteration_no == max_iterations then
- do {
- if max_iterations > 1 then
- hPutStr stderr ("NOTE: Simplifier still going after " ++
- show max_iterations ++
- " iterations; bailing out.\n")
- else return ();
-
- return ("Simplifier baled out", iteration_no, all_counts, binds')
- }
-
- -- Else loop
- else iteration us2 (iteration_no + 1) all_counts binds'
- } }
- where
- (us1, us2) = splitUniqSupply us
-
-
-simplTopBinds [] = returnSmpl []
-simplTopBinds (bind1 : binds) = (simplBind bind1 $
- simplTopBinds binds) `thenSmpl` \ (binds1', binds') ->
- returnSmpl (binds1' ++ binds')
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection[SimplCore-indirections]{Eliminating indirections in Core code, and globalising}
-%* *
-%************************************************************************
-
-Several tasks are done by @tidyCorePgm@
-
-----------------
- [March 98] Indirections are now elimianted by the occurrence analyser
- -- 1. Eliminate indirections. The point here is to transform
- -- x_local = E
- -- x_exported = x_local
- -- ==>
- -- x_exported = E
-
-2. Make certain top-level bindings into Globals. The point is that
- Global things get externally-visible labels at code generation
- time
-
-3. Make the representation of NoRep literals explicit, and
- float their bindings to the top level. We only do the floating
- part for NoRep lits inside a lambda (else no gain). We need to
- take care with let x = "foo" in e
- that we don't end up with a silly binding
- let x = y in e
- with a floated "foo". What a bore.
-
-4. Convert
- case x of {...; x' -> ...x'...}
- ==>
- case x of {...; _ -> ...x... }
- See notes in SimplCase.lhs, near simplDefault for the reasoning here.
-
-5. *Mangle* cases involving par# in the discriminant. The unfolding
- for par in PrelConc.lhs include case expressions with integer
- results solely to fool the strictness analyzer, the simplifier,
- and anyone else who might want to fool with the evaluation order.
- At this point in the compiler our evaluation order is safe.
- Therefore, we convert expressions of the form:
-
- case par# e of
- 0# -> rhs
- _ -> parError#
- ==>
- case par# e of
- _ -> rhs
-
- fork# isn't handled like this - it's an explicit IO operation now.
- The reason is that fork# returns a ThreadId#, which gets in the
- way of the above scheme. And anyway, IO is the only guaranteed
- way to enforce ordering --SDM.
-
-6. Mangle cases involving seq# in the discriminant. Up to this
- point, seq# will appear like this:
-
- case seq# e of
- 0# -> seqError#
- _ -> ...
-
- where the 0# branch is purely to bamboozle the strictness analyser
- (see case 5 above). This code comes from an unfolding for 'seq'
- in Prelude.hs. We translate this into