<?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>cmm/CmmZipUtil.hs</title> <link type='text/css' rel='stylesheet' href='hscolour.css' /> </head> <body> <pre><a name="line-1"></a> <a name="line-2"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>CmmZipUtil</span> <a name="line-3"></a> <span class='hs-layout'>(</span> <span class='hs-varid'>zipPreds</span> <a name="line-4"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>givesUniquePredecessorTo</span> <a name="line-5"></a> <span class='hs-layout'>)</span> <a name="line-6"></a><span class='hs-keyword'>where</span> <a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>BlockId</span> <a name="line-8"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Prelude</span> <span class='hs-varid'>hiding</span> <span class='hs-layout'>(</span><span class='hs-varid'>last</span><span class='hs-layout'>,</span> <span class='hs-varid'>unzip</span><span class='hs-layout'>)</span> <a name="line-9"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ZipCfg</span> <a name="line-10"></a> <a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Maybes</span> <a name="line-12"></a> <a name="line-13"></a><a name="zipPreds"></a><span class='hs-comment'>-- | Compute the predecessors of each /reachable/ block</span> <a name="line-14"></a><span class='hs-definition'>zipPreds</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LastNode</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>LGraph</span> <span class='hs-varid'>m</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BlockEnv</span> <span class='hs-conid'>BlockSet</span> <a name="line-15"></a><span class='hs-definition'>zipPreds</span> <span class='hs-varid'>g</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldl</span> <span class='hs-varid'>add</span> <span class='hs-varid'>emptyBlockEnv</span> <span class='hs-layout'>(</span><span class='hs-varid'>postorder_dfs</span> <span class='hs-varid'>g</span><span class='hs-layout'>)</span> <a name="line-16"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>add</span> <span class='hs-varid'>env</span> <span class='hs-varid'>block</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Block</span> <span class='hs-varid'>id</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <a name="line-17"></a> <span class='hs-varid'>foldl</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>env</span> <span class='hs-varid'>sid</span> <span class='hs-keyglyph'>-></span> <a name="line-18"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>preds</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lookupBlockEnv</span> <span class='hs-varid'>env</span> <span class='hs-varid'>sid</span> <span class='hs-varop'>`orElse`</span> <span class='hs-varid'>emptyBlockSet</span> <a name="line-19"></a> <span class='hs-keyword'>in</span> <span class='hs-varid'>extendBlockEnv</span> <span class='hs-varid'>env</span> <span class='hs-varid'>sid</span> <span class='hs-layout'>(</span><span class='hs-varid'>extendBlockSet</span> <span class='hs-varid'>preds</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <a name="line-20"></a> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-varid'>succs</span> <span class='hs-varid'>block</span><span class='hs-layout'>)</span> <a name="line-21"></a> <a name="line-22"></a><span class='hs-comment'>-- | Tell if a graph gives a block a unique predecessor. For</span> <a name="line-23"></a><span class='hs-comment'>-- efficiency, this function is designed to be partially applied.</span> <a name="line-24"></a> <a name="line-25"></a><a name="givesUniquePredecessorTo"></a><span class='hs-definition'>givesUniquePredecessorTo</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LastNode</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>LGraph</span> <span class='hs-varid'>m</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BlockId</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span> <a name="line-26"></a><span class='hs-definition'>givesUniquePredecessorTo</span> <span class='hs-varid'>g</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>id</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>elemBlockSet</span> <span class='hs-varid'>id</span> <span class='hs-varid'>singlePreds</span> <a name="line-27"></a> <span class='hs-comment'>-- accumulates a pair of sets: the set of all blocks containing a single</span> <a name="line-28"></a> <span class='hs-comment'>-- predecessor, and the set of all blocks containing at least two predecessors</span> <a name="line-29"></a> <span class='hs-keyword'>where</span> <span class='hs-layout'>(</span><span class='hs-varid'>singlePreds</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fold_blocks</span> <span class='hs-varid'>add</span> <span class='hs-layout'>(</span><span class='hs-varid'>emptyBlockSet</span><span class='hs-layout'>,</span> <span class='hs-varid'>emptyBlockSet</span><span class='hs-layout'>)</span> <span class='hs-varid'>g</span> <a name="line-30"></a> <span class='hs-varid'>add</span> <span class='hs-varid'>b</span> <span class='hs-layout'>(</span><span class='hs-varid'>single</span><span class='hs-layout'>,</span> <span class='hs-varid'>multi</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldl</span> <span class='hs-varid'>add_pred</span> <span class='hs-layout'>(</span><span class='hs-varid'>single</span><span class='hs-layout'>,</span> <span class='hs-varid'>multi</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>succs</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <a name="line-31"></a> <span class='hs-varid'>add_pred</span> <span class='hs-varid'>pair</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-varid'>single</span><span class='hs-layout'>,</span> <span class='hs-varid'>multi</span><span class='hs-layout'>)</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'>=</span> <a name="line-32"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>elemBlockSet</span> <span class='hs-varid'>id</span> <span class='hs-varid'>multi</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>pair</span> <a name="line-33"></a> <span class='hs-keyword'>else</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>elemBlockSet</span> <span class='hs-varid'>id</span> <span class='hs-varid'>single</span> <span class='hs-keyword'>then</span> <a name="line-34"></a> <span class='hs-layout'>(</span><span class='hs-varid'>removeBlockSet</span> <span class='hs-varid'>single</span> <span class='hs-varid'>id</span><span class='hs-layout'>,</span> <span class='hs-varid'>extendBlockSet</span> <span class='hs-varid'>multi</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span> <a name="line-35"></a> <span class='hs-keyword'>else</span> <a name="line-36"></a> <span class='hs-layout'>(</span><span class='hs-varid'>extendBlockSet</span> <span class='hs-varid'>single</span> <span class='hs-varid'>id</span><span class='hs-layout'>,</span> <span class='hs-varid'>multi</span><span class='hs-layout'>)</span> <a name="line-37"></a> <a name="line-38"></a> <a name="line-39"></a> </pre></body> </html>
