<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>profiling/SCCfinal.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[SCCfinal]{Modify and collect code generation for final STG program}
This is now a sort-of-normal STG-to-STG pass (WDP 94/06), run by stg2stg.
- Traverses the STG program collecting the cost centres. These are required
to declare the cost centres at the start of code generation.
Note: because of cross-module unfolding, some of these cost centres may be
from other modules. But will still have to give them "extern"
declarations.
- Puts on CAF cost-centres if the user has asked for individual CAF
cost-centres.
- Ditto for individual DICT cost-centres.
- Boxes top-level inherited functions passed as arguments.
- "Distributes" given cost-centres to all as-yet-unmarked RHSs.
\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>SCCfinal</span> <span class='hs-layout'>(</span> <span class='hs-varid'>stgMassageForProfiling</span> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-4"></a>
<a name="line-5"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>StgSyn</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CostCentre</span> <span class='hs-comment'>-- lots of things</span>
<a name="line-8"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Id</span>
<a name="line-9"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span>
<a name="line-10"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Module</span>
<a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>UniqSupply</span> <span class='hs-layout'>(</span> <span class='hs-varid'>splitUniqSupply</span><span class='hs-layout'>,</span> <span class='hs-conid'>UniqSupply</span> <span class='hs-layout'>)</span>
<a name="line-12"></a><span class='hs-cpp'>#ifdef PROF_DO_BOXING</span>
<a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>UniqSupply</span> <span class='hs-layout'>(</span> <span class='hs-varid'>uniqFromSupply</span> <span class='hs-layout'>)</span>
<a name="line-14"></a><span class='hs-cpp'>#endif</span>
<a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarSet</span>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ListSetOps</span> <span class='hs-layout'>(</span> <span class='hs-varid'>removeDups</span> <span class='hs-layout'>)</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DynFlags</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="stgMassageForProfiling"></a><span class='hs-definition'>stgMassageForProfiling</span>
<a name="line-2"></a> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DynFlags</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PackageId</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Module</span> <span class='hs-comment'>-- module name</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UniqSupply</span> <span class='hs-comment'>-- unique supply</span>
<a name="line-6"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>StgBinding</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- input</span>
<a name="line-7"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>CollectedCCs</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>StgBinding</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-8"></a>
<a name="line-9"></a><span class='hs-definition'>stgMassageForProfiling</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>this_pkg</span> <span class='hs-varid'>mod_name</span> <span class='hs-varid'>us</span> <span class='hs-varid'>stg_binds</span>
<a name="line-10"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span>
<a name="line-11"></a> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>local_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>extern_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>cc_stacks</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-12"></a> <span class='hs-varid'>stg_binds2</span><span class='hs-layout'>)</span>
<a name="line-13"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>initMM</span> <span class='hs-varid'>mod_name</span> <span class='hs-varid'>us</span> <span class='hs-layout'>(</span><span class='hs-varid'>do_top_bindings</span> <span class='hs-varid'>stg_binds</span><span class='hs-layout'>)</span>
<a name="line-14"></a>
<a name="line-15"></a> <span class='hs-layout'>(</span><span class='hs-varid'>fixed_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>fixed_cc_stacks</span><span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>dopt</span> <span class='hs-conid'>Opt_AutoSccsOnIndividualCafs</span> <span class='hs-varid'>dflags</span>
<a name="line-17"></a> <span class='hs-keyword'>then</span> <span class='hs-layout'>(</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- don't need "all CAFs" CC</span>
<a name="line-18"></a> <span class='hs-comment'>-- (for Prelude, we use PreludeCC)</span>
<a name="line-19"></a> <span class='hs-keyword'>else</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-varid'>all_cafs_cc</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>all_cafs_ccs</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-20"></a>
<a name="line-21"></a> <span class='hs-varid'>local_ccs_no_dups</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fst</span> <span class='hs-layout'>(</span><span class='hs-varid'>removeDups</span> <span class='hs-varid'>cmpCostCentre</span> <span class='hs-varid'>local_ccs</span><span class='hs-layout'>)</span>
<a name="line-22"></a> <span class='hs-varid'>extern_ccs_no_dups</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fst</span> <span class='hs-layout'>(</span><span class='hs-varid'>removeDups</span> <span class='hs-varid'>cmpCostCentre</span> <span class='hs-varid'>extern_ccs</span><span class='hs-layout'>)</span>
<a name="line-23"></a> <span class='hs-keyword'>in</span>
<a name="line-24"></a> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>fixed_ccs</span> <span class='hs-varop'>++</span> <span class='hs-varid'>local_ccs_no_dups</span><span class='hs-layout'>,</span>
<a name="line-25"></a> <span class='hs-varid'>extern_ccs_no_dups</span><span class='hs-layout'>,</span>
<a name="line-26"></a> <span class='hs-varid'>fixed_cc_stacks</span> <span class='hs-varop'>++</span> <span class='hs-varid'>cc_stacks</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>stg_binds2</span><span class='hs-layout'>)</span>
<a name="line-27"></a> <span class='hs-keyword'>where</span>
<a name="line-28"></a>
<a name="line-29"></a> <span class='hs-varid'>all_cafs_cc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkAllCafsCC</span> <span class='hs-varid'>mod_name</span>
<a name="line-30"></a> <span class='hs-varid'>all_cafs_ccs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkSingletonCCS</span> <span class='hs-varid'>all_cafs_cc</span>
<a name="line-31"></a>
<a name="line-32"></a> <span class='hs-comment'>----------</span>
<a name="line-33"></a> <span class='hs-varid'>do_top_bindings</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>StgBinding</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>StgBinding</span><span class='hs-keyglyph'>]</span>
<a name="line-34"></a>
<a name="line-35"></a> <span class='hs-varid'>do_top_bindings</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>[]</span>
<a name="line-36"></a>
<a name="line-37"></a> <span class='hs-varid'>do_top_bindings</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgNonRec</span> <span class='hs-varid'>b</span> <span class='hs-varid'>rhs</span> <span class='hs-conop'>:</span> <span class='hs-varid'>bs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-38"></a> <span class='hs-varid'>rhs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_top_rhs</span> <span class='hs-varid'>b</span> <span class='hs-varid'>rhs</span>
<a name="line-39"></a> <span class='hs-varid'>addTopLevelIshId</span> <span class='hs-varid'>b</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-40"></a> <span class='hs-varid'>bs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_top_bindings</span> <span class='hs-varid'>bs</span>
<a name="line-41"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgNonRec</span> <span class='hs-varid'>b</span> <span class='hs-varid'>rhs'</span> <span class='hs-conop'>:</span> <span class='hs-varid'>bs'</span><span class='hs-layout'>)</span>
<a name="line-42"></a>
<a name="line-43"></a> <span class='hs-varid'>do_top_bindings</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRec</span> <span class='hs-varid'>pairs</span> <span class='hs-conop'>:</span> <span class='hs-varid'>bs</span><span class='hs-layout'>)</span>
<a name="line-44"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addTopLevelIshIds</span> <span class='hs-varid'>binders</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-45"></a> <span class='hs-varid'>pairs2</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>do_pair</span> <span class='hs-varid'>pairs</span>
<a name="line-46"></a> <span class='hs-varid'>bs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_top_bindings</span> <span class='hs-varid'>bs</span>
<a name="line-47"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRec</span> <span class='hs-varid'>pairs2</span> <span class='hs-conop'>:</span> <span class='hs-varid'>bs'</span><span class='hs-layout'>)</span>
<a name="line-48"></a> <span class='hs-keyword'>where</span>
<a name="line-49"></a> <span class='hs-varid'>binders</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>fst</span> <span class='hs-varid'>pairs</span>
<a name="line-50"></a> <span class='hs-varid'>do_pair</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-51"></a> <span class='hs-varid'>rhs2</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_top_rhs</span> <span class='hs-varid'>b</span> <span class='hs-varid'>rhs</span>
<a name="line-52"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs2</span><span class='hs-layout'>)</span>
<a name="line-53"></a>
<a name="line-54"></a> <span class='hs-comment'>----------</span>
<a name="line-55"></a> <span class='hs-varid'>do_top_rhs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StgRhs</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-conid'>StgRhs</span>
<a name="line-56"></a>
<a name="line-57"></a> <span class='hs-varid'>do_top_rhs</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsClosure</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgSCC</span> <span class='hs-varid'>cc</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgConApp</span> <span class='hs-varid'>con</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-58"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isSccCountCostCentre</span> <span class='hs-varid'>cc</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isDllConApp</span> <span class='hs-varid'>this_pkg</span> <span class='hs-varid'>con</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span>
<a name="line-59"></a> <span class='hs-comment'>-- Trivial _scc_ around nothing but static data</span>
<a name="line-60"></a> <span class='hs-comment'>-- Eliminate _scc_ ... and turn into StgRhsCon</span>
<a name="line-61"></a>
<a name="line-62"></a> <span class='hs-comment'>-- isDllConApp checks for LitLit args too</span>
<a name="line-63"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsCon</span> <span class='hs-varid'>dontCareCCS</span> <span class='hs-varid'>con</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span>
<a name="line-64"></a>
<a name="line-65"></a><span class='hs-comment'>{- Can't do this one with cost-centre stacks: --SDM
<a name="line-66"></a> do_top_rhs binder (StgRhsClosure no_cc bi fv u [] (StgSCC ty cc expr))
<a name="line-67"></a> | (noCCSAttached no_cc || currentOrSubsumedCCS no_cc)
<a name="line-68"></a> && not (isSccCountCostCentre cc)
<a name="line-69"></a> -- Top level CAF without a cost centre attached
<a name="line-70"></a> -- Attach and collect cc of trivial _scc_ in body
<a name="line-71"></a> = do collectCC cc
<a name="line-72"></a> expr' <- set_prevailing_cc cc (do_expr expr)
<a name="line-73"></a> return (StgRhsClosure cc bi fv u [] expr')
<a name="line-74"></a>-}</span>
<a name="line-75"></a>
<a name="line-76"></a> <span class='hs-varid'>do_top_rhs</span> <span class='hs-varid'>binder</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsClosure</span> <span class='hs-varid'>no_cc</span> <span class='hs-varid'>bi</span> <span class='hs-varid'>fv</span> <span class='hs-varid'>u</span> <span class='hs-varid'>srt</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span>
<a name="line-77"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>noCCSAttached</span> <span class='hs-varid'>no_cc</span> <span class='hs-varop'>||</span> <span class='hs-varid'>currentOrSubsumedCCS</span> <span class='hs-varid'>no_cc</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-78"></a> <span class='hs-comment'>-- Top level CAF without a cost centre attached</span>
<a name="line-79"></a> <span class='hs-comment'>-- Attach CAF cc (collect if individual CAF ccs)</span>
<a name="line-80"></a> <span class='hs-varid'>caf_ccs</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>dopt</span> <span class='hs-conid'>Opt_AutoSccsOnIndividualCafs</span> <span class='hs-varid'>dflags</span>
<a name="line-81"></a> <span class='hs-keyword'>then</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>cc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkAutoCC</span> <span class='hs-varid'>binder</span> <span class='hs-varid'>modl</span> <span class='hs-conid'>CafCC</span>
<a name="line-82"></a> <span class='hs-varid'>ccs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkSingletonCCS</span> <span class='hs-varid'>cc</span>
<a name="line-83"></a> <span class='hs-comment'>-- careful: the binder might be :Main.main,</span>
<a name="line-84"></a> <span class='hs-comment'>-- which doesn't belong to module mod_name.</span>
<a name="line-85"></a> <span class='hs-comment'>-- bug #249, tests prof001, prof002</span>
<a name="line-86"></a> <span class='hs-varid'>modl</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>nameModule_maybe</span> <span class='hs-layout'>(</span><span class='hs-varid'>idName</span> <span class='hs-varid'>binder</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>m</span>
<a name="line-87"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mod_name</span>
<a name="line-88"></a> <span class='hs-keyword'>in</span> <span class='hs-keyword'>do</span>
<a name="line-89"></a> <span class='hs-varid'>collectNewCC</span> <span class='hs-varid'>cc</span>
<a name="line-90"></a> <span class='hs-varid'>collectCCS</span> <span class='hs-varid'>ccs</span>
<a name="line-91"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>ccs</span>
<a name="line-92"></a> <span class='hs-keyword'>else</span>
<a name="line-93"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>all_cafs_ccs</span>
<a name="line-94"></a> <span class='hs-varid'>body'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>set_prevailing_cc</span> <span class='hs-varid'>caf_ccs</span> <span class='hs-layout'>(</span><span class='hs-varid'>do_expr</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span>
<a name="line-95"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsClosure</span> <span class='hs-varid'>caf_ccs</span> <span class='hs-varid'>bi</span> <span class='hs-varid'>fv</span> <span class='hs-varid'>u</span> <span class='hs-varid'>srt</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span>
<a name="line-96"></a>
<a name="line-97"></a> <span class='hs-varid'>do_top_rhs</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsClosure</span> <span class='hs-varid'>cc</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>
<a name="line-98"></a> <span class='hs-comment'>-- Top level CAF with cost centre attached</span>
<a name="line-99"></a> <span class='hs-comment'>-- Should this be a CAF cc ??? Does this ever occur ???</span>
<a name="line-100"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"SCCfinal: CAF with cc:"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>cc</span><span class='hs-layout'>)</span>
<a name="line-101"></a>
<a name="line-102"></a> <span class='hs-varid'>do_top_rhs</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsClosure</span> <span class='hs-varid'>no_ccs</span> <span class='hs-varid'>bi</span> <span class='hs-varid'>fv</span> <span class='hs-varid'>u</span> <span class='hs-varid'>srt</span> <span class='hs-varid'>args</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span>
<a name="line-103"></a> <span class='hs-comment'>-- Top level function, probably subsumed</span>
<a name="line-104"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>noCCSAttached</span> <span class='hs-varid'>no_ccs</span>
<a name="line-105"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>body'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>set_lambda_cc</span> <span class='hs-layout'>(</span><span class='hs-varid'>do_expr</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span>
<a name="line-106"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsClosure</span> <span class='hs-varid'>subsumedCCS</span> <span class='hs-varid'>bi</span> <span class='hs-varid'>fv</span> <span class='hs-varid'>u</span> <span class='hs-varid'>srt</span> <span class='hs-varid'>args</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span>
<a name="line-107"></a>
<a name="line-108"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-109"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"SCCfinal: CAF with cc:"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>no_ccs</span><span class='hs-layout'>)</span>
<a name="line-110"></a>
<a name="line-111"></a> <span class='hs-varid'>do_top_rhs</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsCon</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>con</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span>
<a name="line-112"></a> <span class='hs-comment'>-- Top-level (static) data is not counted in heap</span>
<a name="line-113"></a> <span class='hs-comment'>-- profiles; nor do we set CCCS from it; so we</span>
<a name="line-114"></a> <span class='hs-comment'>-- just slam in dontCareCostCentre</span>
<a name="line-115"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsCon</span> <span class='hs-varid'>dontCareCCS</span> <span class='hs-varid'>con</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span>
<a name="line-116"></a>
<a name="line-117"></a> <span class='hs-comment'>------</span>
<a name="line-118"></a> <span class='hs-varid'>do_expr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>StgExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-conid'>StgExpr</span>
<a name="line-119"></a>
<a name="line-120"></a> <span class='hs-varid'>do_expr</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgLit</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgLit</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span>
<a name="line-121"></a>
<a name="line-122"></a> <span class='hs-varid'>do_expr</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgApp</span> <span class='hs-varid'>fn</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span>
<a name="line-123"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>boxHigherOrderArgs</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgApp</span> <span class='hs-varid'>fn</span><span class='hs-layout'>)</span> <span class='hs-varid'>args</span>
<a name="line-124"></a>
<a name="line-125"></a> <span class='hs-varid'>do_expr</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgConApp</span> <span class='hs-varid'>con</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span>
<a name="line-126"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>boxHigherOrderArgs</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>args</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StgConApp</span> <span class='hs-varid'>con</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span> <span class='hs-varid'>args</span>
<a name="line-127"></a>
<a name="line-128"></a> <span class='hs-varid'>do_expr</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgOpApp</span> <span class='hs-varid'>con</span> <span class='hs-varid'>args</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span>
<a name="line-129"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>boxHigherOrderArgs</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>args</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StgOpApp</span> <span class='hs-varid'>con</span> <span class='hs-varid'>args</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>args</span>
<a name="line-130"></a>
<a name="line-131"></a> <span class='hs-varid'>do_expr</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgSCC</span> <span class='hs-varid'>cc</span> <span class='hs-varid'>expr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-comment'>-- Ha, we found a cost centre!</span>
<a name="line-132"></a> <span class='hs-varid'>collectCC</span> <span class='hs-varid'>cc</span>
<a name="line-133"></a> <span class='hs-varid'>expr'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_expr</span> <span class='hs-varid'>expr</span>
<a name="line-134"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgSCC</span> <span class='hs-varid'>cc</span> <span class='hs-varid'>expr'</span><span class='hs-layout'>)</span>
<a name="line-135"></a>
<a name="line-136"></a> <span class='hs-varid'>do_expr</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgCase</span> <span class='hs-varid'>expr</span> <span class='hs-varid'>fv1</span> <span class='hs-varid'>fv2</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>srt</span> <span class='hs-varid'>alt_type</span> <span class='hs-varid'>alts</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-137"></a> <span class='hs-varid'>expr'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_expr</span> <span class='hs-varid'>expr</span>
<a name="line-138"></a> <span class='hs-varid'>alts'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>do_alt</span> <span class='hs-varid'>alts</span>
<a name="line-139"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgCase</span> <span class='hs-varid'>expr'</span> <span class='hs-varid'>fv1</span> <span class='hs-varid'>fv2</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>srt</span> <span class='hs-varid'>alt_type</span> <span class='hs-varid'>alts'</span><span class='hs-layout'>)</span>
<a name="line-140"></a> <span class='hs-keyword'>where</span>
<a name="line-141"></a> <span class='hs-varid'>do_alt</span> <span class='hs-layout'>(</span><span class='hs-varid'>id</span><span class='hs-layout'>,</span> <span class='hs-varid'>bs</span><span class='hs-layout'>,</span> <span class='hs-varid'>use_mask</span><span class='hs-layout'>,</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-142"></a> <span class='hs-varid'>e'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_expr</span> <span class='hs-varid'>e</span>
<a name="line-143"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>id</span><span class='hs-layout'>,</span> <span class='hs-varid'>bs</span><span class='hs-layout'>,</span> <span class='hs-varid'>use_mask</span><span class='hs-layout'>,</span> <span class='hs-varid'>e'</span><span class='hs-layout'>)</span>
<a name="line-144"></a>
<a name="line-145"></a> <span class='hs-varid'>do_expr</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgLet</span> <span class='hs-varid'>b</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-146"></a> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span><span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_let</span> <span class='hs-varid'>b</span> <span class='hs-varid'>e</span>
<a name="line-147"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgLet</span> <span class='hs-varid'>b</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span>
<a name="line-148"></a>
<a name="line-149"></a> <span class='hs-varid'>do_expr</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgLetNoEscape</span> <span class='hs-varid'>lvs1</span> <span class='hs-varid'>lvs2</span> <span class='hs-varid'>b</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-150"></a> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span><span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_let</span> <span class='hs-varid'>b</span> <span class='hs-varid'>e</span>
<a name="line-151"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgLetNoEscape</span> <span class='hs-varid'>lvs1</span> <span class='hs-varid'>lvs2</span> <span class='hs-varid'>b</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span>
<a name="line-152"></a>
<a name="line-153"></a> <span class='hs-varid'>do_expr</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgTick</span> <span class='hs-varid'>m</span> <span class='hs-varid'>n</span> <span class='hs-varid'>expr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-154"></a> <span class='hs-varid'>expr'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_expr</span> <span class='hs-varid'>expr</span>
<a name="line-155"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgTick</span> <span class='hs-varid'>m</span> <span class='hs-varid'>n</span> <span class='hs-varid'>expr'</span><span class='hs-layout'>)</span>
<a name="line-156"></a>
<a name="line-157"></a> <span class='hs-varid'>do_expr</span> <span class='hs-varid'>other</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"SCCfinal.do_expr"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>other</span><span class='hs-layout'>)</span>
<a name="line-158"></a>
<a name="line-159"></a> <span class='hs-comment'>----------------------------------</span>
<a name="line-160"></a>
<a name="line-161"></a> <span class='hs-varid'>do_let</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgNonRec</span> <span class='hs-varid'>b</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-162"></a> <span class='hs-varid'>rhs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_rhs</span> <span class='hs-varid'>rhs</span>
<a name="line-163"></a> <span class='hs-varid'>addTopLevelIshId</span> <span class='hs-varid'>b</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-164"></a> <span class='hs-varid'>e'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_expr</span> <span class='hs-varid'>e</span>
<a name="line-165"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgNonRec</span> <span class='hs-varid'>b</span> <span class='hs-varid'>rhs'</span><span class='hs-layout'>,</span><span class='hs-varid'>e'</span><span class='hs-layout'>)</span>
<a name="line-166"></a>
<a name="line-167"></a> <span class='hs-varid'>do_let</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRec</span> <span class='hs-varid'>pairs</span><span class='hs-layout'>)</span> <span class='hs-varid'>e</span>
<a name="line-168"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addTopLevelIshIds</span> <span class='hs-varid'>binders</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-169"></a> <span class='hs-varid'>pairs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>do_pair</span> <span class='hs-varid'>pairs</span>
<a name="line-170"></a> <span class='hs-varid'>e'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_expr</span> <span class='hs-varid'>e</span>
<a name="line-171"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRec</span> <span class='hs-varid'>pairs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>e'</span><span class='hs-layout'>)</span>
<a name="line-172"></a> <span class='hs-keyword'>where</span>
<a name="line-173"></a> <span class='hs-varid'>binders</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>fst</span> <span class='hs-varid'>pairs</span>
<a name="line-174"></a> <span class='hs-varid'>do_pair</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-175"></a> <span class='hs-varid'>rhs2</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_rhs</span> <span class='hs-varid'>rhs</span>
<a name="line-176"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs2</span><span class='hs-layout'>)</span>
<a name="line-177"></a>
<a name="line-178"></a> <span class='hs-comment'>----------------------------------</span>
<a name="line-179"></a> <span class='hs-varid'>do_rhs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>StgRhs</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-conid'>StgRhs</span>
<a name="line-180"></a> <span class='hs-comment'>-- We play much the same game as we did in do_top_rhs above;</span>
<a name="line-181"></a> <span class='hs-comment'>-- but we don't have to worry about cafs etc.</span>
<a name="line-182"></a>
<a name="line-183"></a><span class='hs-comment'>{-
<a name="line-184"></a> do_rhs (StgRhsClosure closure_cc bi fv u [] (StgSCC ty cc (StgCon (DataCon con) args _)))
<a name="line-185"></a> | not (isSccCountCostCentre cc)
<a name="line-186"></a> = do collectCC cc
<a name="line-187"></a> return (StgRhsCon cc con args)
<a name="line-188"></a>-}</span>
<a name="line-189"></a>
<a name="line-190"></a> <span class='hs-varid'>do_rhs</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsClosure</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>bi</span> <span class='hs-varid'>fv</span> <span class='hs-varid'>u</span> <span class='hs-varid'>srt</span> <span class='hs-varid'>args</span> <span class='hs-varid'>expr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-191"></a> <span class='hs-layout'>(</span><span class='hs-varid'>expr'</span><span class='hs-layout'>,</span> <span class='hs-varid'>ccs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>slurpSCCs</span> <span class='hs-varid'>currentCCS</span> <span class='hs-varid'>expr</span>
<a name="line-192"></a> <span class='hs-varid'>expr''</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>do_expr</span> <span class='hs-varid'>expr'</span>
<a name="line-193"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsClosure</span> <span class='hs-varid'>ccs</span> <span class='hs-varid'>bi</span> <span class='hs-varid'>fv</span> <span class='hs-varid'>u</span> <span class='hs-varid'>srt</span> <span class='hs-varid'>args</span> <span class='hs-varid'>expr''</span><span class='hs-layout'>)</span>
<a name="line-194"></a> <span class='hs-keyword'>where</span>
<a name="line-195"></a> <span class='hs-varid'>slurpSCCs</span> <span class='hs-varid'>ccs</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgSCC</span> <span class='hs-varid'>cc</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span>
<a name="line-196"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>collectCC</span> <span class='hs-varid'>cc</span>
<a name="line-197"></a> <span class='hs-varid'>slurpSCCs</span> <span class='hs-layout'>(</span><span class='hs-varid'>cc</span> <span class='hs-varop'>`pushCCOnCCS`</span> <span class='hs-varid'>ccs</span><span class='hs-layout'>)</span> <span class='hs-varid'>e</span>
<a name="line-198"></a> <span class='hs-varid'>slurpSCCs</span> <span class='hs-varid'>ccs</span> <span class='hs-varid'>e</span>
<a name="line-199"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>e</span><span class='hs-layout'>,</span> <span class='hs-varid'>ccs</span><span class='hs-layout'>)</span>
<a name="line-200"></a>
<a name="line-201"></a> <span class='hs-varid'>do_rhs</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsCon</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>con</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span>
<a name="line-202"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgRhsCon</span> <span class='hs-varid'>currentCCS</span> <span class='hs-varid'>con</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Boxing higher-order args}
%* *
%************************************************************************
Boxing is *turned off* at the moment, until we can figure out how to
do it properly in general.
\begin{code}
<pre><a name="line-1"></a><a name="boxHigherOrderArgs"></a><span class='hs-definition'>boxHigherOrderArgs</span>
<a name="line-2"></a> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>StgArg</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StgExpr</span><span class='hs-layout'>)</span>
<a name="line-3"></a> <span class='hs-comment'>-- An application lacking its arguments</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>StgArg</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- arguments which we might box</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-conid'>StgExpr</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-cpp'>#ifndef PROF_DO_BOXING</span>
<a name="line-8"></a><span class='hs-definition'>boxHigherOrderArgs</span> <span class='hs-varid'>almost_expr</span> <span class='hs-varid'>args</span>
<a name="line-9"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>almost_expr</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span>
<a name="line-10"></a><span class='hs-cpp'>#else</span>
<a name="line-11"></a><span class='hs-definition'>boxHigherOrderArgs</span> <span class='hs-varid'>almost_expr</span> <span class='hs-varid'>args</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-12"></a> <span class='hs-varid'>ids</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getTopLevelIshIds</span>
<a name="line-13"></a> <span class='hs-layout'>(</span><span class='hs-varid'>let_bindings</span><span class='hs-layout'>,</span> <span class='hs-varid'>new_args</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapAccumLM</span> <span class='hs-layout'>(</span><span class='hs-varid'>do_arg</span> <span class='hs-varid'>ids</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>args</span>
<a name="line-14"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-varid'>mk_stg_let</span> <span class='hs-varid'>currentCCS</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>almost_expr</span> <span class='hs-varid'>new_args</span><span class='hs-layout'>)</span> <span class='hs-varid'>let_bindings</span><span class='hs-layout'>)</span>
<a name="line-15"></a> <span class='hs-keyword'>where</span>
<a name="line-16"></a> <span class='hs-comment'>---------------</span>
<a name="line-17"></a>
<a name="line-18"></a> <span class='hs-varid'>do_arg</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>bindings</span> <span class='hs-varid'>arg</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>StgVarArg</span> <span class='hs-varid'>old_var</span><span class='hs-layout'>)</span>
<a name="line-19"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isLocalVar</span> <span class='hs-varid'>old_var</span><span class='hs-layout'>)</span> <span class='hs-varop'>||</span> <span class='hs-varid'>elemVarSet</span> <span class='hs-varid'>old_var</span> <span class='hs-varid'>ids</span><span class='hs-layout'>)</span>
<a name="line-20"></a> <span class='hs-varop'>&&</span> <span class='hs-varid'>isFunTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>dropForAlls</span> <span class='hs-varid'>var_type</span><span class='hs-layout'>)</span>
<a name="line-21"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-comment'>-- make a trivial let-binding for the top-level function</span>
<a name="line-22"></a> <span class='hs-varid'>uniq</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getUniqueMM</span>
<a name="line-23"></a> <span class='hs-keyword'>let</span>
<a name="line-24"></a> <span class='hs-varid'>new_var</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkSysLocal</span> <span class='hs-layout'>(</span><span class='hs-varid'>fsLit</span> <span class='hs-str'>"sf"</span><span class='hs-layout'>)</span> <span class='hs-varid'>uniq</span> <span class='hs-varid'>var_type</span>
<a name="line-25"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-layout'>(</span><span class='hs-varid'>new_var</span><span class='hs-layout'>,</span> <span class='hs-varid'>old_var</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>bindings</span><span class='hs-layout'>,</span> <span class='hs-conid'>StgVarArg</span> <span class='hs-varid'>new_var</span> <span class='hs-layout'>)</span>
<a name="line-26"></a> <span class='hs-keyword'>where</span>
<a name="line-27"></a> <span class='hs-varid'>var_type</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>old_var</span>
<a name="line-28"></a>
<a name="line-29"></a> <span class='hs-varid'>do_arg</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>bindings</span> <span class='hs-varid'>arg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>bindings</span><span class='hs-layout'>,</span> <span class='hs-varid'>arg</span><span class='hs-layout'>)</span>
<a name="line-30"></a>
<a name="line-31"></a> <span class='hs-comment'>---------------</span>
<a name="line-32"></a> <span class='hs-varid'>mk_stg_let</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CostCentreStack</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span> <span class='hs-conid'>Id</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StgExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StgExpr</span>
<a name="line-33"></a>
<a name="line-34"></a> <span class='hs-varid'>mk_stg_let</span> <span class='hs-varid'>cc</span> <span class='hs-layout'>(</span><span class='hs-varid'>new_var</span><span class='hs-layout'>,</span> <span class='hs-varid'>old_var</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span>
<a name="line-35"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span>
<a name="line-36"></a> <span class='hs-varid'>rhs_body</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StgApp</span> <span class='hs-varid'>old_var</span> <span class='hs-keyglyph'>[</span><span class='hs-comment'>{-args-}</span><span class='hs-keyglyph'>]</span>
<a name="line-37"></a> <span class='hs-varid'>rhs_closure</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StgRhsClosure</span> <span class='hs-varid'>cc</span> <span class='hs-varid'>stgArgOcc</span> <span class='hs-keyglyph'>[</span><span class='hs-comment'>{-fvs-}</span><span class='hs-keyglyph'>]</span> <span class='hs-conid'>ReEntrant</span> <span class='hs-conid'>NoSRT</span><span class='hs-comment'>{-eeek!!!-}</span> <span class='hs-keyglyph'>[</span><span class='hs-comment'>{-args-}</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>rhs_body</span>
<a name="line-38"></a> <span class='hs-keyword'>in</span>
<a name="line-39"></a> <span class='hs-conid'>StgLet</span> <span class='hs-layout'>(</span><span class='hs-conid'>StgNonRec</span> <span class='hs-varid'>new_var</span> <span class='hs-varid'>rhs_closure</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span>
<a name="line-40"></a> <span class='hs-keyword'>where</span>
<a name="line-41"></a> <span class='hs-varid'>bOGUS_LVs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyUniqSet</span> <span class='hs-comment'>-- easier to print than: panic "mk_stg_let: LVs"</span>
<a name="line-42"></a><span class='hs-cpp'>#endif</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Boring monad stuff for this}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="MassageM"></a><span class='hs-keyword'>newtype</span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>result</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MassageM</span> <span class='hs-layout'>{</span>
<a name="line-3"></a> <span class='hs-varid'>unMassageM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Module</span> <span class='hs-comment'>-- module name</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CostCentreStack</span> <span class='hs-comment'>-- prevailing CostCentre</span>
<a name="line-5"></a> <span class='hs-comment'>-- if none, subsumedCosts at top-level</span>
<a name="line-6"></a> <span class='hs-comment'>-- currentCostCentre at nested levels</span>
<a name="line-7"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UniqSupply</span>
<a name="line-8"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VarSet</span> <span class='hs-comment'>-- toplevel-ish Ids for boxing</span>
<a name="line-9"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CollectedCCs</span>
<a name="line-10"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>CollectedCCs</span><span class='hs-layout'>,</span> <span class='hs-varid'>result</span><span class='hs-layout'>)</span>
<a name="line-11"></a> <span class='hs-layout'>}</span>
<a name="line-12"></a>
<a name="line-13"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Monad</span> <span class='hs-conid'>MassageM</span> <span class='hs-keyword'>where</span>
<a name="line-14"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MassageM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>ccs</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-15"></a> <span class='hs-layout'>(</span><span class='hs-varop'>>>=</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>thenMM</span>
<a name="line-16"></a> <span class='hs-layout'>(</span><span class='hs-varop'>>></span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>thenMM_</span>
<a name="line-17"></a>
<a name="line-18"></a><span class='hs-comment'>-- the initMM function also returns the final CollectedCCs</span>
<a name="line-19"></a>
<a name="line-20"></a><a name="initMM"></a><span class='hs-definition'>initMM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Module</span> <span class='hs-comment'>-- module name, which we may consult</span>
<a name="line-21"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UniqSupply</span>
<a name="line-22"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>a</span>
<a name="line-23"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>CollectedCCs</span><span class='hs-layout'>,</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-24"></a>
<a name="line-25"></a><span class='hs-definition'>initMM</span> <span class='hs-varid'>mod_name</span> <span class='hs-varid'>init_us</span> <span class='hs-layout'>(</span><span class='hs-conid'>MassageM</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>m</span> <span class='hs-varid'>mod_name</span> <span class='hs-varid'>noCCS</span> <span class='hs-varid'>init_us</span> <span class='hs-varid'>emptyVarSet</span> <span class='hs-layout'>(</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-26"></a>
<a name="line-27"></a><a name="thenMM"></a><span class='hs-definition'>thenMM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>b</span>
<a name="line-28"></a><a name="thenMM_"></a><span class='hs-definition'>thenMM_</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>MassageM</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>b</span>
<a name="line-29"></a>
<a name="line-30"></a><span class='hs-definition'>thenMM</span> <span class='hs-varid'>expr</span> <span class='hs-varid'>cont</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MassageM</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>mod</span> <span class='hs-varid'>scope_cc</span> <span class='hs-varid'>us</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs</span> <span class='hs-keyglyph'>-></span>
<a name="line-31"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>splitUniqSupply</span> <span class='hs-varid'>us</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>s1</span><span class='hs-layout'>,</span> <span class='hs-varid'>s2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-32"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>unMassageM</span> <span class='hs-varid'>expr</span> <span class='hs-varid'>mod</span> <span class='hs-varid'>scope_cc</span> <span class='hs-varid'>s1</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>ccs2</span><span class='hs-layout'>,</span> <span class='hs-varid'>result</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-33"></a> <span class='hs-varid'>unMassageM</span> <span class='hs-layout'>(</span><span class='hs-varid'>cont</span> <span class='hs-varid'>result</span><span class='hs-layout'>)</span> <span class='hs-varid'>mod</span> <span class='hs-varid'>scope_cc</span> <span class='hs-varid'>s2</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs2</span> <span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-34"></a>
<a name="line-35"></a><span class='hs-definition'>thenMM_</span> <span class='hs-varid'>expr</span> <span class='hs-varid'>cont</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MassageM</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>mod</span> <span class='hs-varid'>scope_cc</span> <span class='hs-varid'>us</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs</span> <span class='hs-keyglyph'>-></span>
<a name="line-36"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>splitUniqSupply</span> <span class='hs-varid'>us</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>s1</span><span class='hs-layout'>,</span> <span class='hs-varid'>s2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-37"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>unMassageM</span> <span class='hs-varid'>expr</span> <span class='hs-varid'>mod</span> <span class='hs-varid'>scope_cc</span> <span class='hs-varid'>s1</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>ccs2</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-38"></a> <span class='hs-varid'>unMassageM</span> <span class='hs-varid'>cont</span> <span class='hs-varid'>mod</span> <span class='hs-varid'>scope_cc</span> <span class='hs-varid'>s2</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs2</span> <span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-39"></a>
<a name="line-40"></a><span class='hs-cpp'>#ifdef PROF_DO_BOXING</span>
<a name="line-41"></a><a name="getUniqueMM"></a><span class='hs-definition'>getUniqueMM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MassageM</span> <span class='hs-conid'>Unique</span>
<a name="line-42"></a><span class='hs-definition'>getUniqueMM</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MassageM</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>mod</span> <span class='hs-varid'>scope_cc</span> <span class='hs-varid'>us</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>uniqFromSupply</span> <span class='hs-varid'>us</span><span class='hs-layout'>)</span>
<a name="line-43"></a><span class='hs-cpp'>#endif</span>
<a name="line-44"></a>
<a name="line-45"></a><a name="addTopLevelIshId"></a><span class='hs-definition'>addTopLevelIshId</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>a</span>
<a name="line-46"></a><span class='hs-definition'>addTopLevelIshId</span> <span class='hs-varid'>id</span> <span class='hs-varid'>scope</span>
<a name="line-47"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MassageM</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>mod</span> <span class='hs-varid'>scope_cc</span> <span class='hs-varid'>us</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs</span> <span class='hs-keyglyph'>-></span>
<a name="line-48"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>isCurrentCCS</span> <span class='hs-varid'>scope_cc</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>unMassageM</span> <span class='hs-varid'>scope</span> <span class='hs-varid'>mod</span> <span class='hs-varid'>scope_cc</span> <span class='hs-varid'>us</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs</span>
<a name="line-49"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>unMassageM</span> <span class='hs-varid'>scope</span> <span class='hs-varid'>mod</span> <span class='hs-varid'>scope_cc</span> <span class='hs-varid'>us</span> <span class='hs-layout'>(</span><span class='hs-varid'>extendVarSet</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span> <span class='hs-varid'>ccs</span>
<a name="line-50"></a>
<a name="line-51"></a><a name="addTopLevelIshIds"></a><span class='hs-definition'>addTopLevelIshIds</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>a</span>
<a name="line-52"></a><span class='hs-definition'>addTopLevelIshIds</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>cont</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cont</span>
<a name="line-53"></a><span class='hs-definition'>addTopLevelIshIds</span> <span class='hs-layout'>(</span><span class='hs-varid'>id</span><span class='hs-conop'>:</span><span class='hs-varid'>ids</span><span class='hs-layout'>)</span> <span class='hs-varid'>cont</span>
<a name="line-54"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addTopLevelIshId</span> <span class='hs-varid'>id</span> <span class='hs-layout'>(</span><span class='hs-varid'>addTopLevelIshIds</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>cont</span><span class='hs-layout'>)</span>
<a name="line-55"></a>
<a name="line-56"></a><span class='hs-cpp'>#ifdef PROF_DO_BOXING</span>
<a name="line-57"></a><a name="getTopLevelIshIds"></a><span class='hs-definition'>getTopLevelIshIds</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MassageM</span> <span class='hs-conid'>VarSet</span>
<a name="line-58"></a><span class='hs-definition'>getTopLevelIshIds</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MassageM</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-sel'>_mod</span> <span class='hs-sel'>_scope_cc</span> <span class='hs-sel'>_us</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ids</span><span class='hs-layout'>)</span>
<a name="line-59"></a><span class='hs-cpp'>#endif</span>
</pre>\end{code}
The prevailing CCS is used to tell whether we're in a top-levelish
position, where top-levelish is defined as "not inside a lambda".
Prevailing CCs used to be used for something much more complicated,
I'm sure --SDM
\begin{code}
<pre><a name="line-1"></a><a name="set_lambda_cc"></a><span class='hs-definition'>set_lambda_cc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>a</span>
<a name="line-2"></a><span class='hs-definition'>set_lambda_cc</span> <span class='hs-varid'>action</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MassageM</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>mod</span> <span class='hs-sel'>_scope_cc</span> <span class='hs-varid'>us</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unMassageM</span> <span class='hs-varid'>action</span> <span class='hs-varid'>mod</span> <span class='hs-varid'>currentCCS</span> <span class='hs-varid'>us</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs</span>
<a name="line-5"></a>
<a name="line-6"></a><a name="set_prevailing_cc"></a><span class='hs-definition'>set_prevailing_cc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CostCentreStack</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-varid'>a</span>
<a name="line-7"></a><span class='hs-definition'>set_prevailing_cc</span> <span class='hs-varid'>cc_to_set_to</span> <span class='hs-varid'>action</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MassageM</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>mod</span> <span class='hs-sel'>_scope_cc</span> <span class='hs-varid'>us</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs</span>
<a name="line-9"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unMassageM</span> <span class='hs-varid'>action</span> <span class='hs-varid'>mod</span> <span class='hs-varid'>cc_to_set_to</span> <span class='hs-varid'>us</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>ccs</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="collectCC"></a><span class='hs-definition'>collectCC</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CostCentre</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-conid'>()</span>
<a name="line-2"></a><span class='hs-definition'>collectCC</span> <span class='hs-varid'>cc</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MassageM</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>mod_name</span> <span class='hs-sel'>_scope_cc</span> <span class='hs-sel'>_us</span> <span class='hs-sel'>_ids</span> <span class='hs-layout'>(</span><span class='hs-varid'>local_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>extern_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ccss</span><span class='hs-layout'>)</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>noCCAttached</span> <span class='hs-varid'>cc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-5"></a> <span class='hs-keyword'>if</span> <span class='hs-layout'>(</span><span class='hs-varid'>cc</span> <span class='hs-varop'>`ccFromThisModule`</span> <span class='hs-varid'>mod_name</span><span class='hs-layout'>)</span> <span class='hs-keyword'>then</span>
<a name="line-6"></a> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>cc</span> <span class='hs-conop'>:</span> <span class='hs-varid'>local_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>extern_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ccss</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-7"></a> <span class='hs-keyword'>else</span> <span class='hs-comment'>-- must declare it "extern"</span>
<a name="line-8"></a> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>local_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>cc</span> <span class='hs-conop'>:</span> <span class='hs-varid'>extern_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ccss</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-9"></a>
<a name="line-10"></a><a name="collectNewCC"></a><span class='hs-comment'>-- Version of collectCC used when we definitely want to declare this</span>
<a name="line-11"></a><span class='hs-comment'>-- CC as local, even if its module name is not the same as the current</span>
<a name="line-12"></a><span class='hs-comment'>-- module name (eg. the special :Main module) see bug #249, #1472,</span>
<a name="line-13"></a><span class='hs-comment'>-- test prof001,prof002.</span>
<a name="line-14"></a><span class='hs-definition'>collectNewCC</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CostCentre</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-conid'>()</span>
<a name="line-15"></a><span class='hs-definition'>collectNewCC</span> <span class='hs-varid'>cc</span>
<a name="line-16"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MassageM</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-sel'>_mod_name</span> <span class='hs-sel'>_scope_cc</span> <span class='hs-sel'>_us</span> <span class='hs-sel'>_ids</span> <span class='hs-layout'>(</span><span class='hs-varid'>local_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>extern_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ccss</span><span class='hs-layout'>)</span>
<a name="line-17"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>cc</span> <span class='hs-conop'>:</span> <span class='hs-varid'>local_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>extern_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ccss</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-18"></a>
<a name="line-19"></a><a name="collectCCS"></a><span class='hs-definition'>collectCCS</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CostCentreStack</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MassageM</span> <span class='hs-conid'>()</span>
<a name="line-20"></a>
<a name="line-21"></a><span class='hs-definition'>collectCCS</span> <span class='hs-varid'>ccs</span>
<a name="line-22"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MassageM</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-sel'>_mod_name</span> <span class='hs-sel'>_scope_cc</span> <span class='hs-sel'>_us</span> <span class='hs-sel'>_ids</span> <span class='hs-layout'>(</span><span class='hs-varid'>local_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>extern_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ccss</span><span class='hs-layout'>)</span>
<a name="line-23"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>noCCSAttached</span> <span class='hs-varid'>ccs</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-24"></a> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>local_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>extern_ccs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ccs</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ccss</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
</pre>\end{code}
</body>
</html>
