<?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>simplCore/SimplMonad.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The AQUA Project, Glasgow University, 1993-1998
%
\section[SimplMonad]{The simplifier Monad}
\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>SimplMonad</span> <span class='hs-layout'>(</span>
<a name="line-2"></a> <span class='hs-comment'>-- The monad</span>
<a name="line-3"></a> <span class='hs-conid'>SimplM</span><span class='hs-layout'>,</span>
<a name="line-4"></a> <span class='hs-varid'>initSmpl</span><span class='hs-layout'>,</span>
<a name="line-5"></a> <span class='hs-varid'>getDOptsSmpl</span><span class='hs-layout'>,</span> <span class='hs-varid'>getSimplRules</span><span class='hs-layout'>,</span> <span class='hs-varid'>getFamEnvs</span><span class='hs-layout'>,</span>
<a name="line-6"></a>
<a name="line-7"></a> <span class='hs-comment'>-- Unique supply</span>
<a name="line-8"></a> <span class='hs-conid'>MonadUnique</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>newId</span><span class='hs-layout'>,</span>
<a name="line-9"></a>
<a name="line-10"></a> <span class='hs-comment'>-- Counting</span>
<a name="line-11"></a> <span class='hs-conid'>SimplCount</span><span class='hs-layout'>,</span> <span class='hs-conid'>Tick</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-12"></a> <span class='hs-varid'>tick</span><span class='hs-layout'>,</span> <span class='hs-varid'>freeTick</span><span class='hs-layout'>,</span>
<a name="line-13"></a> <span class='hs-varid'>getSimplCount</span><span class='hs-layout'>,</span> <span class='hs-varid'>zeroSimplCount</span><span class='hs-layout'>,</span> <span class='hs-varid'>pprSimplCount</span><span class='hs-layout'>,</span>
<a name="line-14"></a> <span class='hs-varid'>plusSimplCount</span><span class='hs-layout'>,</span> <span class='hs-varid'>isZeroSimplCount</span><span class='hs-layout'>,</span>
<a name="line-15"></a>
<a name="line-16"></a> <span class='hs-comment'>-- Switch checker</span>
<a name="line-17"></a> <span class='hs-conid'>SwitchChecker</span><span class='hs-layout'>,</span> <span class='hs-conid'>SwitchResult</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>getSimplIntSwitch</span><span class='hs-layout'>,</span>
<a name="line-18"></a> <span class='hs-varid'>isAmongSimpl</span><span class='hs-layout'>,</span> <span class='hs-varid'>intSwitchSet</span><span class='hs-layout'>,</span> <span class='hs-varid'>switchIsOn</span>
<a name="line-19"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-20"></a>
<a name="line-21"></a><span class='hs-keyword'>import</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-varid'>mkSysLocal</span> <span class='hs-layout'>)</span>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Type</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Type</span> <span class='hs-layout'>)</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FamInstEnv</span> <span class='hs-layout'>(</span> <span class='hs-conid'>FamInstEnv</span> <span class='hs-layout'>)</span>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Rules</span> <span class='hs-layout'>(</span> <span class='hs-conid'>RuleBase</span> <span class='hs-layout'>)</span>
<a name="line-25"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>UniqSupply</span>
<a name="line-26"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DynFlags</span> <span class='hs-layout'>(</span> <span class='hs-conid'>SimplifierSwitch</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>DynFlags</span><span class='hs-layout'>,</span> <span class='hs-conid'>DynFlag</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>dopt</span> <span class='hs-layout'>)</span>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>StaticFlags</span> <span class='hs-layout'>(</span> <span class='hs-varid'>opt_PprStyle_Debug</span><span class='hs-layout'>,</span> <span class='hs-varid'>opt_HistorySize</span> <span class='hs-layout'>)</span>
<a name="line-28"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Maybes</span> <span class='hs-layout'>(</span> <span class='hs-varid'>expectJust</span> <span class='hs-layout'>)</span>
<a name="line-29"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-layout'>(</span> <span class='hs-conid'>FiniteMap</span><span class='hs-layout'>,</span> <span class='hs-varid'>emptyFM</span><span class='hs-layout'>,</span> <span class='hs-varid'>lookupFM</span><span class='hs-layout'>,</span> <span class='hs-varid'>addToFM</span><span class='hs-layout'>,</span> <span class='hs-varid'>plusFM_C</span><span class='hs-layout'>,</span> <span class='hs-varid'>fmToList</span> <span class='hs-layout'>)</span>
<a name="line-30"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastString</span>
<a name="line-31"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastTypes</span>
<a name="line-33"></a>
<a name="line-34"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Array</span>
<a name="line-35"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Array</span><span class='hs-varop'>.</span><span class='hs-conid'>Base</span> <span class='hs-layout'>(</span><span class='hs-varid'>unsafeAt</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Monad plumbing}
%* *
%************************************************************************
For the simplifier monad, we want to {\em thread} a unique supply and a counter.
(Command-line switches move around through the explicitly-passed SimplEnv.)
\begin{code}
<pre><a name="line-1"></a><a name="SimplM"></a><span class='hs-keyword'>newtype</span> <span class='hs-conid'>SimplM</span> <span class='hs-varid'>result</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>{</span> <span class='hs-varid'>unSM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplTopEnv</span> <span class='hs-comment'>-- Envt that does not change much</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UniqSupply</span> <span class='hs-comment'>-- We thread the unique supply because</span>
<a name="line-4"></a> <span class='hs-comment'>-- constantly splitting it is rather expensive</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplCount</span>
<a name="line-6"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>result</span><span class='hs-layout'>,</span> <span class='hs-conid'>UniqSupply</span><span class='hs-layout'>,</span> <span class='hs-conid'>SimplCount</span><span class='hs-layout'>)</span><span class='hs-layout'>}</span>
<a name="line-7"></a>
<a name="line-8"></a><a name="SimplTopEnv"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>SimplTopEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>STE</span> <span class='hs-layout'>{</span> <span class='hs-varid'>st_flags</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DynFlags</span>
<a name="line-9"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>st_rules</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleBase</span>
<a name="line-10"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>st_fams</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>FamInstEnv</span><span class='hs-layout'>,</span> <span class='hs-conid'>FamInstEnv</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="initSmpl"></a><span class='hs-definition'>initSmpl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DynFlags</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RuleBase</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>FamInstEnv</span><span class='hs-layout'>,</span> <span class='hs-conid'>FamInstEnv</span><span class='hs-layout'>)</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UniqSupply</span> <span class='hs-comment'>-- No init count; set to 0</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplM</span> <span class='hs-varid'>a</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>SimplCount</span><span class='hs-layout'>)</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-definition'>initSmpl</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>rules</span> <span class='hs-varid'>fam_envs</span> <span class='hs-varid'>us</span> <span class='hs-varid'>m</span>
<a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>unSM</span> <span class='hs-varid'>m</span> <span class='hs-varid'>env</span> <span class='hs-varid'>us</span> <span class='hs-layout'>(</span><span class='hs-varid'>zeroSimplCount</span> <span class='hs-varid'>dflags</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-8"></a> <span class='hs-layout'>(</span><span class='hs-varid'>result</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>count</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>result</span><span class='hs-layout'>,</span> <span class='hs-varid'>count</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-keyword'>where</span>
<a name="line-10"></a> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>STE</span> <span class='hs-layout'>{</span> <span class='hs-varid'>st_flags</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dflags</span><span class='hs-layout'>,</span> <span class='hs-varid'>st_rules</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rules</span><span class='hs-layout'>,</span> <span class='hs-varid'>st_fams</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fam_envs</span> <span class='hs-layout'>}</span>
<a name="line-11"></a>
<a name="line-12"></a><span class='hs-comment'>{-# INLINE thenSmpl #-}</span>
<a name="line-13"></a><span class='hs-comment'>{-# INLINE thenSmpl_ #-}</span>
<a name="line-14"></a><span class='hs-comment'>{-# INLINE returnSmpl #-}</span>
<a name="line-15"></a>
<a name="line-16"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Monad</span> <span class='hs-conid'>SimplM</span> <span class='hs-keyword'>where</span>
<a name="line-17"></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'>thenSmpl_</span>
<a name="line-18"></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'>thenSmpl</span>
<a name="line-19"></a> <span class='hs-varid'>return</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>returnSmpl</span>
<a name="line-20"></a>
<a name="line-21"></a><a name="returnSmpl"></a><span class='hs-definition'>returnSmpl</span> <span class='hs-keyglyph'>::</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplM</span> <span class='hs-varid'>a</span>
<a name="line-22"></a><span class='hs-definition'>returnSmpl</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-sel'>_st_env</span> <span class='hs-varid'>us</span> <span class='hs-varid'>sc</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>e</span><span class='hs-layout'>,</span> <span class='hs-varid'>us</span><span class='hs-layout'>,</span> <span class='hs-varid'>sc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-23"></a>
<a name="line-24"></a><a name="thenSmpl"></a><span class='hs-definition'>thenSmpl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplM</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'>SimplM</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplM</span> <span class='hs-varid'>b</span>
<a name="line-25"></a><a name="thenSmpl_"></a><span class='hs-definition'>thenSmpl_</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplM</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplM</span> <span class='hs-varid'>b</span>
<a name="line-26"></a>
<a name="line-27"></a><span class='hs-definition'>thenSmpl</span> <span class='hs-varid'>m</span> <span class='hs-varid'>k</span>
<a name="line-28"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>st_env</span> <span class='hs-varid'>us0</span> <span class='hs-varid'>sc0</span> <span class='hs-keyglyph'>-></span>
<a name="line-29"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>unSM</span> <span class='hs-varid'>m</span> <span class='hs-varid'>st_env</span> <span class='hs-varid'>us0</span> <span class='hs-varid'>sc0</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-30"></a> <span class='hs-layout'>(</span><span class='hs-varid'>m_result</span><span class='hs-layout'>,</span> <span class='hs-varid'>us1</span><span class='hs-layout'>,</span> <span class='hs-varid'>sc1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unSM</span> <span class='hs-layout'>(</span><span class='hs-varid'>k</span> <span class='hs-varid'>m_result</span><span class='hs-layout'>)</span> <span class='hs-varid'>st_env</span> <span class='hs-varid'>us1</span> <span class='hs-varid'>sc1</span> <span class='hs-layout'>)</span>
<a name="line-31"></a>
<a name="line-32"></a><span class='hs-definition'>thenSmpl_</span> <span class='hs-varid'>m</span> <span class='hs-varid'>k</span>
<a name="line-33"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st_env</span> <span class='hs-varid'>us0</span> <span class='hs-varid'>sc0</span> <span class='hs-keyglyph'>-></span>
<a name="line-34"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>unSM</span> <span class='hs-varid'>m</span> <span class='hs-varid'>st_env</span> <span class='hs-varid'>us0</span> <span class='hs-varid'>sc0</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-35"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>us1</span><span class='hs-layout'>,</span> <span class='hs-varid'>sc1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unSM</span> <span class='hs-varid'>k</span> <span class='hs-varid'>st_env</span> <span class='hs-varid'>us1</span> <span class='hs-varid'>sc1</span><span class='hs-layout'>)</span>
<a name="line-36"></a>
<a name="line-37"></a><span class='hs-comment'>-- TODO: this specializing is not allowed</span>
<a name="line-38"></a><span class='hs-comment'>-- {-# SPECIALIZE mapM :: (a -> SimplM b) -> [a] -> SimplM [b] #-}</span>
<a name="line-39"></a><span class='hs-comment'>-- {-# SPECIALIZE mapAndUnzipM :: (a -> SimplM (b, c)) -> [a] -> SimplM ([b],[c]) #-}</span>
<a name="line-40"></a><span class='hs-comment'>-- {-# SPECIALIZE mapAccumLM :: (acc -> b -> SimplM (acc,c)) -> acc -> [b] -> SimplM (acc, [c]) #-}</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{The unique supply}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>MonadUnique</span> <span class='hs-conid'>SimplM</span> <span class='hs-keyword'>where</span>
<a name="line-2"></a> <span class='hs-varid'>getUniqueSupplyM</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-sel'>_st_env</span> <span class='hs-varid'>us</span> <span class='hs-varid'>sc</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>case</span> <span class='hs-varid'>splitUniqSupply</span> <span class='hs-varid'>us</span> <span class='hs-keyword'>of</span>
<a name="line-4"></a> <span class='hs-layout'>(</span><span class='hs-varid'>us1</span><span class='hs-layout'>,</span> <span class='hs-varid'>us2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>us1</span><span class='hs-layout'>,</span> <span class='hs-varid'>us2</span><span class='hs-layout'>,</span> <span class='hs-varid'>sc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-5"></a>
<a name="line-6"></a> <span class='hs-varid'>getUniqueM</span>
<a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-sel'>_st_env</span> <span class='hs-varid'>us</span> <span class='hs-varid'>sc</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>case</span> <span class='hs-varid'>splitUniqSupply</span> <span class='hs-varid'>us</span> <span class='hs-keyword'>of</span>
<a name="line-8"></a> <span class='hs-layout'>(</span><span class='hs-varid'>us1</span><span class='hs-layout'>,</span> <span class='hs-varid'>us2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>uniqFromSupply</span> <span class='hs-varid'>us1</span><span class='hs-layout'>,</span> <span class='hs-varid'>us2</span><span class='hs-layout'>,</span> <span class='hs-varid'>sc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-9"></a>
<a name="line-10"></a> <span class='hs-varid'>getUniquesM</span>
<a name="line-11"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-sel'>_st_env</span> <span class='hs-varid'>us</span> <span class='hs-varid'>sc</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>case</span> <span class='hs-varid'>splitUniqSupply</span> <span class='hs-varid'>us</span> <span class='hs-keyword'>of</span>
<a name="line-12"></a> <span class='hs-layout'>(</span><span class='hs-varid'>us1</span><span class='hs-layout'>,</span> <span class='hs-varid'>us2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>uniqsFromSupply</span> <span class='hs-varid'>us1</span><span class='hs-layout'>,</span> <span class='hs-varid'>us2</span><span class='hs-layout'>,</span> <span class='hs-varid'>sc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-13"></a>
<a name="line-14"></a><a name="getDOptsSmpl"></a><span class='hs-definition'>getDOptsSmpl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplM</span> <span class='hs-conid'>DynFlags</span>
<a name="line-15"></a><span class='hs-definition'>getDOptsSmpl</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st_env</span> <span class='hs-varid'>us</span> <span class='hs-varid'>sc</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>st_flags</span> <span class='hs-varid'>st_env</span><span class='hs-layout'>,</span> <span class='hs-varid'>us</span><span class='hs-layout'>,</span> <span class='hs-varid'>sc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-16"></a>
<a name="line-17"></a><a name="getSimplRules"></a><span class='hs-definition'>getSimplRules</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplM</span> <span class='hs-conid'>RuleBase</span>
<a name="line-18"></a><span class='hs-definition'>getSimplRules</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st_env</span> <span class='hs-varid'>us</span> <span class='hs-varid'>sc</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>st_rules</span> <span class='hs-varid'>st_env</span><span class='hs-layout'>,</span> <span class='hs-varid'>us</span><span class='hs-layout'>,</span> <span class='hs-varid'>sc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-19"></a>
<a name="line-20"></a><a name="getFamEnvs"></a><span class='hs-definition'>getFamEnvs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplM</span> <span class='hs-layout'>(</span><span class='hs-conid'>FamInstEnv</span><span class='hs-layout'>,</span> <span class='hs-conid'>FamInstEnv</span><span class='hs-layout'>)</span>
<a name="line-21"></a><span class='hs-definition'>getFamEnvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st_env</span> <span class='hs-varid'>us</span> <span class='hs-varid'>sc</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>st_fams</span> <span class='hs-varid'>st_env</span><span class='hs-layout'>,</span> <span class='hs-varid'>us</span><span class='hs-layout'>,</span> <span class='hs-varid'>sc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-22"></a>
<a name="line-23"></a><a name="newId"></a><span class='hs-definition'>newId</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FastString</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplM</span> <span class='hs-conid'>Id</span>
<a name="line-24"></a><span class='hs-definition'>newId</span> <span class='hs-varid'>fs</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>uniq</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getUniqueM</span>
<a name="line-25"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkSysLocal</span> <span class='hs-varid'>fs</span> <span class='hs-varid'>uniq</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Counting up what we've done}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="getSimplCount"></a><span class='hs-definition'>getSimplCount</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplM</span> <span class='hs-conid'>SimplCount</span>
<a name="line-2"></a><span class='hs-definition'>getSimplCount</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-sel'>_st_env</span> <span class='hs-varid'>us</span> <span class='hs-varid'>sc</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>sc</span><span class='hs-layout'>,</span> <span class='hs-varid'>us</span><span class='hs-layout'>,</span> <span class='hs-varid'>sc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-3"></a>
<a name="line-4"></a><a name="tick"></a><span class='hs-definition'>tick</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Tick</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplM</span> <span class='hs-conid'>()</span>
<a name="line-5"></a><span class='hs-definition'>tick</span> <span class='hs-varid'>t</span>
<a name="line-6"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-sel'>_st_env</span> <span class='hs-varid'>us</span> <span class='hs-varid'>sc</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>sc'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>doTick</span> <span class='hs-varid'>t</span> <span class='hs-varid'>sc</span>
<a name="line-7"></a> <span class='hs-keyword'>in</span> <span class='hs-varid'>sc'</span> <span class='hs-varop'>`seq`</span> <span class='hs-layout'>(</span><span class='hs-conid'>()</span><span class='hs-layout'>,</span> <span class='hs-varid'>us</span><span class='hs-layout'>,</span> <span class='hs-varid'>sc'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-8"></a>
<a name="line-9"></a><a name="freeTick"></a><span class='hs-definition'>freeTick</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Tick</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplM</span> <span class='hs-conid'>()</span>
<a name="line-10"></a><span class='hs-comment'>-- Record a tick, but don't add to the total tick count, which is</span>
<a name="line-11"></a><span class='hs-comment'>-- used to decide when nothing further has happened</span>
<a name="line-12"></a><span class='hs-definition'>freeTick</span> <span class='hs-varid'>t</span>
<a name="line-13"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-sel'>_st_env</span> <span class='hs-varid'>us</span> <span class='hs-varid'>sc</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>sc'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>doFreeTick</span> <span class='hs-varid'>t</span> <span class='hs-varid'>sc</span>
<a name="line-14"></a> <span class='hs-keyword'>in</span> <span class='hs-varid'>sc'</span> <span class='hs-varop'>`seq`</span> <span class='hs-layout'>(</span><span class='hs-conid'>()</span><span class='hs-layout'>,</span> <span class='hs-varid'>us</span><span class='hs-layout'>,</span> <span class='hs-varid'>sc'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="verboseSimplStats"></a><span class='hs-definition'>verboseSimplStats</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span>
<a name="line-2"></a><span class='hs-definition'>verboseSimplStats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>opt_PprStyle_Debug</span> <span class='hs-comment'>-- For now, anyway</span>
<a name="line-3"></a>
<a name="line-4"></a><a name="zeroSimplCount"></a><span class='hs-definition'>zeroSimplCount</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DynFlags</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplCount</span>
<a name="line-5"></a><a name="isZeroSimplCount"></a><span class='hs-definition'>isZeroSimplCount</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplCount</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-6"></a><a name="pprSimplCount"></a><span class='hs-definition'>pprSimplCount</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplCount</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-7"></a><a name="doTick"></a><span class='hs-definition'>doTick</span><span class='hs-layout'>,</span> <span class='hs-varid'>doFreeTick</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Tick</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplCount</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplCount</span>
<a name="line-8"></a><a name="plusSimplCount"></a><span class='hs-definition'>plusSimplCount</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplCount</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplCount</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplCount</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="SimplCount"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>SimplCount</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>VerySimplZero</span> <span class='hs-comment'>-- These two are used when </span>
<a name="line-2"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>VerySimplNonZero</span> <span class='hs-comment'>-- we are only interested in </span>
<a name="line-3"></a> <span class='hs-comment'>-- termination info</span>
<a name="line-4"></a>
<a name="line-5"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>SimplCount</span> <span class='hs-layout'>{</span>
<a name="line-6"></a> <span class='hs-varid'>ticks</span> <span class='hs-keyglyph'>::</span> <span class='hs-varop'>!</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Total ticks</span>
<a name="line-7"></a> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>::</span> <span class='hs-varop'>!</span><span class='hs-conid'>TickCounts</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- How many of each type</span>
<a name="line-8"></a> <span class='hs-varid'>n_log</span> <span class='hs-keyglyph'>::</span> <span class='hs-varop'>!</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- N</span>
<a name="line-9"></a> <span class='hs-varid'>log1</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Tick</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Last N events; <= opt_HistorySize</span>
<a name="line-10"></a> <span class='hs-varid'>log2</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Tick</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Last opt_HistorySize events before that</span>
<a name="line-11"></a> <span class='hs-layout'>}</span>
<a name="line-12"></a>
<a name="line-13"></a><a name="TickCounts"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>TickCounts</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-conid'>Tick</span> <span class='hs-conid'>Int</span>
<a name="line-14"></a>
<a name="line-15"></a><a name="zeroSimplCount"></a><span class='hs-definition'>zeroSimplCount</span> <span class='hs-varid'>dflags</span>
<a name="line-16"></a> <span class='hs-comment'>-- This is where we decide whether to do</span>
<a name="line-17"></a> <span class='hs-comment'>-- the VerySimpl version or the full-stats version</span>
<a name="line-18"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>dopt</span> <span class='hs-conid'>Opt_D_dump_simpl_stats</span> <span class='hs-varid'>dflags</span>
<a name="line-19"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SimplCount</span> <span class='hs-layout'>{</span><span class='hs-varid'>ticks</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0</span><span class='hs-layout'>,</span> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyFM</span><span class='hs-layout'>,</span>
<a name="line-20"></a> <span class='hs-varid'>n_log</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0</span><span class='hs-layout'>,</span> <span class='hs-varid'>log1</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>log2</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span><span class='hs-layout'>}</span>
<a name="line-21"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-22"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>VerySimplZero</span>
<a name="line-23"></a>
<a name="line-24"></a><a name="isZeroSimplCount"></a><span class='hs-definition'>isZeroSimplCount</span> <span class='hs-conid'>VerySimplZero</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-25"></a><span class='hs-definition'>isZeroSimplCount</span> <span class='hs-layout'>(</span><span class='hs-conid'>SimplCount</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ticks</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-26"></a><span class='hs-definition'>isZeroSimplCount</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-27"></a>
<a name="line-28"></a><a name="doFreeTick"></a><span class='hs-definition'>doFreeTick</span> <span class='hs-varid'>tick</span> <span class='hs-varid'>sc</span><span class='hs-keyglyph'>@</span><span class='hs-conid'>SimplCount</span> <span class='hs-layout'>{</span> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dts</span> <span class='hs-layout'>}</span>
<a name="line-29"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sc</span> <span class='hs-layout'>{</span> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dts</span> <span class='hs-varop'>`addTick`</span> <span class='hs-varid'>tick</span> <span class='hs-layout'>}</span>
<a name="line-30"></a><span class='hs-definition'>doFreeTick</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>sc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sc</span>
<a name="line-31"></a>
<a name="line-32"></a><a name="doTick"></a><span class='hs-definition'>doTick</span> <span class='hs-varid'>tick</span> <span class='hs-varid'>sc</span><span class='hs-keyglyph'>@</span><span class='hs-conid'>SimplCount</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ticks</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tks</span><span class='hs-layout'>,</span> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dts</span><span class='hs-layout'>,</span> <span class='hs-varid'>n_log</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nl</span><span class='hs-layout'>,</span> <span class='hs-varid'>log1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>l1</span> <span class='hs-layout'>}</span>
<a name="line-33"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>nl</span> <span class='hs-varop'>>=</span> <span class='hs-varid'>opt_HistorySize</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sc1</span> <span class='hs-layout'>{</span> <span class='hs-varid'>n_log</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>1</span><span class='hs-layout'>,</span> <span class='hs-varid'>log1</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>tick</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-varid'>log2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>l1</span> <span class='hs-layout'>}</span>
<a name="line-34"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sc1</span> <span class='hs-layout'>{</span> <span class='hs-varid'>n_log</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nl</span><span class='hs-varop'>+</span><span class='hs-num'>1</span><span class='hs-layout'>,</span> <span class='hs-varid'>log1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tick</span> <span class='hs-conop'>:</span> <span class='hs-varid'>l1</span> <span class='hs-layout'>}</span>
<a name="line-35"></a> <span class='hs-keyword'>where</span>
<a name="line-36"></a> <span class='hs-varid'>sc1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sc</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ticks</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tks</span><span class='hs-varop'>+</span><span class='hs-num'>1</span><span class='hs-layout'>,</span> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dts</span> <span class='hs-varop'>`addTick`</span> <span class='hs-varid'>tick</span> <span class='hs-layout'>}</span>
<a name="line-37"></a>
<a name="line-38"></a><span class='hs-definition'>doTick</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>VerySimplNonZero</span> <span class='hs-comment'>-- The very simple case</span>
<a name="line-39"></a>
<a name="line-40"></a>
<a name="line-41"></a><a name="addTick"></a><span class='hs-comment'>-- Don't use plusFM_C because that's lazy, and we want to </span>
<a name="line-42"></a><span class='hs-comment'>-- be pretty strict here!</span>
<a name="line-43"></a><span class='hs-definition'>addTick</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TickCounts</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Tick</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TickCounts</span>
<a name="line-44"></a><span class='hs-definition'>addTick</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>tick</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupFM</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>tick</span> <span class='hs-keyword'>of</span>
<a name="line-45"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>addToFM</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>tick</span> <span class='hs-num'>1</span>
<a name="line-46"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>n1</span> <span class='hs-varop'>`seq`</span> <span class='hs-varid'>addToFM</span> <span class='hs-varid'>fm</span> <span class='hs-varid'>tick</span> <span class='hs-varid'>n1</span>
<a name="line-47"></a> <span class='hs-keyword'>where</span>
<a name="line-48"></a> <span class='hs-varid'>n1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>n</span><span class='hs-varop'>+</span><span class='hs-num'>1</span>
<a name="line-49"></a>
<a name="line-50"></a>
<a name="line-51"></a><a name="plusSimplCount"></a><span class='hs-definition'>plusSimplCount</span> <span class='hs-varid'>sc1</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>SimplCount</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ticks</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tks1</span><span class='hs-layout'>,</span> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dts1</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-52"></a> <span class='hs-varid'>sc2</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>SimplCount</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ticks</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tks2</span><span class='hs-layout'>,</span> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dts2</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-53"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>log_base</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ticks</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tks1</span> <span class='hs-varop'>+</span> <span class='hs-varid'>tks2</span><span class='hs-layout'>,</span> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>plusFM_C</span> <span class='hs-layout'>(</span><span class='hs-varop'>+</span><span class='hs-layout'>)</span> <span class='hs-varid'>dts1</span> <span class='hs-varid'>dts2</span> <span class='hs-layout'>}</span>
<a name="line-54"></a> <span class='hs-keyword'>where</span>
<a name="line-55"></a> <span class='hs-comment'>-- A hackish way of getting recent log info</span>
<a name="line-56"></a> <span class='hs-varid'>log_base</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>null</span> <span class='hs-layout'>(</span><span class='hs-varid'>log1</span> <span class='hs-varid'>sc2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sc1</span> <span class='hs-comment'>-- Nothing at all in sc2</span>
<a name="line-57"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>null</span> <span class='hs-layout'>(</span><span class='hs-varid'>log2</span> <span class='hs-varid'>sc2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sc2</span> <span class='hs-layout'>{</span> <span class='hs-varid'>log2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>log1</span> <span class='hs-varid'>sc1</span> <span class='hs-layout'>}</span>
<a name="line-58"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sc2</span>
<a name="line-59"></a>
<a name="line-60"></a><span class='hs-definition'>plusSimplCount</span> <span class='hs-conid'>VerySimplZero</span> <span class='hs-conid'>VerySimplZero</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>VerySimplZero</span>
<a name="line-61"></a><span class='hs-definition'>plusSimplCount</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>VerySimplNonZero</span>
<a name="line-62"></a>
<a name="line-63"></a><a name="pprSimplCount"></a><span class='hs-definition'>pprSimplCount</span> <span class='hs-conid'>VerySimplZero</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Total ticks: ZERO!"</span><span class='hs-layout'>)</span>
<a name="line-64"></a><span class='hs-definition'>pprSimplCount</span> <span class='hs-conid'>VerySimplNonZero</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Total ticks: NON-ZERO!"</span><span class='hs-layout'>)</span>
<a name="line-65"></a><span class='hs-definition'>pprSimplCount</span> <span class='hs-layout'>(</span><span class='hs-conid'>SimplCount</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ticks</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tks</span><span class='hs-layout'>,</span> <span class='hs-varid'>details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dts</span><span class='hs-layout'>,</span> <span class='hs-varid'>log1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>l1</span><span class='hs-layout'>,</span> <span class='hs-varid'>log2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>l2</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-66"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Total ticks: "</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>int</span> <span class='hs-varid'>tks</span><span class='hs-layout'>,</span>
<a name="line-67"></a> <span class='hs-varid'>text</span> <span class='hs-str'>""</span><span class='hs-layout'>,</span>
<a name="line-68"></a> <span class='hs-varid'>pprTickCounts</span> <span class='hs-layout'>(</span><span class='hs-varid'>fmToList</span> <span class='hs-varid'>dts</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-69"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>verboseSimplStats</span> <span class='hs-keyword'>then</span>
<a name="line-70"></a> <span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>text</span> <span class='hs-str'>""</span><span class='hs-layout'>,</span>
<a name="line-71"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Log (most recent first)"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-72"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>4</span> <span class='hs-layout'>(</span><span class='hs-varid'>vcat</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>l1</span><span class='hs-layout'>)</span> <span class='hs-varop'>$$</span> <span class='hs-varid'>vcat</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>l2</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-73"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>empty</span>
<a name="line-74"></a> <span class='hs-keyglyph'>]</span>
<a name="line-75"></a>
<a name="line-76"></a><a name="pprTickCounts"></a><span class='hs-definition'>pprTickCounts</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Tick</span><span class='hs-layout'>,</span><span class='hs-conid'>Int</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-77"></a><span class='hs-definition'>pprTickCounts</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>empty</span>
<a name="line-78"></a><span class='hs-definition'>pprTickCounts</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>tick1</span><span class='hs-layout'>,</span><span class='hs-varid'>n1</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>ticks</span><span class='hs-layout'>)</span>
<a name="line-79"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>int</span> <span class='hs-varid'>tot_n</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>tickString</span> <span class='hs-varid'>tick1</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-80"></a> <span class='hs-varid'>pprTCDetails</span> <span class='hs-varid'>real_these</span><span class='hs-layout'>,</span>
<a name="line-81"></a> <span class='hs-varid'>pprTickCounts</span> <span class='hs-varid'>others</span>
<a name="line-82"></a> <span class='hs-keyglyph'>]</span>
<a name="line-83"></a> <span class='hs-keyword'>where</span>
<a name="line-84"></a> <span class='hs-varid'>tick1_tag</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tickToTag</span> <span class='hs-varid'>tick1</span>
<a name="line-85"></a> <span class='hs-layout'>(</span><span class='hs-varid'>these</span><span class='hs-layout'>,</span> <span class='hs-varid'>others</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>span</span> <span class='hs-varid'>same_tick</span> <span class='hs-varid'>ticks</span>
<a name="line-86"></a> <span class='hs-varid'>real_these</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>tick1</span><span class='hs-layout'>,</span><span class='hs-varid'>n1</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>these</span>
<a name="line-87"></a> <span class='hs-varid'>same_tick</span> <span class='hs-layout'>(</span><span class='hs-varid'>tick2</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'>tickToTag</span> <span class='hs-varid'>tick2</span> <span class='hs-varop'>==</span> <span class='hs-varid'>tick1_tag</span>
<a name="line-88"></a> <span class='hs-varid'>tot_n</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sum</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>n</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>n</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>real_these</span><span class='hs-keyglyph'>]</span>
<a name="line-89"></a>
<a name="line-90"></a><a name="pprTCDetails"></a><span class='hs-definition'>pprTCDetails</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Tick</span><span class='hs-layout'>,</span> <span class='hs-conid'>Int</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-91"></a><span class='hs-definition'>pprTCDetails</span> <span class='hs-varid'>ticks</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>tick</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span>
<a name="line-92"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>verboseSimplStats</span> <span class='hs-varop'>||</span> <span class='hs-varid'>isRuleFired</span> <span class='hs-varid'>tick</span>
<a name="line-93"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nest</span> <span class='hs-num'>4</span> <span class='hs-layout'>(</span><span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>int</span> <span class='hs-varid'>n</span> <span class='hs-varop'><+></span> <span class='hs-varid'>pprTickCts</span> <span class='hs-varid'>tick</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>tick</span><span class='hs-layout'>,</span><span class='hs-varid'>n</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ticks</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-94"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-95"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>empty</span>
<a name="line-96"></a><span class='hs-definition'>pprTCDetails</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"pprTCDetails []"</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Ticks}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="Tick"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Tick</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PreInlineUnconditionally</span> <span class='hs-conid'>Id</span>
<a name="line-3"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>PostInlineUnconditionally</span> <span class='hs-conid'>Id</span>
<a name="line-4"></a>
<a name="line-5"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>UnfoldingDone</span> <span class='hs-conid'>Id</span>
<a name="line-6"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>RuleFired</span> <span class='hs-conid'>FastString</span> <span class='hs-comment'>-- Rule name</span>
<a name="line-7"></a>
<a name="line-8"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>LetFloatFromLet</span>
<a name="line-9"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>EtaExpansion</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- LHS binder</span>
<a name="line-10"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>EtaReduction</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Binder on outer lambda</span>
<a name="line-11"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>BetaReduction</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Lambda binder</span>
<a name="line-12"></a>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>CaseOfCase</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Bndr on *inner* case</span>
<a name="line-15"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>KnownBranch</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Case binder</span>
<a name="line-16"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>CaseMerge</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Binder on outer case</span>
<a name="line-17"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>AltMerge</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Case binder</span>
<a name="line-18"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>CaseElim</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Case binder</span>
<a name="line-19"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>CaseIdentity</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Case binder</span>
<a name="line-20"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>FillInCaseDefault</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Case binder</span>
<a name="line-21"></a>
<a name="line-22"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>BottomFound</span>
<a name="line-23"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>SimplifierDone</span> <span class='hs-comment'>-- Ticked at each iteration of the simplifier</span>
<a name="line-24"></a>
<a name="line-25"></a><a name="isRuleFired"></a><span class='hs-definition'>isRuleFired</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Tick</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-26"></a><span class='hs-definition'>isRuleFired</span> <span class='hs-layout'>(</span><span class='hs-conid'>RuleFired</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-27"></a><span class='hs-definition'>isRuleFired</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-28"></a>
<a name="line-29"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Outputable</span> <span class='hs-conid'>Tick</span> <span class='hs-keyword'>where</span>
<a name="line-30"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tick</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>tickString</span> <span class='hs-varid'>tick</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>pprTickCts</span> <span class='hs-varid'>tick</span>
<a name="line-31"></a>
<a name="line-32"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Eq</span> <span class='hs-conid'>Tick</span> <span class='hs-keyword'>where</span>
<a name="line-33"></a> <span class='hs-varid'>a</span> <span class='hs-varop'>==</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`cmpTick`</span> <span class='hs-varid'>b</span> <span class='hs-keyword'>of</span>
<a name="line-34"></a> <span class='hs-conid'>EQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>True</span>
<a name="line-35"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>False</span>
<a name="line-36"></a>
<a name="line-37"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Ord</span> <span class='hs-conid'>Tick</span> <span class='hs-keyword'>where</span>
<a name="line-38"></a> <span class='hs-varid'>compare</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cmpTick</span>
<a name="line-39"></a>
<a name="line-40"></a><a name="tickToTag"></a><span class='hs-definition'>tickToTag</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Tick</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span>
<a name="line-41"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>PreInlineUnconditionally</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0</span>
<a name="line-42"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>PostInlineUnconditionally</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>1</span>
<a name="line-43"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>UnfoldingDone</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>2</span>
<a name="line-44"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>RuleFired</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>3</span>
<a name="line-45"></a><span class='hs-definition'>tickToTag</span> <span class='hs-conid'>LetFloatFromLet</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>4</span>
<a name="line-46"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>EtaExpansion</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>5</span>
<a name="line-47"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>EtaReduction</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>6</span>
<a name="line-48"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>BetaReduction</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>7</span>
<a name="line-49"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseOfCase</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>8</span>
<a name="line-50"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>KnownBranch</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>9</span>
<a name="line-51"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseMerge</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>10</span>
<a name="line-52"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseElim</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>11</span>
<a name="line-53"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseIdentity</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>12</span>
<a name="line-54"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>FillInCaseDefault</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>13</span>
<a name="line-55"></a><span class='hs-definition'>tickToTag</span> <span class='hs-conid'>BottomFound</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>14</span>
<a name="line-56"></a><span class='hs-definition'>tickToTag</span> <span class='hs-conid'>SimplifierDone</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>16</span>
<a name="line-57"></a><span class='hs-definition'>tickToTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>AltMerge</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>17</span>
<a name="line-58"></a>
<a name="line-59"></a><a name="tickString"></a><span class='hs-definition'>tickString</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Tick</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span>
<a name="line-60"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>PreInlineUnconditionally</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"PreInlineUnconditionally"</span>
<a name="line-61"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>PostInlineUnconditionally</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>=</span> <span class='hs-str'>"PostInlineUnconditionally"</span>
<a name="line-62"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>UnfoldingDone</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"UnfoldingDone"</span>
<a name="line-63"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>RuleFired</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"RuleFired"</span>
<a name="line-64"></a><span class='hs-definition'>tickString</span> <span class='hs-conid'>LetFloatFromLet</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"LetFloatFromLet"</span>
<a name="line-65"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>EtaExpansion</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"EtaExpansion"</span>
<a name="line-66"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>EtaReduction</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"EtaReduction"</span>
<a name="line-67"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>BetaReduction</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"BetaReduction"</span>
<a name="line-68"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseOfCase</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"CaseOfCase"</span>
<a name="line-69"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>KnownBranch</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"KnownBranch"</span>
<a name="line-70"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseMerge</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"CaseMerge"</span>
<a name="line-71"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>AltMerge</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"AltMerge"</span>
<a name="line-72"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseElim</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"CaseElim"</span>
<a name="line-73"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseIdentity</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"CaseIdentity"</span>
<a name="line-74"></a><span class='hs-definition'>tickString</span> <span class='hs-layout'>(</span><span class='hs-conid'>FillInCaseDefault</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"FillInCaseDefault"</span>
<a name="line-75"></a><span class='hs-definition'>tickString</span> <span class='hs-conid'>BottomFound</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"BottomFound"</span>
<a name="line-76"></a><span class='hs-definition'>tickString</span> <span class='hs-conid'>SimplifierDone</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"SimplifierDone"</span>
<a name="line-77"></a>
<a name="line-78"></a><a name="pprTickCts"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Tick</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-79"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>PreInlineUnconditionally</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-80"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>PostInlineUnconditionally</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-81"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>UnfoldingDone</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-82"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>RuleFired</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-83"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-conid'>LetFloatFromLet</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>empty</span>
<a name="line-84"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>EtaExpansion</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-85"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>EtaReduction</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-86"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>BetaReduction</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-87"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseOfCase</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-88"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>KnownBranch</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-89"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseMerge</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-90"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>AltMerge</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-91"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseElim</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-92"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseIdentity</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-93"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-layout'>(</span><span class='hs-conid'>FillInCaseDefault</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>v</span>
<a name="line-94"></a><span class='hs-definition'>pprTickCts</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>empty</span>
<a name="line-95"></a>
<a name="line-96"></a><a name="cmpTick"></a><span class='hs-definition'>cmpTick</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Tick</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Tick</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Ordering</span>
<a name="line-97"></a><span class='hs-definition'>cmpTick</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>tickToTag</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>tickToTag</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-98"></a> <span class='hs-conid'>GT</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>GT</span>
<a name="line-99"></a> <span class='hs-conid'>EQ</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isRuleFired</span> <span class='hs-varid'>a</span> <span class='hs-varop'>||</span> <span class='hs-varid'>verboseSimplStats</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>cmpEqTick</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span>
<a name="line-100"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>EQ</span>
<a name="line-101"></a> <span class='hs-conid'>LT</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LT</span>
<a name="line-102"></a> <span class='hs-comment'>-- Always distinguish RuleFired, so that the stats</span>
<a name="line-103"></a> <span class='hs-comment'>-- can report them even in non-verbose mode</span>
<a name="line-104"></a>
<a name="line-105"></a><a name="cmpEqTick"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Tick</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Tick</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Ordering</span>
<a name="line-106"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>PreInlineUnconditionally</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>PreInlineUnconditionally</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-107"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>PostInlineUnconditionally</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>PostInlineUnconditionally</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-108"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>UnfoldingDone</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>UnfoldingDone</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-109"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>RuleFired</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>RuleFired</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-110"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>EtaExpansion</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>EtaExpansion</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-111"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>EtaReduction</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>EtaReduction</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-112"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>BetaReduction</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>BetaReduction</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-113"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseOfCase</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseOfCase</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-114"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>KnownBranch</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>KnownBranch</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-115"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseMerge</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseMerge</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-116"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>AltMerge</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>AltMerge</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-117"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseElim</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseElim</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-118"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseIdentity</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>CaseIdentity</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-119"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-layout'>(</span><span class='hs-conid'>FillInCaseDefault</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>FillInCaseDefault</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>b</span>
<a name="line-120"></a><span class='hs-definition'>cmpEqTick</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>EQ</span>
</pre>\end{code}
%************************************************************************
%* *
\subsubsection{Command-line switches}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="SwitchChecker"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>SwitchChecker</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SimplifierSwitch</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SwitchResult</span>
<a name="line-2"></a>
<a name="line-3"></a><a name="SwitchResult"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>SwitchResult</span>
<a name="line-4"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SwBool</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- on/off</span>
<a name="line-5"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>SwString</span> <span class='hs-conid'>FastString</span> <span class='hs-comment'>-- nothing or a String</span>
<a name="line-6"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>SwInt</span> <span class='hs-conid'>Int</span> <span class='hs-comment'>-- nothing or an Int</span>
<a name="line-7"></a>
<a name="line-8"></a><a name="isAmongSimpl"></a><span class='hs-definition'>isAmongSimpl</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>SimplifierSwitch</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplifierSwitch</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SwitchResult</span>
<a name="line-9"></a><span class='hs-definition'>isAmongSimpl</span> <span class='hs-varid'>on_switches</span> <span class='hs-comment'>-- Switches mentioned later occur *earlier*</span>
<a name="line-10"></a> <span class='hs-comment'>-- in the list; defaults right at the end.</span>
<a name="line-11"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span>
<a name="line-12"></a> <span class='hs-varid'>tidied_on_switches</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldl</span> <span class='hs-varid'>rm_dups</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>on_switches</span>
<a name="line-13"></a> <span class='hs-comment'>-- The fold*l* ensures that we keep the latest switches;</span>
<a name="line-14"></a> <span class='hs-comment'>-- ie the ones that occur earliest in the list.</span>
<a name="line-15"></a>
<a name="line-16"></a> <span class='hs-varid'>sw_tbl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Array</span> <span class='hs-conid'>Int</span> <span class='hs-conid'>SwitchResult</span>
<a name="line-17"></a> <span class='hs-varid'>sw_tbl</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>array</span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span> <span class='hs-varid'>lAST_SIMPL_SWITCH_TAG</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- bounds...</span>
<a name="line-18"></a> <span class='hs-varid'>all_undefined</span><span class='hs-layout'>)</span>
<a name="line-19"></a> <span class='hs-varop'>//</span> <span class='hs-varid'>defined_elems</span>
<a name="line-20"></a>
<a name="line-21"></a> <span class='hs-varid'>all_undefined</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-varid'>i</span><span class='hs-layout'>,</span> <span class='hs-conid'>SwBool</span> <span class='hs-conid'>False</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span> <span class='hs-keyglyph'>..</span> <span class='hs-varid'>lAST_SIMPL_SWITCH_TAG</span> <span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>]</span>
<a name="line-22"></a>
<a name="line-23"></a> <span class='hs-varid'>defined_elems</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>mk_assoc_elem</span> <span class='hs-varid'>tidied_on_switches</span>
<a name="line-24"></a> <span class='hs-keyword'>in</span>
<a name="line-25"></a> <span class='hs-comment'>-- (avoid some unboxing, bounds checking, and other horrible things:)</span>
<a name="line-26"></a> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>switch</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unsafeAt</span> <span class='hs-varid'>sw_tbl</span> <span class='hs-varop'>$</span> <span class='hs-varid'>iBox</span> <span class='hs-layout'>(</span><span class='hs-varid'>tagOf_SimplSwitch</span> <span class='hs-varid'>switch</span><span class='hs-layout'>)</span>
<a name="line-27"></a> <span class='hs-keyword'>where</span>
<a name="line-28"></a> <span class='hs-varid'>mk_assoc_elem</span> <span class='hs-varid'>k</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>MaxSimplifierIterations</span> <span class='hs-varid'>lvl</span><span class='hs-layout'>)</span>
<a name="line-29"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>iBox</span> <span class='hs-layout'>(</span><span class='hs-varid'>tagOf_SimplSwitch</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>SwInt</span> <span class='hs-varid'>lvl</span><span class='hs-layout'>)</span>
<a name="line-30"></a> <span class='hs-varid'>mk_assoc_elem</span> <span class='hs-varid'>k</span>
<a name="line-31"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>iBox</span> <span class='hs-layout'>(</span><span class='hs-varid'>tagOf_SimplSwitch</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>SwBool</span> <span class='hs-conid'>True</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- I'm here, Mom!</span>
<a name="line-32"></a>
<a name="line-33"></a> <span class='hs-comment'>-- cannot have duplicates if we are going to use the array thing</span>
<a name="line-34"></a> <span class='hs-varid'>rm_dups</span> <span class='hs-varid'>switches_so_far</span> <span class='hs-varid'>switch</span>
<a name="line-35"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>switch</span> <span class='hs-varop'>`is_elem`</span> <span class='hs-varid'>switches_so_far</span>
<a name="line-36"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>switches_so_far</span>
<a name="line-37"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>switch</span> <span class='hs-conop'>:</span> <span class='hs-varid'>switches_so_far</span>
<a name="line-38"></a> <span class='hs-keyword'>where</span>
<a name="line-39"></a> <span class='hs-keyword'>_</span> <span class='hs-varop'>`is_elem`</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-40"></a> <span class='hs-varid'>sw</span> <span class='hs-varop'>`is_elem`</span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span><span class='hs-conop'>:</span><span class='hs-varid'>ss</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>tagOf_SimplSwitch</span> <span class='hs-varid'>sw</span><span class='hs-layout'>)</span> <span class='hs-varop'>==#</span> <span class='hs-layout'>(</span><span class='hs-varid'>tagOf_SimplSwitch</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span>
<a name="line-41"></a> <span class='hs-varop'>||</span> <span class='hs-varid'>sw</span> <span class='hs-varop'>`is_elem`</span> <span class='hs-varid'>ss</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="getSimplIntSwitch"></a><span class='hs-definition'>getSimplIntSwitch</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SwitchChecker</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Int</span><span class='hs-keyglyph'>-></span> <span class='hs-conid'>SimplifierSwitch</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span>
<a name="line-2"></a><span class='hs-definition'>getSimplIntSwitch</span> <span class='hs-varid'>chkr</span> <span class='hs-varid'>switch</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>expectJust</span> <span class='hs-str'>"getSimplIntSwitch"</span> <span class='hs-layout'>(</span><span class='hs-varid'>intSwitchSet</span> <span class='hs-varid'>chkr</span> <span class='hs-varid'>switch</span><span class='hs-layout'>)</span>
<a name="line-4"></a>
<a name="line-5"></a><a name="switchIsOn"></a><span class='hs-definition'>switchIsOn</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>switch</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SwitchResult</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>switch</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-definition'>switchIsOn</span> <span class='hs-varid'>lookup_fn</span> <span class='hs-varid'>switch</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>lookup_fn</span> <span class='hs-varid'>switch</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-9"></a> <span class='hs-conid'>SwBool</span> <span class='hs-conid'>False</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>False</span>
<a name="line-10"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>True</span>
<a name="line-11"></a>
<a name="line-12"></a><a name="intSwitchSet"></a><span class='hs-definition'>intSwitchSet</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>switch</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SwitchResult</span><span class='hs-layout'>)</span>
<a name="line-13"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>switch</span><span class='hs-layout'>)</span>
<a name="line-14"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Int</span>
<a name="line-15"></a>
<a name="line-16"></a><span class='hs-definition'>intSwitchSet</span> <span class='hs-varid'>lookup_fn</span> <span class='hs-varid'>switch</span>
<a name="line-17"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>lookup_fn</span> <span class='hs-layout'>(</span><span class='hs-varid'>switch</span> <span class='hs-layout'>(</span><span class='hs-varid'>panic</span> <span class='hs-str'>"intSwitchSet"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-18"></a> <span class='hs-conid'>SwInt</span> <span class='hs-varid'>int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Just</span> <span class='hs-varid'>int</span>
<a name="line-19"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Nothing</span>
</pre>\end{code}
These things behave just like enumeration types.
\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Eq</span> <span class='hs-conid'>SimplifierSwitch</span> <span class='hs-keyword'>where</span>
<a name="line-2"></a> <span class='hs-varid'>a</span> <span class='hs-varop'>==</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tagOf_SimplSwitch</span> <span class='hs-varid'>a</span> <span class='hs-varop'>==#</span> <span class='hs-varid'>tagOf_SimplSwitch</span> <span class='hs-varid'>b</span>
<a name="line-3"></a>
<a name="line-4"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Ord</span> <span class='hs-conid'>SimplifierSwitch</span> <span class='hs-keyword'>where</span>
<a name="line-5"></a> <span class='hs-varid'>a</span> <span class='hs-varop'><</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tagOf_SimplSwitch</span> <span class='hs-varid'>a</span> <span class='hs-varop'><#</span> <span class='hs-varid'>tagOf_SimplSwitch</span> <span class='hs-varid'>b</span>
<a name="line-6"></a> <span class='hs-varid'>a</span> <span class='hs-varop'><=</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tagOf_SimplSwitch</span> <span class='hs-varid'>a</span> <span class='hs-varop'><=#</span> <span class='hs-varid'>tagOf_SimplSwitch</span> <span class='hs-varid'>b</span>
<a name="line-7"></a>
<a name="line-8"></a>
<a name="line-9"></a><a name="tagOf_SimplSwitch"></a><span class='hs-definition'>tagOf_SimplSwitch</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplifierSwitch</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FastInt</span>
<a name="line-10"></a><span class='hs-definition'>tagOf_SimplSwitch</span> <span class='hs-layout'>(</span><span class='hs-conid'>MaxSimplifierIterations</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-sel'>_ILIT</span><span class='hs-layout'>(</span><span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-11"></a><span class='hs-definition'>tagOf_SimplSwitch</span> <span class='hs-conid'>NoCaseOfCase</span> <span class='hs-keyglyph'>=</span> <span class='hs-sel'>_ILIT</span><span class='hs-layout'>(</span><span class='hs-num'>2</span><span class='hs-layout'>)</span>
<a name="line-12"></a>
<a name="line-13"></a><span class='hs-comment'>-- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!</span>
<a name="line-14"></a>
<a name="line-15"></a><a name="lAST_SIMPL_SWITCH_TAG"></a><span class='hs-definition'>lAST_SIMPL_SWITCH_TAG</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span>
<a name="line-16"></a><span class='hs-definition'>lAST_SIMPL_SWITCH_TAG</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>2</span>
</pre>\end{code}
</body>
</html>
