<?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>specialise/Rules.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[CoreRules]{Transformation rules}
\begin{code}
<pre><a name="line-1"></a><span class='hs-comment'>-- | Functions for collecting together and applying rewrite rules to a module.</span>
<a name="line-2"></a><span class='hs-comment'>-- The 'CoreRule' datatype itself is declared elsewhere.</span>
<a name="line-3"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Rules</span> <span class='hs-layout'>(</span>
<a name="line-4"></a> <span class='hs-comment'>-- * RuleBase</span>
<a name="line-5"></a> <span class='hs-conid'>RuleBase</span><span class='hs-layout'>,</span>
<a name="line-6"></a>
<a name="line-7"></a> <span class='hs-comment'>-- ** Constructing </span>
<a name="line-8"></a> <span class='hs-varid'>emptyRuleBase</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkRuleBase</span><span class='hs-layout'>,</span> <span class='hs-varid'>extendRuleBaseList</span><span class='hs-layout'>,</span>
<a name="line-9"></a> <span class='hs-varid'>unionRuleBase</span><span class='hs-layout'>,</span> <span class='hs-varid'>pprRuleBase</span><span class='hs-layout'>,</span>
<a name="line-10"></a>
<a name="line-11"></a> <span class='hs-comment'>-- ** Checking rule applications</span>
<a name="line-12"></a> <span class='hs-varid'>ruleCheckProgram</span><span class='hs-layout'>,</span>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-comment'>-- ** Manipulating 'SpecInfo' rules</span>
<a name="line-15"></a> <span class='hs-varid'>mkSpecInfo</span><span class='hs-layout'>,</span> <span class='hs-varid'>extendSpecInfo</span><span class='hs-layout'>,</span> <span class='hs-varid'>addSpecInfo</span><span class='hs-layout'>,</span>
<a name="line-16"></a> <span class='hs-varid'>addIdSpecialisations</span><span class='hs-layout'>,</span>
<a name="line-17"></a>
<a name="line-18"></a> <span class='hs-comment'>-- * Misc. CoreRule helpers</span>
<a name="line-19"></a> <span class='hs-varid'>rulesOfBinds</span><span class='hs-layout'>,</span> <span class='hs-varid'>getRules</span><span class='hs-layout'>,</span> <span class='hs-varid'>pprRulesForUser</span><span class='hs-layout'>,</span>
<a name="line-20"></a>
<a name="line-21"></a> <span class='hs-varid'>lookupRule</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkLocalRule</span><span class='hs-layout'>,</span> <span class='hs-varid'>roughTopNames</span>
<a name="line-22"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-23"></a>
<a name="line-24"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-25"></a>
<a name="line-26"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreSyn</span> <span class='hs-comment'>-- All of it</span>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>OccurAnal</span> <span class='hs-layout'>(</span> <span class='hs-varid'>occurAnalyseExpr</span> <span class='hs-layout'>)</span>
<a name="line-28"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreFVs</span> <span class='hs-layout'>(</span> <span class='hs-varid'>exprFreeVars</span><span class='hs-layout'>,</span> <span class='hs-varid'>exprsFreeVars</span><span class='hs-layout'>,</span> <span class='hs-varid'>bindFreeVars</span><span class='hs-layout'>,</span> <span class='hs-varid'>rulesFreeVars</span> <span class='hs-layout'>)</span>
<a name="line-29"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreUtils</span> <span class='hs-layout'>(</span> <span class='hs-varid'>exprType</span> <span class='hs-layout'>)</span>
<a name="line-30"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>PprCore</span> <span class='hs-layout'>(</span> <span class='hs-varid'>pprRules</span> <span class='hs-layout'>)</span>
<a name="line-31"></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> <span class='hs-conid'>TvSubstEnv</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcEqTypeX</span> <span class='hs-layout'>)</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcType</span> <span class='hs-layout'>(</span> <span class='hs-varid'>tcSplitTyConApp_maybe</span> <span class='hs-layout'>)</span>
<a name="line-33"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreTidy</span> <span class='hs-layout'>(</span> <span class='hs-varid'>tidyRules</span> <span class='hs-layout'>)</span>
<a name="line-34"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Id</span>
<a name="line-35"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>IdInfo</span> <span class='hs-layout'>(</span> <span class='hs-conid'>SpecInfo</span><span class='hs-layout'>(</span> <span class='hs-conid'>SpecInfo</span> <span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-36"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Var</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Var</span> <span class='hs-layout'>)</span>
<a name="line-37"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarEnv</span>
<a name="line-38"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarSet</span>
<a name="line-39"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Name</span><span class='hs-layout'>,</span> <span class='hs-conid'>NamedThing</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-40"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>NameEnv</span>
<a name="line-41"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Unify</span> <span class='hs-layout'>(</span> <span class='hs-varid'>ruleMatchTyX</span><span class='hs-layout'>,</span> <span class='hs-conid'>MatchEnv</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-42"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>BasicTypes</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Activation</span> <span class='hs-layout'>)</span>
<a name="line-43"></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>
<a name="line-44"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-45"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastString</span>
<a name="line-46"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Maybes</span>
<a name="line-47"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>OrdList</span>
<a name="line-48"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Bag</span>
<a name="line-49"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Util</span>
<a name="line-50"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[specialisation-IdInfo]{Specialisation info about an @Id@}
%* *
%************************************************************************
A @CoreRule@ holds details of one rule for an @Id@, which
includes its specialisations.
For example, if a rule for @f@ contains the mapping:
\begin{verbatim}
forall a b d. [Type (List a), Type b, Var d] ===> f' a b
\end{verbatim}
then when we find an application of f to matching types, we simply replace
it by the matching RHS:
\begin{verbatim}
f (List Int) Bool dict ===> f' Int Bool
\end{verbatim}
All the stuff about how many dictionaries to discard, and what types
to apply the specialised function to, are handled by the fact that the
Rule contains a template for the result of the specialisation.
There is one more exciting case, which is dealt with in exactly the same
way. If the specialised value is unboxed then it is lifted at its
definition site and unlifted at its uses. For example:
pi :: forall a. Num a => a
might have a specialisation
[Int#] ===> (case pi' of Lift pi# -> pi#)
where pi' :: Lift Int# is the specialised version of pi.
\begin{code}
<pre><a name="line-1"></a><a name="mkLocalRule"></a><span class='hs-definition'>mkLocalRule</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleName</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Activation</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBndr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreRule</span>
<a name="line-3"></a><span class='hs-comment'>-- ^ Used to make 'CoreRule' for an 'Id' defined in the module being </span>
<a name="line-4"></a><span class='hs-comment'>-- compiled. See also 'CoreSyn.CoreRule'</span>
<a name="line-5"></a><span class='hs-definition'>mkLocalRule</span> <span class='hs-varid'>name</span> <span class='hs-varid'>act</span> <span class='hs-varid'>fn</span> <span class='hs-varid'>bndrs</span> <span class='hs-varid'>args</span> <span class='hs-varid'>rhs</span>
<a name="line-6"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Rule</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ru_name</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>name</span><span class='hs-layout'>,</span> <span class='hs-varid'>ru_fn</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fn</span><span class='hs-layout'>,</span> <span class='hs-varid'>ru_act</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>act</span><span class='hs-layout'>,</span>
<a name="line-7"></a> <span class='hs-varid'>ru_bndrs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bndrs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ru_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>args</span><span class='hs-layout'>,</span>
<a name="line-8"></a> <span class='hs-varid'>ru_rhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ru_rough</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>roughTopNames</span> <span class='hs-varid'>args</span><span class='hs-layout'>,</span>
<a name="line-9"></a> <span class='hs-varid'>ru_local</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span> <span class='hs-layout'>}</span>
<a name="line-10"></a>
<a name="line-11"></a><a name="roughTopNames"></a><span class='hs-comment'>--------------</span>
<a name="line-12"></a><span class='hs-definition'>roughTopNames</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span>
<a name="line-13"></a><span class='hs-comment'>-- ^ Find the \"top\" free names of several expressions. </span>
<a name="line-14"></a><span class='hs-comment'>-- Such names are either:</span>
<a name="line-15"></a><span class='hs-comment'>--</span>
<a name="line-16"></a><span class='hs-comment'>-- 1. The function finally being applied to in an application chain</span>
<a name="line-17"></a><span class='hs-comment'>-- (if that name is a GlobalId: see "Var#globalvslocal"), or</span>
<a name="line-18"></a><span class='hs-comment'>--</span>
<a name="line-19"></a><span class='hs-comment'>-- 2. The 'TyCon' if the expression is a 'Type'</span>
<a name="line-20"></a><span class='hs-comment'>--</span>
<a name="line-21"></a><span class='hs-comment'>-- This is used for the fast-match-check for rules; </span>
<a name="line-22"></a><span class='hs-comment'>-- if the top names don't match, the rest can't</span>
<a name="line-23"></a><span class='hs-definition'>roughTopNames</span> <span class='hs-varid'>args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>roughTopName</span> <span class='hs-varid'>args</span>
<a name="line-24"></a>
<a name="line-25"></a><a name="roughTopName"></a><span class='hs-definition'>roughTopName</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Name</span>
<a name="line-26"></a><span class='hs-definition'>roughTopName</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>ty</span> <span class='hs-keyword'>of</span>
<a name="line-27"></a> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tc</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>getName</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
<a name="line-28"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Nothing</span>
<a name="line-29"></a><span class='hs-definition'>roughTopName</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>f</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>roughTopName</span> <span class='hs-varid'>f</span>
<a name="line-30"></a><span class='hs-definition'>roughTopName</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isGlobalId</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>idName</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span>
<a name="line-31"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-32"></a><span class='hs-definition'>roughTopName</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-33"></a>
<a name="line-34"></a><a name="ruleCantMatch"></a><span class='hs-definition'>ruleCantMatch</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-35"></a><span class='hs-comment'>-- ^ @ruleCantMatch tpl actual@ returns True only if @actual@</span>
<a name="line-36"></a><span class='hs-comment'>-- definitely can't match @tpl@ by instantiating @tpl@. </span>
<a name="line-37"></a><span class='hs-comment'>-- It's only a one-way match; unlike instance matching we </span>
<a name="line-38"></a><span class='hs-comment'>-- don't consider unification.</span>
<a name="line-39"></a><span class='hs-comment'>-- </span>
<a name="line-40"></a><span class='hs-comment'>-- Notice that [_$_]</span>
<a name="line-41"></a><span class='hs-comment'>-- @ruleCantMatch [Nothing] [Just n2] = False@</span>
<a name="line-42"></a><span class='hs-comment'>-- Reason: a template variable can be instantiated by a constant</span>
<a name="line-43"></a><span class='hs-comment'>-- Also:</span>
<a name="line-44"></a><span class='hs-comment'>-- @ruleCantMatch [Just n1] [Nothing] = False@</span>
<a name="line-45"></a><span class='hs-comment'>-- Reason: a local variable @v@ in the actuals might [_$_]</span>
<a name="line-46"></a>
<a name="line-47"></a><span class='hs-definition'>ruleCantMatch</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>n1</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ts</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>n2</span> <span class='hs-conop'>:</span> <span class='hs-keyword'>as</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>n1</span> <span class='hs-varop'>/=</span> <span class='hs-varid'>n2</span> <span class='hs-varop'>||</span> <span class='hs-varid'>ruleCantMatch</span> <span class='hs-varid'>ts</span> <span class='hs-keyword'>as</span>
<a name="line-48"></a><span class='hs-definition'>ruleCantMatch</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ts</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span> <span class='hs-conop'>:</span> <span class='hs-keyword'>as</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ruleCantMatch</span> <span class='hs-varid'>ts</span> <span class='hs-keyword'>as</span>
<a name="line-49"></a><span class='hs-definition'>ruleCantMatch</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="pprRulesForUser"></a><span class='hs-definition'>pprRulesForUser</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreRule</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-2"></a><span class='hs-comment'>-- (a) tidy the rules</span>
<a name="line-3"></a><span class='hs-comment'>-- (b) sort them into order based on the rule name</span>
<a name="line-4"></a><span class='hs-comment'>-- (c) suppress uniques (unless -dppr-debug is on)</span>
<a name="line-5"></a><span class='hs-comment'>-- This combination makes the output stable so we can use in testing</span>
<a name="line-6"></a><span class='hs-comment'>-- It's here rather than in PprCore because it calls tidyRules</span>
<a name="line-7"></a><span class='hs-definition'>pprRulesForUser</span> <span class='hs-varid'>rules</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withPprStyle</span> <span class='hs-varid'>defaultUserStyle</span> <span class='hs-varop'>$</span>
<a name="line-9"></a> <span class='hs-varid'>pprRules</span> <span class='hs-varop'>$</span>
<a name="line-10"></a> <span class='hs-varid'>sortLe</span> <span class='hs-varid'>le_rule</span> <span class='hs-varop'>$</span>
<a name="line-11"></a> <span class='hs-varid'>tidyRules</span> <span class='hs-varid'>emptyTidyEnv</span> <span class='hs-varid'>rules</span>
<a name="line-12"></a> <span class='hs-keyword'>where</span>
<a name="line-13"></a> <span class='hs-varid'>le_rule</span> <span class='hs-varid'>r1</span> <span class='hs-varid'>r2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ru_name</span> <span class='hs-varid'>r1</span> <span class='hs-varop'><=</span> <span class='hs-varid'>ru_name</span> <span class='hs-varid'>r2</span>
</pre>\end{code}
%************************************************************************
%* *
SpecInfo: the rules in an IdInfo
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="mkSpecInfo"></a><span class='hs-comment'>-- | Make a 'SpecInfo' containing a number of 'CoreRule's, suitable</span>
<a name="line-2"></a><span class='hs-comment'>-- for putting into an 'IdInfo'</span>
<a name="line-3"></a><span class='hs-definition'>mkSpecInfo</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreRule</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SpecInfo</span>
<a name="line-4"></a><span class='hs-definition'>mkSpecInfo</span> <span class='hs-varid'>rules</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SpecInfo</span> <span class='hs-varid'>rules</span> <span class='hs-layout'>(</span><span class='hs-varid'>rulesFreeVars</span> <span class='hs-varid'>rules</span><span class='hs-layout'>)</span>
<a name="line-5"></a>
<a name="line-6"></a><a name="extendSpecInfo"></a><span class='hs-definition'>extendSpecInfo</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SpecInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreRule</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SpecInfo</span>
<a name="line-7"></a><span class='hs-definition'>extendSpecInfo</span> <span class='hs-layout'>(</span><span class='hs-conid'>SpecInfo</span> <span class='hs-varid'>rs1</span> <span class='hs-varid'>fvs1</span><span class='hs-layout'>)</span> <span class='hs-varid'>rs2</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SpecInfo</span> <span class='hs-layout'>(</span><span class='hs-varid'>rs2</span> <span class='hs-varop'>++</span> <span class='hs-varid'>rs1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>rulesFreeVars</span> <span class='hs-varid'>rs2</span> <span class='hs-varop'>`unionVarSet`</span> <span class='hs-varid'>fvs1</span><span class='hs-layout'>)</span>
<a name="line-9"></a>
<a name="line-10"></a><a name="addSpecInfo"></a><span class='hs-definition'>addSpecInfo</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SpecInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SpecInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SpecInfo</span>
<a name="line-11"></a><span class='hs-definition'>addSpecInfo</span> <span class='hs-layout'>(</span><span class='hs-conid'>SpecInfo</span> <span class='hs-varid'>rs1</span> <span class='hs-varid'>fvs1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>SpecInfo</span> <span class='hs-varid'>rs2</span> <span class='hs-varid'>fvs2</span><span class='hs-layout'>)</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SpecInfo</span> <span class='hs-layout'>(</span><span class='hs-varid'>rs1</span> <span class='hs-varop'>++</span> <span class='hs-varid'>rs2</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>fvs1</span> <span class='hs-varop'>`unionVarSet`</span> <span class='hs-varid'>fvs2</span><span class='hs-layout'>)</span>
<a name="line-13"></a>
<a name="line-14"></a><a name="addIdSpecialisations"></a><span class='hs-definition'>addIdSpecialisations</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreRule</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span>
<a name="line-15"></a><span class='hs-definition'>addIdSpecialisations</span> <span class='hs-varid'>id</span> <span class='hs-conid'>[]</span>
<a name="line-16"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>id</span>
<a name="line-17"></a><span class='hs-definition'>addIdSpecialisations</span> <span class='hs-varid'>id</span> <span class='hs-varid'>rules</span>
<a name="line-18"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>setIdSpecialisation</span> <span class='hs-varid'>id</span> <span class='hs-varop'>$</span>
<a name="line-19"></a> <span class='hs-varid'>extendSpecInfo</span> <span class='hs-layout'>(</span><span class='hs-varid'>idSpecialisation</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span> <span class='hs-varid'>rules</span>
<a name="line-20"></a>
<a name="line-21"></a><a name="rulesOfBinds"></a><span class='hs-comment'>-- | Gather all the rules for locally bound identifiers from the supplied bindings</span>
<a name="line-22"></a><span class='hs-definition'>rulesOfBinds</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBind</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreRule</span><span class='hs-keyglyph'>]</span>
<a name="line-23"></a><span class='hs-definition'>rulesOfBinds</span> <span class='hs-varid'>binds</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>concatMap</span> <span class='hs-layout'>(</span><span class='hs-varid'>concatMap</span> <span class='hs-varid'>idCoreRules</span> <span class='hs-varop'>.</span> <span class='hs-varid'>bindersOf</span><span class='hs-layout'>)</span> <span class='hs-varid'>binds</span>
<a name="line-24"></a>
<a name="line-25"></a><a name="getRules"></a><span class='hs-definition'>getRules</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleBase</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreRule</span><span class='hs-keyglyph'>]</span>
<a name="line-26"></a> <span class='hs-comment'>-- The rules for an Id come from two places:</span>
<a name="line-27"></a> <span class='hs-comment'>-- (a) the ones it is born with (idCoreRules fn)</span>
<a name="line-28"></a> <span class='hs-comment'>-- (b) rules added in subsequent modules (extra_rules)</span>
<a name="line-29"></a> <span class='hs-comment'>-- PrimOps, for example, are born with a bunch of rules under (a)</span>
<a name="line-30"></a><span class='hs-definition'>getRules</span> <span class='hs-varid'>rule_base</span> <span class='hs-varid'>fn</span>
<a name="line-31"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isLocalId</span> <span class='hs-varid'>fn</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>idCoreRules</span> <span class='hs-varid'>fn</span>
<a name="line-32"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>WARN</span><span class='hs-layout'>(</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isPrimOpId</span> <span class='hs-varid'>fn</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>notNull</span> <span class='hs-layout'>(</span><span class='hs-varid'>idCoreRules</span> <span class='hs-varid'>fn</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-33"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>fn</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>idCoreRules</span> <span class='hs-varid'>fn</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-34"></a> <span class='hs-varid'>idCoreRules</span> <span class='hs-varid'>fn</span> <span class='hs-varop'>++</span> <span class='hs-layout'>(</span><span class='hs-varid'>lookupNameEnv</span> <span class='hs-varid'>rule_base</span> <span class='hs-layout'>(</span><span class='hs-varid'>idName</span> <span class='hs-varid'>fn</span><span class='hs-layout'>)</span> <span class='hs-varop'>`orElse`</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-35"></a> <span class='hs-comment'>-- Only PrimOpIds have rules inside themselves, and perhaps more besides</span>
</pre>\end{code}
%************************************************************************
%* *
RuleBase
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="RuleBase"></a><span class='hs-comment'>-- | Gathers a collection of 'CoreRule's. Maps (the name of) an 'Id' to its rules</span>
<a name="line-2"></a><a name="RuleBase"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>RuleBase</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>NameEnv</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreRule</span><span class='hs-keyglyph'>]</span>
<a name="line-3"></a> <span class='hs-comment'>-- The rules are are unordered; </span>
<a name="line-4"></a> <span class='hs-comment'>-- we sort out any overlaps on lookup</span>
<a name="line-5"></a>
<a name="line-6"></a><a name="emptyRuleBase"></a><span class='hs-definition'>emptyRuleBase</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleBase</span>
<a name="line-7"></a><span class='hs-definition'>emptyRuleBase</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyNameEnv</span>
<a name="line-8"></a>
<a name="line-9"></a><a name="mkRuleBase"></a><span class='hs-definition'>mkRuleBase</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreRule</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RuleBase</span>
<a name="line-10"></a><span class='hs-definition'>mkRuleBase</span> <span class='hs-varid'>rules</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendRuleBaseList</span> <span class='hs-varid'>emptyRuleBase</span> <span class='hs-varid'>rules</span>
<a name="line-11"></a>
<a name="line-12"></a><a name="extendRuleBaseList"></a><span class='hs-definition'>extendRuleBaseList</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleBase</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreRule</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RuleBase</span>
<a name="line-13"></a><span class='hs-definition'>extendRuleBaseList</span> <span class='hs-varid'>rule_base</span> <span class='hs-varid'>new_guys</span>
<a name="line-14"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldl</span> <span class='hs-varid'>extendRuleBase</span> <span class='hs-varid'>rule_base</span> <span class='hs-varid'>new_guys</span>
<a name="line-15"></a>
<a name="line-16"></a><a name="unionRuleBase"></a><span class='hs-definition'>unionRuleBase</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleBase</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RuleBase</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RuleBase</span>
<a name="line-17"></a><span class='hs-definition'>unionRuleBase</span> <span class='hs-varid'>rb1</span> <span class='hs-varid'>rb2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>plusNameEnv_C</span> <span class='hs-layout'>(</span><span class='hs-varop'>++</span><span class='hs-layout'>)</span> <span class='hs-varid'>rb1</span> <span class='hs-varid'>rb2</span>
<a name="line-18"></a>
<a name="line-19"></a><a name="extendRuleBase"></a><span class='hs-definition'>extendRuleBase</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleBase</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreRule</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RuleBase</span>
<a name="line-20"></a><span class='hs-definition'>extendRuleBase</span> <span class='hs-varid'>rule_base</span> <span class='hs-varid'>rule</span>
<a name="line-21"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendNameEnv_Acc</span> <span class='hs-layout'>(</span><span class='hs-conop'>:</span><span class='hs-layout'>)</span> <span class='hs-varid'>singleton</span> <span class='hs-varid'>rule_base</span> <span class='hs-layout'>(</span><span class='hs-varid'>ruleIdName</span> <span class='hs-varid'>rule</span><span class='hs-layout'>)</span> <span class='hs-varid'>rule</span>
<a name="line-22"></a>
<a name="line-23"></a><a name="pprRuleBase"></a><span class='hs-definition'>pprRuleBase</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleBase</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-24"></a><span class='hs-definition'>pprRuleBase</span> <span class='hs-varid'>rules</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>pprRules</span> <span class='hs-layout'>(</span><span class='hs-varid'>tidyRules</span> <span class='hs-varid'>emptyTidyEnv</span> <span class='hs-varid'>rs</span><span class='hs-layout'>)</span>
<a name="line-25"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>rs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>nameEnvElts</span> <span class='hs-varid'>rules</span> <span class='hs-keyglyph'>]</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Matching}
%* *
%************************************************************************
Note [Extra args in rule matching]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we find a matching rule, we return (Just (rule, rhs)),
but the rule firing has only consumed as many of the input args
as the ruleArity says. It's up to the caller to keep track
of any left-over args. E.g. if you call
lookupRule ... f [e1, e2, e3]
and it returns Just (r, rhs), where r has ruleArity 2
then the real rewrite is
f e1 e2 e3 ==> rhs e3
You might think it'd be cleaner for lookupRule to deal with the
leftover arguments, by applying 'rhs' to them, but the main call
in the Simplifier works better as it is. Reason: the 'args' passed
to lookupRule are the result of a lazy substitution
\begin{code}
<pre><a name="line-1"></a><a name="lookupRule"></a><span class='hs-comment'>-- | The main rule matching function. Attempts to apply all (active)</span>
<a name="line-2"></a><span class='hs-comment'>-- supplied rules to this instance of an application in a given</span>
<a name="line-3"></a><span class='hs-comment'>-- context, returning the rule applied and the resulting expression if</span>
<a name="line-4"></a><span class='hs-comment'>-- successful.</span>
<a name="line-5"></a><span class='hs-definition'>lookupRule</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Activation</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>InScopeSet</span>
<a name="line-6"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span>
<a name="line-7"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreRule</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreRule</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span>
<a name="line-8"></a>
<a name="line-9"></a><span class='hs-comment'>-- See Note [Extra args in rule matching]</span>
<a name="line-10"></a><span class='hs-comment'>-- See comments on matchRule</span>
<a name="line-11"></a><span class='hs-definition'>lookupRule</span> <span class='hs-varid'>is_active</span> <span class='hs-varid'>in_scope</span> <span class='hs-varid'>fn</span> <span class='hs-varid'>args</span> <span class='hs-varid'>rules</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>-- pprTrace "matchRules" (ppr fn <+> ppr rules) $</span>
<a name="line-13"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>go</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>rules</span> <span class='hs-keyword'>of</span>
<a name="line-14"></a> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Nothing</span>
<a name="line-15"></a> <span class='hs-layout'>(</span><span class='hs-varid'>m</span><span class='hs-conop'>:</span><span class='hs-varid'>ms</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>findBest</span> <span class='hs-layout'>(</span><span class='hs-varid'>fn</span><span class='hs-layout'>,</span><span class='hs-varid'>args</span><span class='hs-layout'>)</span> <span class='hs-varid'>m</span> <span class='hs-varid'>ms</span><span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-keyword'>where</span>
<a name="line-17"></a> <span class='hs-varid'>rough_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>roughTopName</span> <span class='hs-varid'>args</span>
<a name="line-18"></a>
<a name="line-19"></a> <span class='hs-varid'>go</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>CoreRule</span><span class='hs-layout'>,</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreRule</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>CoreRule</span><span class='hs-layout'>,</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-20"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>ms</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ms</span>
<a name="line-21"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>ms</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-conop'>:</span><span class='hs-varid'>rs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>matchRule</span> <span class='hs-varid'>is_active</span> <span class='hs-varid'>in_scope</span> <span class='hs-varid'>args</span> <span class='hs-varid'>rough_args</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-22"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-layout'>,</span><span class='hs-varid'>e</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>ms</span><span class='hs-layout'>)</span> <span class='hs-varid'>rs</span>
<a name="line-23"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-comment'>-- pprTrace "match failed" (ppr r $$ ppr args $$ </span>
<a name="line-24"></a> <span class='hs-comment'>-- ppr [(arg_id, unfoldingTemplate unf) | Var arg_id <- args, let unf = idUnfolding arg_id, isCheapUnfolding unf] )</span>
<a name="line-25"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>ms</span> <span class='hs-varid'>rs</span>
<a name="line-26"></a>
<a name="line-27"></a><a name="findBest"></a><span class='hs-definition'>findBest</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-28"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreRule</span><span class='hs-layout'>,</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>CoreRule</span><span class='hs-layout'>,</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreRule</span><span class='hs-layout'>,</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span>
<a name="line-29"></a><span class='hs-comment'>-- All these pairs matched the expression</span>
<a name="line-30"></a><span class='hs-comment'>-- Return the pair the the most specific rule</span>
<a name="line-31"></a><span class='hs-comment'>-- The (fn,args) is just for overlap reporting</span>
<a name="line-32"></a>
<a name="line-33"></a><span class='hs-definition'>findBest</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-varid'>rule</span><span class='hs-layout'>,</span><span class='hs-varid'>ans</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>rule</span><span class='hs-layout'>,</span><span class='hs-varid'>ans</span><span class='hs-layout'>)</span>
<a name="line-34"></a><span class='hs-definition'>findBest</span> <span class='hs-varid'>target</span> <span class='hs-layout'>(</span><span class='hs-varid'>rule1</span><span class='hs-layout'>,</span><span class='hs-varid'>ans1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>rule2</span><span class='hs-layout'>,</span><span class='hs-varid'>ans2</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>prs</span><span class='hs-layout'>)</span>
<a name="line-35"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>rule1</span> <span class='hs-varop'>`isMoreSpecific`</span> <span class='hs-varid'>rule2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findBest</span> <span class='hs-varid'>target</span> <span class='hs-layout'>(</span><span class='hs-varid'>rule1</span><span class='hs-layout'>,</span><span class='hs-varid'>ans1</span><span class='hs-layout'>)</span> <span class='hs-varid'>prs</span>
<a name="line-36"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>rule2</span> <span class='hs-varop'>`isMoreSpecific`</span> <span class='hs-varid'>rule1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findBest</span> <span class='hs-varid'>target</span> <span class='hs-layout'>(</span><span class='hs-varid'>rule2</span><span class='hs-layout'>,</span><span class='hs-varid'>ans2</span><span class='hs-layout'>)</span> <span class='hs-varid'>prs</span>
<a name="line-37"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>debugIsOn</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>pp_rule</span> <span class='hs-varid'>rule</span>
<a name="line-38"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>opt_PprStyle_Debug</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>rule</span>
<a name="line-39"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>doubleQuotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ftext</span> <span class='hs-layout'>(</span><span class='hs-varid'>ru_name</span> <span class='hs-varid'>rule</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-40"></a> <span class='hs-keyword'>in</span> <span class='hs-varid'>pprTrace</span> <span class='hs-str'>"Rules.findBest: rule overlap (Rule 1 wins)"</span>
<a name="line-41"></a> <span class='hs-layout'>(</span><span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-keyword'>if</span> <span class='hs-varid'>opt_PprStyle_Debug</span> <span class='hs-keyword'>then</span>
<a name="line-42"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Expression to match:"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>fn</span> <span class='hs-varop'><+></span> <span class='hs-varid'>sep</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span>
<a name="line-43"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>empty</span><span class='hs-layout'>,</span>
<a name="line-44"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Rule 1:"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>pp_rule</span> <span class='hs-varid'>rule1</span><span class='hs-layout'>,</span>
<a name="line-45"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Rule 2:"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>pp_rule</span> <span class='hs-varid'>rule2</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-46"></a> <span class='hs-varid'>findBest</span> <span class='hs-varid'>target</span> <span class='hs-layout'>(</span><span class='hs-varid'>rule1</span><span class='hs-layout'>,</span><span class='hs-varid'>ans1</span><span class='hs-layout'>)</span> <span class='hs-varid'>prs</span>
<a name="line-47"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findBest</span> <span class='hs-varid'>target</span> <span class='hs-layout'>(</span><span class='hs-varid'>rule1</span><span class='hs-layout'>,</span><span class='hs-varid'>ans1</span><span class='hs-layout'>)</span> <span class='hs-varid'>prs</span>
<a name="line-48"></a> <span class='hs-keyword'>where</span>
<a name="line-49"></a> <span class='hs-layout'>(</span><span class='hs-varid'>fn</span><span class='hs-layout'>,</span><span class='hs-varid'>args</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>target</span>
<a name="line-50"></a>
<a name="line-51"></a><a name="isMoreSpecific"></a><span class='hs-definition'>isMoreSpecific</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreRule</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreRule</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-52"></a><span class='hs-definition'>isMoreSpecific</span> <span class='hs-layout'>(</span><span class='hs-conid'>BuiltinRule</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-53"></a><span class='hs-definition'>isMoreSpecific</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>BuiltinRule</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-54"></a><span class='hs-definition'>isMoreSpecific</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rule</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ru_bndrs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bndrs1</span><span class='hs-layout'>,</span> <span class='hs-varid'>ru_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>args1</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-55"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Rule</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ru_bndrs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bndrs2</span><span class='hs-layout'>,</span> <span class='hs-varid'>ru_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>args2</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-56"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isJust</span> <span class='hs-layout'>(</span><span class='hs-varid'>matchN</span> <span class='hs-varid'>in_scope</span> <span class='hs-varid'>bndrs2</span> <span class='hs-varid'>args2</span> <span class='hs-varid'>args1</span><span class='hs-layout'>)</span>
<a name="line-57"></a> <span class='hs-keyword'>where</span>
<a name="line-58"></a> <span class='hs-varid'>in_scope</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkInScopeSet</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkVarSet</span> <span class='hs-varid'>bndrs1</span><span class='hs-layout'>)</span>
<a name="line-59"></a> <span class='hs-comment'>-- Actually we should probably include the free vars </span>
<a name="line-60"></a> <span class='hs-comment'>-- of rule1's args, but I can't be bothered</span>
<a name="line-61"></a>
<a name="line-62"></a><a name="noBlackList"></a><span class='hs-definition'>noBlackList</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Activation</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-63"></a><span class='hs-definition'>noBlackList</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> <span class='hs-comment'>-- Nothing is black listed</span>
<a name="line-64"></a>
<a name="line-65"></a><a name="matchRule"></a><span class='hs-definition'>matchRule</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Activation</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>InScopeSet</span>
<a name="line-66"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span>
<a name="line-67"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreRule</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-68"></a>
<a name="line-69"></a><span class='hs-comment'>-- If (matchRule rule args) returns Just (name,rhs)</span>
<a name="line-70"></a><span class='hs-comment'>-- then (f args) matches the rule, and the corresponding</span>
<a name="line-71"></a><span class='hs-comment'>-- rewritten RHS is rhs</span>
<a name="line-72"></a><span class='hs-comment'>--</span>
<a name="line-73"></a><span class='hs-comment'>-- The bndrs and rhs is occurrence-analysed</span>
<a name="line-74"></a><span class='hs-comment'>--</span>
<a name="line-75"></a><span class='hs-comment'>-- Example</span>
<a name="line-76"></a><span class='hs-comment'>--</span>
<a name="line-77"></a><span class='hs-comment'>-- The rule</span>
<a name="line-78"></a><span class='hs-comment'>-- forall f g x. map f (map g x) ==> map (f . g) x</span>
<a name="line-79"></a><span class='hs-comment'>-- is stored</span>
<a name="line-80"></a><span class='hs-comment'>-- CoreRule "map/map" </span>
<a name="line-81"></a><span class='hs-comment'>-- [f,g,x] -- tpl_vars</span>
<a name="line-82"></a><span class='hs-comment'>-- [f,map g x] -- tpl_args</span>
<a name="line-83"></a><span class='hs-comment'>-- map (f.g) x) -- rhs</span>
<a name="line-84"></a><span class='hs-comment'>-- </span>
<a name="line-85"></a><span class='hs-comment'>-- Then the call: matchRule the_rule [e1,map e2 e3]</span>
<a name="line-86"></a><span class='hs-comment'>-- = Just ("map/map", (\f,g,x -> rhs) e1 e2 e3)</span>
<a name="line-87"></a><span class='hs-comment'>--</span>
<a name="line-88"></a><span class='hs-comment'>-- Any 'surplus' arguments in the input are simply put on the end</span>
<a name="line-89"></a><span class='hs-comment'>-- of the output.</span>
<a name="line-90"></a>
<a name="line-91"></a><span class='hs-definition'>matchRule</span> <span class='hs-sel'>_is_active</span> <span class='hs-sel'>_in_scope</span> <span class='hs-varid'>args</span> <span class='hs-sel'>_rough_args</span>
<a name="line-92"></a> <span class='hs-layout'>(</span><span class='hs-conid'>BuiltinRule</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ru_try</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match_fn</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-93"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>match_fn</span> <span class='hs-varid'>args</span> <span class='hs-keyword'>of</span>
<a name="line-94"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>expr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Just</span> <span class='hs-varid'>expr</span>
<a name="line-95"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Nothing</span>
<a name="line-96"></a>
<a name="line-97"></a><span class='hs-definition'>matchRule</span> <span class='hs-varid'>is_active</span> <span class='hs-varid'>in_scope</span> <span class='hs-varid'>args</span> <span class='hs-varid'>rough_args</span>
<a name="line-98"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Rule</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ru_act</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>act</span><span class='hs-layout'>,</span> <span class='hs-varid'>ru_rough</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tpl_tops</span><span class='hs-layout'>,</span>
<a name="line-99"></a> <span class='hs-varid'>ru_bndrs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tpl_vars</span><span class='hs-layout'>,</span> <span class='hs-varid'>ru_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tpl_args</span><span class='hs-layout'>,</span>
<a name="line-100"></a> <span class='hs-varid'>ru_rhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rhs</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-101"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>is_active</span> <span class='hs-varid'>act</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-102"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>ruleCantMatch</span> <span class='hs-varid'>tpl_tops</span> <span class='hs-varid'>rough_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-103"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-104"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>matchN</span> <span class='hs-varid'>in_scope</span> <span class='hs-varid'>tpl_vars</span> <span class='hs-varid'>tpl_args</span> <span class='hs-varid'>args</span> <span class='hs-keyword'>of</span>
<a name="line-105"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Nothing</span>
<a name="line-106"></a> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>binds</span><span class='hs-layout'>,</span> <span class='hs-varid'>tpl_vals</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkLets</span> <span class='hs-varid'>binds</span> <span class='hs-varop'>$</span>
<a name="line-107"></a> <span class='hs-varid'>rule_fn</span> <span class='hs-varop'>`mkApps`</span> <span class='hs-varid'>tpl_vals</span><span class='hs-layout'>)</span>
<a name="line-108"></a> <span class='hs-keyword'>where</span>
<a name="line-109"></a> <span class='hs-varid'>rule_fn</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occurAnalyseExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkLams</span> <span class='hs-varid'>tpl_vars</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span>
<a name="line-110"></a> <span class='hs-comment'>-- We could do this when putting things into the rulebase, I guess</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="matchN"></a><span class='hs-comment'>-- For a given match template and context, find bindings to wrap around </span>
<a name="line-2"></a><span class='hs-comment'>-- the entire result and what should be substituted for each template variable.</span>
<a name="line-3"></a><span class='hs-comment'>-- Fail if there are two few actual arguments from the target to match the template</span>
<a name="line-4"></a><span class='hs-definition'>matchN</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>InScopeSet</span> <span class='hs-comment'>-- ^ In-scope variables</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Var</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- ^ Match template type variables</span>
<a name="line-6"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- ^ Match template</span>
<a name="line-7"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- ^ Target; can have more elements than the template</span>
<a name="line-8"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBind</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span>
<a name="line-9"></a> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-10"></a>
<a name="line-11"></a><span class='hs-definition'>matchN</span> <span class='hs-varid'>in_scope</span> <span class='hs-varid'>tmpl_vars</span> <span class='hs-varid'>tmpl_es</span> <span class='hs-varid'>target_es</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>tv_subst</span><span class='hs-layout'>,</span> <span class='hs-varid'>id_subst</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span>
<a name="line-13"></a> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>go</span> <span class='hs-varid'>init_menv</span> <span class='hs-varid'>emptySubstEnv</span> <span class='hs-varid'>tmpl_es</span> <span class='hs-varid'>target_es</span>
<a name="line-14"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromOL</span> <span class='hs-varid'>binds</span><span class='hs-layout'>,</span>
<a name="line-15"></a> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>lookup_tmpl</span> <span class='hs-varid'>tv_subst</span> <span class='hs-varid'>id_subst</span><span class='hs-layout'>)</span> <span class='hs-varid'>tmpl_vars'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-16"></a> <span class='hs-keyword'>where</span>
<a name="line-17"></a> <span class='hs-layout'>(</span><span class='hs-varid'>init_rn_env</span><span class='hs-layout'>,</span> <span class='hs-varid'>tmpl_vars'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapAccumL</span> <span class='hs-varid'>rnBndrL</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkRnEnv2</span> <span class='hs-varid'>in_scope</span><span class='hs-layout'>)</span> <span class='hs-varid'>tmpl_vars</span>
<a name="line-18"></a> <span class='hs-comment'>-- See Note [Template binders]</span>
<a name="line-19"></a>
<a name="line-20"></a> <span class='hs-varid'>init_menv</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ME</span> <span class='hs-layout'>{</span> <span class='hs-varid'>me_tmpls</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVarSet</span> <span class='hs-varid'>tmpl_vars'</span><span class='hs-layout'>,</span> <span class='hs-varid'>me_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>init_rn_env</span> <span class='hs-layout'>}</span>
<a name="line-21"></a>
<a name="line-22"></a> <span class='hs-varid'>go</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>subst</span> <span class='hs-conid'>[]</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>subst</span>
<a name="line-23"></a> <span class='hs-varid'>go</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span> <span class='hs-comment'>-- Fail if too few actual args</span>
<a name="line-24"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-layout'>(</span><span class='hs-varid'>t</span><span class='hs-conop'>:</span><span class='hs-varid'>ts</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>e</span><span class='hs-conop'>:</span><span class='hs-varid'>es</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>subst1</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>t</span> <span class='hs-varid'>e</span>
<a name="line-25"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>go</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst1</span> <span class='hs-varid'>ts</span> <span class='hs-varid'>es</span> <span class='hs-layout'>}</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-varid'>lookup_tmpl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TvSubstEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IdSubstEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Var</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-28"></a> <span class='hs-varid'>lookup_tmpl</span> <span class='hs-varid'>tv_subst</span> <span class='hs-varid'>id_subst</span> <span class='hs-varid'>tmpl_var'</span>
<a name="line-29"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isTyVar</span> <span class='hs-varid'>tmpl_var'</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupVarEnv</span> <span class='hs-varid'>tv_subst</span> <span class='hs-varid'>tmpl_var'</span> <span class='hs-keyword'>of</span>
<a name="line-30"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-varid'>ty</span>
<a name="line-31"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unbound</span> <span class='hs-varid'>tmpl_var'</span>
<a name="line-32"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupVarEnv</span> <span class='hs-varid'>id_subst</span> <span class='hs-varid'>tmpl_var'</span> <span class='hs-keyword'>of</span>
<a name="line-33"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>e</span>
<a name="line-34"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unbound</span> <span class='hs-varid'>tmpl_var'</span>
<a name="line-35"></a>
<a name="line-36"></a> <span class='hs-varid'>unbound</span> <span class='hs-varid'>var</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"Template variable unbound in rewrite rule"</span>
<a name="line-37"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>var</span> <span class='hs-varop'>$$</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tmpl_vars</span> <span class='hs-varop'>$$</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tmpl_vars'</span> <span class='hs-varop'>$$</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tmpl_es</span> <span class='hs-varop'>$$</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>target_es</span><span class='hs-layout'>)</span>
</pre>\end{code}
Note [Template binders]
~~~~~~~~~~~~~~~~~~~~~~~
Consider the following match:
Template: forall x. f x
Target: f (x+1)
This should succeed, because the template variable 'x' has
nothing to do with the 'x' in the target.
On reflection, this case probably does just work, but this might not
Template: forall x. f (\x.x)
Target: f (\y.y)
Here we want to clone when we find the \x, but to know that x must be in scope
To achive this, we use rnBndrL to rename the template variables if
necessary; the renamed ones are the tmpl_vars'
---------------------------------------------
The inner workings of matching
---------------------------------------------
\begin{code}
<pre><a name="line-1"></a><a name="SubstEnv"></a><span class='hs-comment'>-- These two definitions are not the same as in Subst,</span>
<a name="line-2"></a><a name="SubstEnv"></a><span class='hs-comment'>-- but they simple and direct, and purely local to this module</span>
<a name="line-3"></a><a name="SubstEnv"></a><span class='hs-comment'>--</span>
<a name="line-4"></a><a name="SubstEnv"></a><span class='hs-comment'>-- * The domain of the TvSubstEnv and IdSubstEnv are the template</span>
<a name="line-5"></a><a name="SubstEnv"></a><span class='hs-comment'>-- variables passed into the match.</span>
<a name="line-6"></a><a name="SubstEnv"></a><span class='hs-comment'>--</span>
<a name="line-7"></a><a name="SubstEnv"></a><span class='hs-comment'>-- * The (OrdList CoreBind) in a SubstEnv are the bindings floated out</span>
<a name="line-8"></a><a name="SubstEnv"></a><span class='hs-comment'>-- from nested matches; see the Let case of match, below</span>
<a name="line-9"></a><a name="SubstEnv"></a><span class='hs-comment'>--</span>
<a name="line-10"></a><a name="SubstEnv"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>SubstEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-conid'>TvSubstEnv</span><span class='hs-layout'>,</span> <span class='hs-conid'>IdSubstEnv</span><span class='hs-layout'>,</span> <span class='hs-conid'>OrdList</span> <span class='hs-conid'>CoreBind</span><span class='hs-layout'>)</span>
<a name="line-11"></a><a name="IdSubstEnv"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>IdSubstEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>IdEnv</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-12"></a>
<a name="line-13"></a><a name="emptySubstEnv"></a><span class='hs-definition'>emptySubstEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SubstEnv</span>
<a name="line-14"></a><span class='hs-definition'>emptySubstEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>emptyVarEnv</span><span class='hs-layout'>,</span> <span class='hs-varid'>emptyVarEnv</span><span class='hs-layout'>,</span> <span class='hs-varid'>nilOL</span><span class='hs-layout'>)</span>
<a name="line-15"></a>
<a name="line-16"></a>
<a name="line-17"></a><span class='hs-comment'>-- At one stage I tried to match even if there are more </span>
<a name="line-18"></a><span class='hs-comment'>-- template args than real args.</span>
<a name="line-19"></a>
<a name="line-20"></a><span class='hs-comment'>-- I now think this is probably a bad idea.</span>
<a name="line-21"></a><span class='hs-comment'>-- Should the template (map f xs) match (map g)? I think not.</span>
<a name="line-22"></a><span class='hs-comment'>-- For a start, in general eta expansion wastes work.</span>
<a name="line-23"></a><span class='hs-comment'>-- SLPJ July 99</span>
<a name="line-24"></a>
<a name="line-25"></a>
<a name="line-26"></a><a name="match"></a><span class='hs-definition'>match</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MatchEnv</span>
<a name="line-27"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SubstEnv</span>
<a name="line-28"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Template</span>
<a name="line-29"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Target</span>
<a name="line-30"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>SubstEnv</span>
<a name="line-31"></a>
<a name="line-32"></a><span class='hs-comment'>-- See the notes with Unify.match, which matches types</span>
<a name="line-33"></a><span class='hs-comment'>-- Everything is very similar for terms</span>
<a name="line-34"></a>
<a name="line-35"></a><span class='hs-comment'>-- Interesting examples:</span>
<a name="line-36"></a><span class='hs-comment'>-- Consider matching</span>
<a name="line-37"></a><span class='hs-comment'>-- \x->f against \f->f</span>
<a name="line-38"></a><span class='hs-comment'>-- When we meet the lambdas we must remember to rename f to f' in the</span>
<a name="line-39"></a><span class='hs-comment'>-- second expresion. The RnEnv2 does that.</span>
<a name="line-40"></a><span class='hs-comment'>--</span>
<a name="line-41"></a><span class='hs-comment'>-- Consider matching </span>
<a name="line-42"></a><span class='hs-comment'>-- forall a. \b->b against \a->3</span>
<a name="line-43"></a><span class='hs-comment'>-- We must rename the \a. Otherwise when we meet the lambdas we </span>
<a name="line-44"></a><span class='hs-comment'>-- might substitute [a/b] in the template, and then erroneously </span>
<a name="line-45"></a><span class='hs-comment'>-- succeed in matching what looks like the template variable 'a' against 3.</span>
<a name="line-46"></a>
<a name="line-47"></a><span class='hs-comment'>-- The Var case follows closely what happens in Unify.match</span>
<a name="line-48"></a><span class='hs-definition'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v1</span><span class='hs-layout'>)</span> <span class='hs-varid'>e2</span>
<a name="line-49"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>subst</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>match_var</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>v1</span> <span class='hs-varid'>e2</span>
<a name="line-50"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>subst</span>
<a name="line-51"></a>
<a name="line-52"></a><span class='hs-definition'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-layout'>(</span><span class='hs-conid'>Note</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>e1</span><span class='hs-layout'>)</span> <span class='hs-varid'>e2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span>
<a name="line-53"></a><span class='hs-definition'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>e1</span> <span class='hs-layout'>(</span><span class='hs-conid'>Note</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span>
<a name="line-54"></a> <span class='hs-comment'>-- Ignore notes in both template and thing to be matched</span>
<a name="line-55"></a> <span class='hs-comment'>-- See Note [Notes in RULE matching]</span>
<a name="line-56"></a>
<a name="line-57"></a><span class='hs-definition'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>e1</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v2</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Note [Expanding variables]</span>
<a name="line-58"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>locallyBoundR</span> <span class='hs-varid'>rn_env</span> <span class='hs-varid'>v2</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Note [Do not expand locally-bound variables]</span>
<a name="line-59"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>e2'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>expandId</span> <span class='hs-varid'>v2'</span>
<a name="line-60"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match</span> <span class='hs-layout'>(</span><span class='hs-varid'>menv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>me_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nukeRnEnvR</span> <span class='hs-varid'>rn_env</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2'</span>
<a name="line-61"></a> <span class='hs-keyword'>where</span>
<a name="line-62"></a> <span class='hs-varid'>v2'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lookupRnInScope</span> <span class='hs-varid'>rn_env</span> <span class='hs-varid'>v2</span>
<a name="line-63"></a> <span class='hs-varid'>rn_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>me_env</span> <span class='hs-varid'>menv</span>
<a name="line-64"></a> <span class='hs-comment'>-- Notice that we look up v2 in the in-scope set</span>
<a name="line-65"></a> <span class='hs-comment'>-- See Note [Lookup in-scope]</span>
<a name="line-66"></a> <span class='hs-comment'>-- No need to apply any renaming first (hence no rnOccR)</span>
<a name="line-67"></a> <span class='hs-comment'>-- becuase of the not-locallyBoundR</span>
<a name="line-68"></a>
<a name="line-69"></a><span class='hs-definition'>match</span> <span class='hs-varid'>menv</span> <span class='hs-layout'>(</span><span class='hs-varid'>tv_subst</span><span class='hs-layout'>,</span> <span class='hs-varid'>id_subst</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span> <span class='hs-varid'>e1</span> <span class='hs-layout'>(</span><span class='hs-conid'>Let</span> <span class='hs-varid'>bind</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span>
<a name="line-70"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>all</span> <span class='hs-varid'>freshly_bound</span> <span class='hs-varid'>bndrs</span> <span class='hs-comment'>-- See Note [Matching lets]</span>
<a name="line-71"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>any</span> <span class='hs-layout'>(</span><span class='hs-varid'>locallyBoundR</span> <span class='hs-varid'>rn_env</span><span class='hs-layout'>)</span> <span class='hs-varid'>bind_fvs</span><span class='hs-layout'>)</span>
<a name="line-72"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match</span> <span class='hs-layout'>(</span><span class='hs-varid'>menv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>me_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rn_env'</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-73"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tv_subst</span><span class='hs-layout'>,</span> <span class='hs-varid'>id_subst</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds</span> <span class='hs-varop'>`snocOL`</span> <span class='hs-varid'>bind'</span><span class='hs-layout'>)</span>
<a name="line-74"></a> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2'</span>
<a name="line-75"></a> <span class='hs-keyword'>where</span>
<a name="line-76"></a> <span class='hs-varid'>rn_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>me_env</span> <span class='hs-varid'>menv</span>
<a name="line-77"></a> <span class='hs-varid'>bndrs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bindersOf</span> <span class='hs-varid'>bind</span>
<a name="line-78"></a> <span class='hs-varid'>bind_fvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>varSetElems</span> <span class='hs-layout'>(</span><span class='hs-varid'>bindFreeVars</span> <span class='hs-varid'>bind</span><span class='hs-layout'>)</span>
<a name="line-79"></a> <span class='hs-varid'>freshly_bound</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span> <span class='hs-varop'>`rnInScope`</span> <span class='hs-varid'>rn_env</span><span class='hs-layout'>)</span>
<a name="line-80"></a> <span class='hs-varid'>bind'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bind</span>
<a name="line-81"></a> <span class='hs-varid'>e2'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>e2</span>
<a name="line-82"></a> <span class='hs-varid'>rn_env'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendRnInScopeList</span> <span class='hs-varid'>rn_env</span> <span class='hs-varid'>bndrs</span>
<a name="line-83"></a>
<a name="line-84"></a><span class='hs-definition'>match</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>subst</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lit</span> <span class='hs-varid'>lit1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lit</span> <span class='hs-varid'>lit2</span><span class='hs-layout'>)</span>
<a name="line-85"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>lit1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>lit2</span>
<a name="line-86"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>subst</span>
<a name="line-87"></a>
<a name="line-88"></a><span class='hs-definition'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>f1</span> <span class='hs-varid'>a1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>f2</span> <span class='hs-varid'>a2</span><span class='hs-layout'>)</span>
<a name="line-89"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>subst'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>f1</span> <span class='hs-varid'>f2</span>
<a name="line-90"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst'</span> <span class='hs-varid'>a1</span> <span class='hs-varid'>a2</span> <span class='hs-layout'>}</span>
<a name="line-91"></a>
<a name="line-92"></a><span class='hs-definition'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lam</span> <span class='hs-varid'>x1</span> <span class='hs-varid'>e1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lam</span> <span class='hs-varid'>x2</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span>
<a name="line-93"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match</span> <span class='hs-varid'>menv'</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span>
<a name="line-94"></a> <span class='hs-keyword'>where</span>
<a name="line-95"></a> <span class='hs-varid'>menv'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>menv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>me_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rnBndr2</span> <span class='hs-layout'>(</span><span class='hs-varid'>me_env</span> <span class='hs-varid'>menv</span><span class='hs-layout'>)</span> <span class='hs-varid'>x1</span> <span class='hs-varid'>x2</span> <span class='hs-layout'>}</span>
<a name="line-96"></a>
<a name="line-97"></a><span class='hs-comment'>-- This rule does eta expansion</span>
<a name="line-98"></a><span class='hs-comment'>-- (\x.M) ~ N iff M ~ N x</span>
<a name="line-99"></a><span class='hs-comment'>-- It's important that this is *after* the let rule,</span>
<a name="line-100"></a><span class='hs-comment'>-- so that (\x.M) ~ (let y = e in \y.N)</span>
<a name="line-101"></a><span class='hs-comment'>-- does the let thing, and then gets the lam/lam rule above</span>
<a name="line-102"></a><span class='hs-definition'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lam</span> <span class='hs-varid'>x1</span> <span class='hs-varid'>e1</span><span class='hs-layout'>)</span> <span class='hs-varid'>e2</span>
<a name="line-103"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match</span> <span class='hs-varid'>menv'</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>e1</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>e2</span> <span class='hs-layout'>(</span><span class='hs-varid'>varToCoreExpr</span> <span class='hs-varid'>new_x</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-104"></a> <span class='hs-keyword'>where</span>
<a name="line-105"></a> <span class='hs-layout'>(</span><span class='hs-varid'>rn_env'</span><span class='hs-layout'>,</span> <span class='hs-varid'>new_x</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rnBndrL</span> <span class='hs-layout'>(</span><span class='hs-varid'>me_env</span> <span class='hs-varid'>menv</span><span class='hs-layout'>)</span> <span class='hs-varid'>x1</span>
<a name="line-106"></a> <span class='hs-varid'>menv'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>menv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>me_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rn_env'</span> <span class='hs-layout'>}</span>
<a name="line-107"></a>
<a name="line-108"></a><span class='hs-comment'>-- Eta expansion the other way</span>
<a name="line-109"></a><span class='hs-comment'>-- M ~ (\y.N) iff M y ~ N</span>
<a name="line-110"></a><span class='hs-definition'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>e1</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lam</span> <span class='hs-varid'>x2</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span>
<a name="line-111"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match</span> <span class='hs-varid'>menv'</span> <span class='hs-varid'>subst</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>e1</span> <span class='hs-layout'>(</span><span class='hs-varid'>varToCoreExpr</span> <span class='hs-varid'>new_x</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>e2</span>
<a name="line-112"></a> <span class='hs-keyword'>where</span>
<a name="line-113"></a> <span class='hs-layout'>(</span><span class='hs-varid'>rn_env'</span><span class='hs-layout'>,</span> <span class='hs-varid'>new_x</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rnBndrR</span> <span class='hs-layout'>(</span><span class='hs-varid'>me_env</span> <span class='hs-varid'>menv</span><span class='hs-layout'>)</span> <span class='hs-varid'>x2</span>
<a name="line-114"></a> <span class='hs-varid'>menv'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>menv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>me_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rn_env'</span> <span class='hs-layout'>}</span>
<a name="line-115"></a>
<a name="line-116"></a><span class='hs-definition'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-layout'>(</span><span class='hs-conid'>Case</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>x1</span> <span class='hs-varid'>ty1</span> <span class='hs-varid'>alts1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Case</span> <span class='hs-varid'>e2</span> <span class='hs-varid'>x2</span> <span class='hs-varid'>ty2</span> <span class='hs-varid'>alts2</span><span class='hs-layout'>)</span>
<a name="line-117"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>subst1</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>match_ty</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>ty1</span> <span class='hs-varid'>ty2</span>
<a name="line-118"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>subst2</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst1</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span>
<a name="line-119"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>menv'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>menv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>me_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rnBndr2</span> <span class='hs-layout'>(</span><span class='hs-varid'>me_env</span> <span class='hs-varid'>menv</span><span class='hs-layout'>)</span> <span class='hs-varid'>x1</span> <span class='hs-varid'>x2</span> <span class='hs-layout'>}</span>
<a name="line-120"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>match_alts</span> <span class='hs-varid'>menv'</span> <span class='hs-varid'>subst2</span> <span class='hs-varid'>alts1</span> <span class='hs-varid'>alts2</span> <span class='hs-comment'>-- Alts are both sorted</span>
<a name="line-121"></a> <span class='hs-layout'>}</span>
<a name="line-122"></a>
<a name="line-123"></a><span class='hs-definition'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty2</span><span class='hs-layout'>)</span>
<a name="line-124"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match_ty</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>ty1</span> <span class='hs-varid'>ty2</span>
<a name="line-125"></a>
<a name="line-126"></a><span class='hs-definition'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-layout'>(</span><span class='hs-conid'>Cast</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>co1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Cast</span> <span class='hs-varid'>e2</span> <span class='hs-varid'>co2</span><span class='hs-layout'>)</span>
<a name="line-127"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>subst1</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>match_ty</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>co1</span> <span class='hs-varid'>co2</span>
<a name="line-128"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst1</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span> <span class='hs-layout'>}</span>
<a name="line-129"></a>
<a name="line-130"></a><span class='hs-comment'>-- Everything else fails</span>
<a name="line-131"></a><span class='hs-definition'>match</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-sel'>_e1</span> <span class='hs-sel'>_e2</span> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>-- pprTrace "Failing at" ((text "e1:" <+> ppr _e1) $$ (text "e2:" <+> ppr _e2)) $ </span>
<a name="line-132"></a> <span class='hs-conid'>Nothing</span>
<a name="line-133"></a>
<a name="line-134"></a><a name="match_var"></a><span class='hs-comment'>------------------------------------------</span>
<a name="line-135"></a><span class='hs-definition'>match_var</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MatchEnv</span>
<a name="line-136"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SubstEnv</span>
<a name="line-137"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Var</span> <span class='hs-comment'>-- Template</span>
<a name="line-138"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Target</span>
<a name="line-139"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>SubstEnv</span>
<a name="line-140"></a><span class='hs-definition'>match_var</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-varid'>tv_subst</span><span class='hs-layout'>,</span> <span class='hs-varid'>id_subst</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span> <span class='hs-varid'>v1</span> <span class='hs-varid'>e2</span>
<a name="line-141"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>v1'</span> <span class='hs-varop'>`elemVarSet`</span> <span class='hs-varid'>me_tmpls</span> <span class='hs-varid'>menv</span>
<a name="line-142"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupVarEnv</span> <span class='hs-varid'>id_subst</span> <span class='hs-varid'>v1'</span> <span class='hs-keyword'>of</span>
<a name="line-143"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>any</span> <span class='hs-layout'>(</span><span class='hs-varid'>inRnEnvR</span> <span class='hs-varid'>rn_env</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>varSetElems</span> <span class='hs-layout'>(</span><span class='hs-varid'>exprFreeVars</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-144"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Nothing</span> <span class='hs-comment'>-- Occurs check failure</span>
<a name="line-145"></a> <span class='hs-comment'>-- e.g. match forall a. (\x-> a x) against (\y. y y)</span>
<a name="line-146"></a>
<a name="line-147"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- No renaming to do on e2, because no free var</span>
<a name="line-148"></a> <span class='hs-comment'>-- of e2 is in the rnEnvR of the envt</span>
<a name="line-149"></a> <span class='hs-comment'>-- Note [Matching variable types]</span>
<a name="line-150"></a> <span class='hs-comment'>-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~</span>
<a name="line-151"></a> <span class='hs-comment'>-- However, we must match the *types*; e.g.</span>
<a name="line-152"></a> <span class='hs-comment'>-- forall (c::Char->Int) (x::Char). </span>
<a name="line-153"></a> <span class='hs-comment'>-- f (c x) = "RULE FIRED"</span>
<a name="line-154"></a> <span class='hs-comment'>-- We must only match on args that have the right type</span>
<a name="line-155"></a> <span class='hs-comment'>-- It's actually quite difficult to come up with an example that shows</span>
<a name="line-156"></a> <span class='hs-comment'>-- you need type matching, esp since matching is left-to-right, so type</span>
<a name="line-157"></a> <span class='hs-comment'>-- args get matched first. But it's possible (e.g. simplrun008) and</span>
<a name="line-158"></a> <span class='hs-comment'>-- this is the Right Thing to do</span>
<a name="line-159"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tv_subst'</span> <span class='hs-keyglyph'><-</span> <span class='hs-conid'>Unify</span><span class='hs-varop'>.</span><span class='hs-varid'>ruleMatchTyX</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>tv_subst</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>v1'</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>exprType</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span>
<a name="line-160"></a> <span class='hs-comment'>-- c.f. match_ty below</span>
<a name="line-161"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tv_subst'</span><span class='hs-layout'>,</span> <span class='hs-varid'>extendVarEnv</span> <span class='hs-varid'>id_subst</span> <span class='hs-varid'>v1'</span> <span class='hs-varid'>e2</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-162"></a>
<a name="line-163"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>e1'</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>eqExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>nukeRnEnvL</span> <span class='hs-varid'>rn_env</span><span class='hs-layout'>)</span> <span class='hs-varid'>e1'</span> <span class='hs-varid'>e2</span>
<a name="line-164"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Just</span> <span class='hs-varid'>subst</span>
<a name="line-165"></a>
<a name="line-166"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-167"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Nothing</span>
<a name="line-168"></a>
<a name="line-169"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- v1 is not a template variable; check for an exact match with e2</span>
<a name="line-170"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>e2</span> <span class='hs-keyword'>of</span>
<a name="line-171"></a> <span class='hs-conid'>Var</span> <span class='hs-varid'>v2</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>v1'</span> <span class='hs-varop'>==</span> <span class='hs-varid'>rnOccR</span> <span class='hs-varid'>rn_env</span> <span class='hs-varid'>v2</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Just</span> <span class='hs-varid'>subst</span>
<a name="line-172"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Nothing</span>
<a name="line-173"></a>
<a name="line-174"></a> <span class='hs-keyword'>where</span>
<a name="line-175"></a> <span class='hs-varid'>rn_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>me_env</span> <span class='hs-varid'>menv</span>
<a name="line-176"></a> <span class='hs-varid'>v1'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rnOccL</span> <span class='hs-varid'>rn_env</span> <span class='hs-varid'>v1</span>
<a name="line-177"></a> <span class='hs-comment'>-- If the template is</span>
<a name="line-178"></a> <span class='hs-comment'>-- forall x. f x (\x -> x) = ...</span>
<a name="line-179"></a> <span class='hs-comment'>-- Then the x inside the lambda isn't the </span>
<a name="line-180"></a> <span class='hs-comment'>-- template x, so we must rename first!</span>
<a name="line-181"></a>
<a name="line-182"></a>
<a name="line-183"></a><a name="match_alts"></a><span class='hs-comment'>------------------------------------------</span>
<a name="line-184"></a><span class='hs-definition'>match_alts</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MatchEnv</span>
<a name="line-185"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SubstEnv</span>
<a name="line-186"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreAlt</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Template</span>
<a name="line-187"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreAlt</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Target</span>
<a name="line-188"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>SubstEnv</span>
<a name="line-189"></a><span class='hs-definition'>match_alts</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>subst</span> <span class='hs-conid'>[]</span> <span class='hs-conid'>[]</span>
<a name="line-190"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varid'>subst</span>
<a name="line-191"></a><span class='hs-definition'>match_alts</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>c1</span><span class='hs-layout'>,</span><span class='hs-varid'>vs1</span><span class='hs-layout'>,</span><span class='hs-varid'>r1</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>alts1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>c2</span><span class='hs-layout'>,</span><span class='hs-varid'>vs2</span><span class='hs-layout'>,</span><span class='hs-varid'>r2</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>alts2</span><span class='hs-layout'>)</span>
<a name="line-192"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>c1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>c2</span>
<a name="line-193"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>subst1</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>match</span> <span class='hs-varid'>menv'</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>r1</span> <span class='hs-varid'>r2</span>
<a name="line-194"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>match_alts</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>subst1</span> <span class='hs-varid'>alts1</span> <span class='hs-varid'>alts2</span> <span class='hs-layout'>}</span>
<a name="line-195"></a> <span class='hs-keyword'>where</span>
<a name="line-196"></a> <span class='hs-varid'>menv'</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MatchEnv</span>
<a name="line-197"></a> <span class='hs-varid'>menv'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>menv</span> <span class='hs-layout'>{</span> <span class='hs-varid'>me_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rnBndrs2</span> <span class='hs-layout'>(</span><span class='hs-varid'>me_env</span> <span class='hs-varid'>menv</span><span class='hs-layout'>)</span> <span class='hs-varid'>vs1</span> <span class='hs-varid'>vs2</span> <span class='hs-layout'>}</span>
<a name="line-198"></a>
<a name="line-199"></a><span class='hs-definition'>match_alts</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span>
<a name="line-200"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
</pre>\end{code}
Matching Core types: use the matcher in TcType.
Notice that we treat newtypes as opaque. For example, suppose
we have a specialised version of a function at a newtype, say
newtype T = MkT Int
We only want to replace (f T) with f', not (f Int).
\begin{code}
<pre><a name="line-1"></a><a name="match_ty"></a><span class='hs-comment'>------------------------------------------</span>
<a name="line-2"></a><span class='hs-definition'>match_ty</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MatchEnv</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SubstEnv</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- Template</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- Target</span>
<a name="line-6"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>SubstEnv</span>
<a name="line-7"></a><span class='hs-definition'>match_ty</span> <span class='hs-varid'>menv</span> <span class='hs-layout'>(</span><span class='hs-varid'>tv_subst</span><span class='hs-layout'>,</span> <span class='hs-varid'>id_subst</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty1</span> <span class='hs-varid'>ty2</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tv_subst'</span> <span class='hs-keyglyph'><-</span> <span class='hs-conid'>Unify</span><span class='hs-varop'>.</span><span class='hs-varid'>ruleMatchTyX</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>tv_subst</span> <span class='hs-varid'>ty1</span> <span class='hs-varid'>ty2</span>
<a name="line-9"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tv_subst'</span><span class='hs-layout'>,</span> <span class='hs-varid'>id_subst</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
</pre>\end{code}
Note [Expanding variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~
Here is another Very Important rule: if the term being matched is a
variable, we expand it so long as its unfolding is "expandable". (Its
occurrence information is not necessarily up to date, so we don't use
it.) By "expandable" we mean a WHNF or a "constructor-like" application.
This is the key reason for "constructor-like" Ids. If we have
{-# NOINLINE [1] CONLIKE g #-}
{-# RULE f (g x) = h x #-}
then in the term
let v = g 3 in ....(f v)....
we want to make the rule fire, to replace (f v) with (h 3).
Note [Do not expand locally-bound variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Do *not* expand locally-bound variables, else there's a worry that the
unfolding might mention variables that are themselves renamed.
Example
case x of y { (p,q) -> ...y... }
Don't expand 'y' to (p,q) because p,q might themselves have been
renamed. Essentially we only expand unfoldings that are "outside"
the entire match.
Hence, (a) the guard (not (isLocallyBoundR v2))
(b) when we expand we nuke the renaming envt (nukeRnEnvR).
Note [Notes in RULE matching]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Look through Notes in both template and expression being matched. In
particular, we don't want to be confused by InlineMe notes. Maybe we
should be more careful about profiling notes, but for now I'm just
riding roughshod over them. cf Note [Notes in call patterns] in
SpecConstr
Note [Matching lets]
~~~~~~~~~~~~~~~~~~~~
Matching a let-expression. Consider
RULE forall x. f (g x) = <rhs>
and target expression
f (let { w=R } in g E))
Then we'd like the rule to match, to generate
let { w=R } in (\x. <rhs>) E
In effect, we want to float the let-binding outward, to enable
the match to happen. This is the WHOLE REASON for accumulating
bindings in the SubstEnv
We can only do this if
(a) Widening the scope of w does not capture any variables
We use a conservative test: w is not already in scope
If not, we clone the binders, and substitute
(b) The free variables of R are not bound by the part of the
target expression outside the let binding; e.g.
f (\v. let w = v+1 in g E)
Here we obviously cannot float the let-binding for w.
You may think rule (a) would never apply, because rule matching is
mostly invoked from the simplifier, when we have just run substExpr
over the argument, so there will be no shadowing anyway.
The fly in the ointment is that the forall'd variables of the
RULE itself are considered in scope.
I though of various ways to solve (a). One plan was to
clone the binders if they are in scope. But watch out!
(let x=y+1 in let z=x+1 in (z,z)
--> should match (p,p) but watch out that
the use of x on z's rhs is OK!
If we clone x, then the let-binding for 'z' is then caught by (b),
at least unless we elaborate the RnEnv stuff a bit.
So for we simply fail to match unless both (a) and (b) hold.
Other cases to think about
(let x=y+1 in \x. (x,x))
--> let x=y+1 in (\x1. (x1,x1))
(\x. let x = y+1 in (x,x))
--> let x1 = y+1 in (\x. (x1,x1)
(let x=y+1 in (x,x), let x=y-1 in (x,x))
--> let x=y+1 in let x1=y-1 in ((x,x),(x1,x1))
Note [Lookup in-scope]
~~~~~~~~~~~~~~~~~~~~~~
Consider this example
foo :: Int -> Maybe Int -> Int
foo 0 (Just n) = n
foo m (Just n) = foo (m-n) (Just n)
SpecConstr sees this fragment:
case w_smT of wild_Xf [Just A] {
Data.Maybe.Nothing -> lvl_smf;
Data.Maybe.Just n_acT [Just S(L)] ->
case n_acT of wild1_ams [Just A] { GHC.Base.I# y_amr [Just L] ->
\$wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf
}};
and correctly generates the rule
RULES: "SC:$wfoo1" [0] __forall {y_amr [Just L] :: GHC.Prim.Int#
sc_snn :: GHC.Prim.Int#}
\$wfoo_smW sc_snn (Data.Maybe.Just @ GHC.Base.Int (GHC.Base.I# y_amr))
= \$s\$wfoo_sno y_amr sc_snn ;]
BUT we must ensure that this rule matches in the original function!
Note that the call to \$wfoo is
\$wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf
During matching we expand wild_Xf to (Just n_acT). But then we must also
expand n_acT to (I# y_amr). And we can only do that if we look up n_acT
in the in-scope set, because in wild_Xf's unfolding it won't have an unfolding
at all.
That is why the 'lookupRnInScope' call in the (Var v2) case of 'match'
is so important.
\begin{code}
<pre><a name="line-1"></a><a name="eqExpr"></a><span class='hs-definition'>eqExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RnEnv2</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-2"></a><span class='hs-comment'>-- ^ A kind of shallow equality used in rule matching, so does </span>
<a name="line-3"></a><span class='hs-comment'>-- /not/ look through newtypes or predicate types</span>
<a name="line-4"></a>
<a name="line-5"></a><span class='hs-definition'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v2</span><span class='hs-layout'>)</span>
<a name="line-6"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>rnOccL</span> <span class='hs-varid'>env</span> <span class='hs-varid'>v1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>rnOccR</span> <span class='hs-varid'>env</span> <span class='hs-varid'>v2</span>
<a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-8"></a>
<a name="line-9"></a><span class='hs-comment'>-- The next two rules expand non-local variables</span>
<a name="line-10"></a><span class='hs-comment'>-- C.f. Note [Expanding variables]</span>
<a name="line-11"></a><span class='hs-comment'>-- and Note [Do not expand locally-bound variables]</span>
<a name="line-12"></a><span class='hs-definition'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v1</span><span class='hs-layout'>)</span> <span class='hs-varid'>e2</span>
<a name="line-13"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>locallyBoundL</span> <span class='hs-varid'>env</span> <span class='hs-varid'>v1</span><span class='hs-layout'>)</span>
<a name="line-14"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>e1'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>expandId</span> <span class='hs-layout'>(</span><span class='hs-varid'>lookupRnInScope</span> <span class='hs-varid'>env</span> <span class='hs-varid'>v1</span><span class='hs-layout'>)</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eqExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>nukeRnEnvL</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-varid'>e1'</span> <span class='hs-varid'>e2</span>
<a name="line-16"></a>
<a name="line-17"></a><span class='hs-definition'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-varid'>e1</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v2</span><span class='hs-layout'>)</span>
<a name="line-18"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>locallyBoundR</span> <span class='hs-varid'>env</span> <span class='hs-varid'>v2</span><span class='hs-layout'>)</span>
<a name="line-19"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>e2'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>expandId</span> <span class='hs-layout'>(</span><span class='hs-varid'>lookupRnInScope</span> <span class='hs-varid'>env</span> <span class='hs-varid'>v2</span><span class='hs-layout'>)</span>
<a name="line-20"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eqExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>nukeRnEnvR</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2'</span>
<a name="line-21"></a>
<a name="line-22"></a><span class='hs-definition'>eqExpr</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lit</span> <span class='hs-varid'>lit1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lit</span> <span class='hs-varid'>lit2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lit1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>lit2</span>
<a name="line-23"></a><span class='hs-definition'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>f1</span> <span class='hs-varid'>a1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>f2</span> <span class='hs-varid'>a2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-varid'>f1</span> <span class='hs-varid'>f2</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-varid'>a1</span> <span class='hs-varid'>a2</span>
<a name="line-24"></a><span class='hs-definition'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lam</span> <span class='hs-varid'>v1</span> <span class='hs-varid'>e1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lam</span> <span class='hs-varid'>v2</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eqExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>rnBndr2</span> <span class='hs-varid'>env</span> <span class='hs-varid'>v1</span> <span class='hs-varid'>v2</span><span class='hs-layout'>)</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span>
<a name="line-25"></a><span class='hs-definition'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Note</span> <span class='hs-varid'>n1</span> <span class='hs-varid'>e1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Note</span> <span class='hs-varid'>n2</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eq_note</span> <span class='hs-varid'>env</span> <span class='hs-varid'>n1</span> <span class='hs-varid'>n2</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span>
<a name="line-26"></a><span class='hs-definition'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Cast</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>co1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Cast</span> <span class='hs-varid'>e2</span> <span class='hs-varid'>co2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcEqTypeX</span> <span class='hs-varid'>env</span> <span class='hs-varid'>co1</span> <span class='hs-varid'>co2</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span>
<a name="line-27"></a><span class='hs-definition'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>t1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>t2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcEqTypeX</span> <span class='hs-varid'>env</span> <span class='hs-varid'>t1</span> <span class='hs-varid'>t2</span>
<a name="line-28"></a>
<a name="line-29"></a><span class='hs-definition'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Let</span> <span class='hs-layout'>(</span><span class='hs-conid'>NonRec</span> <span class='hs-varid'>v1</span> <span class='hs-varid'>r1</span><span class='hs-layout'>)</span> <span class='hs-varid'>e1</span><span class='hs-layout'>)</span>
<a name="line-30"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Let</span> <span class='hs-layout'>(</span><span class='hs-conid'>NonRec</span> <span class='hs-varid'>v2</span> <span class='hs-varid'>r2</span><span class='hs-layout'>)</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-varid'>r1</span> <span class='hs-varid'>r2</span>
<a name="line-31"></a> <span class='hs-varop'>&&</span> <span class='hs-varid'>eqExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>rnBndr2</span> <span class='hs-varid'>env</span> <span class='hs-varid'>v1</span> <span class='hs-varid'>v2</span><span class='hs-layout'>)</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span>
<a name="line-32"></a><span class='hs-definition'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Let</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rec</span> <span class='hs-varid'>ps1</span><span class='hs-layout'>)</span> <span class='hs-varid'>e1</span><span class='hs-layout'>)</span>
<a name="line-33"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Let</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rec</span> <span class='hs-varid'>ps2</span><span class='hs-layout'>)</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>equalLength</span> <span class='hs-varid'>ps1</span> <span class='hs-varid'>ps2</span>
<a name="line-34"></a> <span class='hs-varop'>&&</span> <span class='hs-varid'>and</span> <span class='hs-layout'>(</span><span class='hs-varid'>zipWith</span> <span class='hs-varid'>eq_rhs</span> <span class='hs-varid'>ps1</span> <span class='hs-varid'>ps2</span><span class='hs-layout'>)</span>
<a name="line-35"></a> <span class='hs-varop'>&&</span> <span class='hs-varid'>eqExpr</span> <span class='hs-varid'>env'</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span>
<a name="line-36"></a> <span class='hs-keyword'>where</span>
<a name="line-37"></a> <span class='hs-varid'>env'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldl2</span> <span class='hs-varid'>rn_bndr2</span> <span class='hs-varid'>env</span> <span class='hs-varid'>ps2</span> <span class='hs-varid'>ps2</span>
<a name="line-38"></a> <span class='hs-varid'>rn_bndr2</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-varid'>b1</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>b2</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'>rnBndr2</span> <span class='hs-varid'>env</span> <span class='hs-varid'>b1</span> <span class='hs-varid'>b2</span>
<a name="line-39"></a> <span class='hs-varid'>eq_rhs</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>r1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>r2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eqExpr</span> <span class='hs-varid'>env'</span> <span class='hs-varid'>r1</span> <span class='hs-varid'>r2</span>
<a name="line-40"></a><span class='hs-definition'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Case</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>v1</span> <span class='hs-varid'>t1</span> <span class='hs-varid'>a1</span><span class='hs-layout'>)</span>
<a name="line-41"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Case</span> <span class='hs-varid'>e2</span> <span class='hs-varid'>v2</span> <span class='hs-varid'>t2</span> <span class='hs-varid'>a2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eqExpr</span> <span class='hs-varid'>env</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span>
<a name="line-42"></a> <span class='hs-varop'>&&</span> <span class='hs-varid'>tcEqTypeX</span> <span class='hs-varid'>env</span> <span class='hs-varid'>t1</span> <span class='hs-varid'>t2</span>
<a name="line-43"></a> <span class='hs-varop'>&&</span> <span class='hs-varid'>equalLength</span> <span class='hs-varid'>a1</span> <span class='hs-varid'>a2</span>
<a name="line-44"></a> <span class='hs-varop'>&&</span> <span class='hs-varid'>and</span> <span class='hs-layout'>(</span><span class='hs-varid'>zipWith</span> <span class='hs-layout'>(</span><span class='hs-varid'>eq_alt</span> <span class='hs-varid'>env'</span><span class='hs-layout'>)</span> <span class='hs-varid'>a1</span> <span class='hs-varid'>a2</span><span class='hs-layout'>)</span>
<a name="line-45"></a> <span class='hs-keyword'>where</span>
<a name="line-46"></a> <span class='hs-varid'>env'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rnBndr2</span> <span class='hs-varid'>env</span> <span class='hs-varid'>v1</span> <span class='hs-varid'>v2</span>
<a name="line-47"></a>
<a name="line-48"></a><span class='hs-definition'>eqExpr</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-49"></a>
<a name="line-50"></a><a name="eq_alt"></a><span class='hs-definition'>eq_alt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RnEnv2</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreAlt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreAlt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-51"></a><span class='hs-definition'>eq_alt</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-varid'>c1</span><span class='hs-layout'>,</span><span class='hs-varid'>vs1</span><span class='hs-layout'>,</span><span class='hs-varid'>r1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>c2</span><span class='hs-layout'>,</span><span class='hs-varid'>vs2</span><span class='hs-layout'>,</span><span class='hs-varid'>r2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>c1</span><span class='hs-varop'>==</span><span class='hs-varid'>c2</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>eqExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>rnBndrs2</span> <span class='hs-varid'>env</span> <span class='hs-varid'>vs1</span> <span class='hs-varid'>vs2</span><span class='hs-layout'>)</span> <span class='hs-varid'>r1</span> <span class='hs-varid'>r2</span>
<a name="line-52"></a>
<a name="line-53"></a><a name="eq_note"></a><span class='hs-definition'>eq_note</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RnEnv2</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Note</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Note</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-54"></a><span class='hs-definition'>eq_note</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>SCC</span> <span class='hs-varid'>cc1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>SCC</span> <span class='hs-varid'>cc2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cc1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>cc2</span>
<a name="line-55"></a><span class='hs-definition'>eq_note</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreNote</span> <span class='hs-varid'>s1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreNote</span> <span class='hs-varid'>s2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>s1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>s2</span>
<a name="line-56"></a><span class='hs-definition'>eq_note</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>InlineMe</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>InlineMe</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-57"></a><span class='hs-definition'>eq_note</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
</pre>\end{code}
Auxiliary functions
\begin{code}
<pre><a name="line-1"></a><a name="locallyBoundL"></a><span class='hs-definition'>locallyBoundL</span><span class='hs-layout'>,</span> <span class='hs-varid'>locallyBoundR</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RnEnv2</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Var</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-2"></a><span class='hs-definition'>locallyBoundL</span> <span class='hs-varid'>rn_env</span> <span class='hs-varid'>v</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>inRnEnvL</span> <span class='hs-varid'>rn_env</span> <span class='hs-varid'>v</span>
<a name="line-3"></a><a name="locallyBoundR"></a><span class='hs-definition'>locallyBoundR</span> <span class='hs-varid'>rn_env</span> <span class='hs-varid'>v</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>inRnEnvR</span> <span class='hs-varid'>rn_env</span> <span class='hs-varid'>v</span>
<a name="line-4"></a>
<a name="line-5"></a>
<a name="line-6"></a><a name="expandId"></a><span class='hs-definition'>expandId</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-7"></a><span class='hs-definition'>expandId</span> <span class='hs-varid'>id</span>
<a name="line-8"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isExpandableUnfolding</span> <span class='hs-varid'>unfolding</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>unfoldingTemplate</span> <span class='hs-varid'>unfolding</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-10"></a> <span class='hs-keyword'>where</span>
<a name="line-11"></a> <span class='hs-varid'>unfolding</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>idUnfolding</span> <span class='hs-varid'>id</span>
</pre>\end{code}
%************************************************************************
%* *
Rule-check the program
%* *
%************************************************************************
We want to know what sites have rules that could have fired but didn't.
This pass runs over the tree (without changing it) and reports such.
\begin{code}
<pre><a name="line-1"></a><a name="ruleCheckProgram"></a><span class='hs-comment'>-- | Report partial matches for rules beginning with the specified</span>
<a name="line-2"></a><span class='hs-comment'>-- string for the purposes of error reporting</span>
<a name="line-3"></a><span class='hs-definition'>ruleCheckProgram</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Activation</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- ^ Rule activation test</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span> <span class='hs-comment'>-- ^ Rule pattern</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RuleBase</span> <span class='hs-comment'>-- ^ Database of rules</span>
<a name="line-6"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBind</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- ^ Bindings to check in</span>
<a name="line-7"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span> <span class='hs-comment'>-- ^ Resulting check message</span>
<a name="line-8"></a><span class='hs-definition'>ruleCheckProgram</span> <span class='hs-varid'>is_active</span> <span class='hs-varid'>rule_pat</span> <span class='hs-varid'>rule_base</span> <span class='hs-varid'>binds</span>
<a name="line-9"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isEmptyBag</span> <span class='hs-varid'>results</span>
<a name="line-10"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-str'>"Rule check results: no rule application sites"</span>
<a name="line-11"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>text</span> <span class='hs-str'>"Rule check results:"</span><span class='hs-layout'>,</span>
<a name="line-13"></a> <span class='hs-varid'>line</span><span class='hs-layout'>,</span>
<a name="line-14"></a> <span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>p</span> <span class='hs-varop'>$$</span> <span class='hs-varid'>line</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>bagToList</span> <span class='hs-varid'>results</span> <span class='hs-keyglyph'>]</span>
<a name="line-15"></a> <span class='hs-keyglyph'>]</span>
<a name="line-16"></a> <span class='hs-keyword'>where</span>
<a name="line-17"></a> <span class='hs-varid'>results</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unionManyBags</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>ruleCheckBind</span> <span class='hs-layout'>(</span><span class='hs-conid'>RuleCheckEnv</span> <span class='hs-varid'>is_active</span> <span class='hs-varid'>rule_pat</span> <span class='hs-varid'>rule_base</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span>
<a name="line-18"></a> <span class='hs-varid'>line</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>replicate</span> <span class='hs-num'>20</span> <span class='hs-chr'>'-'</span><span class='hs-layout'>)</span>
<a name="line-19"></a>
<a name="line-20"></a><a name="RuleCheckEnv"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>RuleCheckEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RuleCheckEnv</span> <span class='hs-layout'>{</span>
<a name="line-21"></a> <span class='hs-varid'>rc_is_active</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Activation</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>,</span>
<a name="line-22"></a> <span class='hs-varid'>rc_pattern</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span><span class='hs-layout'>,</span>
<a name="line-23"></a> <span class='hs-varid'>rc_rule_base</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleBase</span>
<a name="line-24"></a><span class='hs-layout'>}</span>
<a name="line-25"></a>
<a name="line-26"></a><a name="ruleCheckBind"></a><span class='hs-definition'>ruleCheckBind</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleCheckEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreBind</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bag</span> <span class='hs-conid'>SDoc</span>
<a name="line-27"></a> <span class='hs-comment'>-- The Bag returned has one SDoc for each call site found</span>
<a name="line-28"></a><span class='hs-definition'>ruleCheckBind</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>NonRec</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-varid'>r</span>
<a name="line-29"></a><span class='hs-definition'>ruleCheckBind</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rec</span> <span class='hs-varid'>prs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unionManyBags</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-varid'>r</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'>r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>prs</span><span class='hs-keyglyph'>]</span>
<a name="line-30"></a>
<a name="line-31"></a><a name="ruleCheck"></a><span class='hs-definition'>ruleCheck</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleCheckEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bag</span> <span class='hs-conid'>SDoc</span>
<a name="line-32"></a><span class='hs-definition'>ruleCheck</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyBag</span>
<a name="line-33"></a><span class='hs-definition'>ruleCheck</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lit</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyBag</span>
<a name="line-34"></a><span class='hs-definition'>ruleCheck</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyBag</span>
<a name="line-35"></a><span class='hs-definition'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>f</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ruleCheckApp</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>f</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span>
<a name="line-36"></a><span class='hs-definition'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Note</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-varid'>e</span>
<a name="line-37"></a><span class='hs-definition'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Cast</span> <span class='hs-varid'>e</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-varid'>e</span>
<a name="line-38"></a><span class='hs-definition'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Let</span> <span class='hs-varid'>bd</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ruleCheckBind</span> <span class='hs-varid'>env</span> <span class='hs-varid'>bd</span> <span class='hs-varop'>`unionBags`</span> <span class='hs-varid'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-varid'>e</span>
<a name="line-39"></a><span class='hs-definition'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lam</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-varid'>e</span>
<a name="line-40"></a><span class='hs-definition'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Case</span> <span class='hs-varid'>e</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>as</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-varid'>e</span> <span class='hs-varop'>`unionBags`</span>
<a name="line-41"></a> <span class='hs-varid'>unionManyBags</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>as</span><span class='hs-keyglyph'>]</span>
<a name="line-42"></a>
<a name="line-43"></a><a name="ruleCheckApp"></a><span class='hs-definition'>ruleCheckApp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleCheckEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Expr</span> <span class='hs-conid'>CoreBndr</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Arg</span> <span class='hs-conid'>CoreBndr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bag</span> <span class='hs-conid'>SDoc</span>
<a name="line-44"></a><span class='hs-definition'>ruleCheckApp</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>f</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyword'>as</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`unionBags`</span> <span class='hs-varid'>ruleCheckApp</span> <span class='hs-varid'>env</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-conop'>:</span><span class='hs-keyword'>as</span><span class='hs-layout'>)</span>
<a name="line-45"></a><span class='hs-definition'>ruleCheckApp</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span> <span class='hs-keyword'>as</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ruleCheckFun</span> <span class='hs-varid'>env</span> <span class='hs-varid'>f</span> <span class='hs-keyword'>as</span>
<a name="line-46"></a><span class='hs-definition'>ruleCheckApp</span> <span class='hs-varid'>env</span> <span class='hs-varid'>other</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ruleCheck</span> <span class='hs-varid'>env</span> <span class='hs-varid'>other</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="ruleCheckFun"></a><span class='hs-definition'>ruleCheckFun</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleCheckEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bag</span> <span class='hs-conid'>SDoc</span>
<a name="line-2"></a><span class='hs-comment'>-- Produce a report for all rules matching the predicate</span>
<a name="line-3"></a><span class='hs-comment'>-- saying why it doesn't match the specified application</span>
<a name="line-4"></a>
<a name="line-5"></a><span class='hs-definition'>ruleCheckFun</span> <span class='hs-varid'>env</span> <span class='hs-varid'>fn</span> <span class='hs-varid'>args</span>
<a name="line-6"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>null</span> <span class='hs-varid'>name_match_rules</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyBag</span>
<a name="line-7"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unitBag</span> <span class='hs-layout'>(</span><span class='hs-varid'>ruleAppCheck_help</span> <span class='hs-layout'>(</span><span class='hs-varid'>rc_is_active</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-varid'>fn</span> <span class='hs-varid'>args</span> <span class='hs-varid'>name_match_rules</span><span class='hs-layout'>)</span>
<a name="line-8"></a> <span class='hs-keyword'>where</span>
<a name="line-9"></a> <span class='hs-varid'>name_match_rules</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>filter</span> <span class='hs-varid'>match</span> <span class='hs-layout'>(</span><span class='hs-varid'>getRules</span> <span class='hs-layout'>(</span><span class='hs-varid'>rc_rule_base</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-varid'>fn</span><span class='hs-layout'>)</span>
<a name="line-10"></a> <span class='hs-varid'>match</span> <span class='hs-varid'>rule</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>rc_pattern</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-varop'>`isPrefixOf`</span> <span class='hs-varid'>unpackFS</span> <span class='hs-layout'>(</span><span class='hs-varid'>ruleName</span> <span class='hs-varid'>rule</span><span class='hs-layout'>)</span>
<a name="line-11"></a>
<a name="line-12"></a><a name="ruleAppCheck_help"></a><span class='hs-definition'>ruleAppCheck_help</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Activation</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreRule</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-13"></a><span class='hs-definition'>ruleAppCheck_help</span> <span class='hs-varid'>is_active</span> <span class='hs-varid'>fn</span> <span class='hs-varid'>args</span> <span class='hs-varid'>rules</span>
<a name="line-14"></a> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>-- The rules match the pattern, so we want to print something</span>
<a name="line-15"></a> <span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>text</span> <span class='hs-str'>"Expression:"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>fn</span><span class='hs-layout'>)</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-16"></a> <span class='hs-varid'>vcat</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>check_rule</span> <span class='hs-varid'>rules</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-17"></a> <span class='hs-keyword'>where</span>
<a name="line-18"></a> <span class='hs-varid'>n_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>args</span>
<a name="line-19"></a> <span class='hs-varid'>i_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>args</span> <span class='hs-varop'>`zip`</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>1</span><span class='hs-keyglyph'>::</span><span class='hs-conid'>Int</span> <span class='hs-keyglyph'>..</span><span class='hs-keyglyph'>]</span>
<a name="line-20"></a> <span class='hs-varid'>rough_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>roughTopName</span> <span class='hs-varid'>args</span>
<a name="line-21"></a>
<a name="line-22"></a> <span class='hs-varid'>check_rule</span> <span class='hs-varid'>rule</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rule_herald</span> <span class='hs-varid'>rule</span> <span class='hs-varop'><></span> <span class='hs-varid'>colon</span> <span class='hs-varop'><+></span> <span class='hs-varid'>rule_info</span> <span class='hs-varid'>rule</span>
<a name="line-23"></a>
<a name="line-24"></a> <span class='hs-varid'>rule_herald</span> <span class='hs-layout'>(</span><span class='hs-conid'>BuiltinRule</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ru_name</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>name</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-25"></a> <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'>"Builtin rule"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>doubleQuotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ftext</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span>
<a name="line-26"></a> <span class='hs-varid'>rule_herald</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rule</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ru_name</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>name</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-27"></a> <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'>"Rule"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>doubleQuotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ftext</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span>
<a name="line-28"></a>
<a name="line-29"></a> <span class='hs-varid'>rule_info</span> <span class='hs-varid'>rule</span>
<a name="line-30"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>matchRule</span> <span class='hs-varid'>noBlackList</span> <span class='hs-varid'>emptyInScopeSet</span> <span class='hs-varid'>args</span> <span class='hs-varid'>rough_args</span> <span class='hs-varid'>rule</span>
<a name="line-31"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-str'>"matches (which is very peculiar!)"</span>
<a name="line-32"></a>
<a name="line-33"></a> <span class='hs-varid'>rule_info</span> <span class='hs-layout'>(</span><span class='hs-conid'>BuiltinRule</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-str'>"does not match"</span>
<a name="line-34"></a>
<a name="line-35"></a> <span class='hs-varid'>rule_info</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rule</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ru_act</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>act</span><span class='hs-layout'>,</span>
<a name="line-36"></a> <span class='hs-varid'>ru_bndrs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rule_bndrs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ru_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rule_args</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-37"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>is_active</span> <span class='hs-varid'>act</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-str'>"active only in later phase"</span>
<a name="line-38"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>n_args</span> <span class='hs-varop'><</span> <span class='hs-varid'>n_rule_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-str'>"too few arguments"</span>
<a name="line-39"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>n_mismatches</span> <span class='hs-varop'>==</span> <span class='hs-varid'>n_rule_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-str'>"no arguments match"</span>
<a name="line-40"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>n_mismatches</span> <span class='hs-varop'>==</span> <span class='hs-num'>0</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-str'>"all arguments match (considered individually), but rule as a whole does not"</span>
<a name="line-41"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-str'>"arguments"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>mismatches</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-str'>"do not match (1-indexing)"</span>
<a name="line-42"></a> <span class='hs-keyword'>where</span>
<a name="line-43"></a> <span class='hs-varid'>n_rule_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>rule_args</span>
<a name="line-44"></a> <span class='hs-varid'>n_mismatches</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>mismatches</span>
<a name="line-45"></a> <span class='hs-varid'>mismatches</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>i</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>rule_arg</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>arg</span><span class='hs-layout'>,</span><span class='hs-varid'>i</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>rule_args</span> <span class='hs-varop'>`zip`</span> <span class='hs-varid'>i_args</span><span class='hs-layout'>,</span>
<a name="line-46"></a> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isJust</span> <span class='hs-layout'>(</span><span class='hs-varid'>match_fn</span> <span class='hs-varid'>rule_arg</span> <span class='hs-varid'>arg</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-47"></a>
<a name="line-48"></a> <span class='hs-varid'>lhs_fvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>exprsFreeVars</span> <span class='hs-varid'>rule_args</span> <span class='hs-comment'>-- Includes template tyvars</span>
<a name="line-49"></a> <span class='hs-varid'>match_fn</span> <span class='hs-varid'>rule_arg</span> <span class='hs-varid'>arg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match</span> <span class='hs-varid'>menv</span> <span class='hs-varid'>emptySubstEnv</span> <span class='hs-varid'>rule_arg</span> <span class='hs-varid'>arg</span>
<a name="line-50"></a> <span class='hs-keyword'>where</span>
<a name="line-51"></a> <span class='hs-varid'>in_scope</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lhs_fvs</span> <span class='hs-varop'>`unionVarSet`</span> <span class='hs-varid'>exprFreeVars</span> <span class='hs-varid'>arg</span>
<a name="line-52"></a> <span class='hs-varid'>menv</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ME</span> <span class='hs-layout'>{</span> <span class='hs-varid'>me_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkRnEnv2</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkInScopeSet</span> <span class='hs-varid'>in_scope</span><span class='hs-layout'>)</span>
<a name="line-53"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>me_tmpls</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVarSet</span> <span class='hs-varid'>rule_bndrs</span> <span class='hs-layout'>}</span>
</pre>\end{code}
</body>
</html>
