<?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>deSugar/Match.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
The @match@ function
\begin{code}
<pre><a name="line-1"></a><span class='hs-comment'>{-# OPTIONS -fno-warn-incomplete-patterns #-}</span>
<a name="line-2"></a><span class='hs-comment'>-- The above warning supression flag is a temporary kludge.</span>
<a name="line-3"></a><span class='hs-comment'>-- While working on this module you are encouraged to remove it and fix</span>
<a name="line-4"></a><span class='hs-comment'>-- any warnings in the module. See</span>
<a name="line-5"></a><span class='hs-comment'>-- <a href="http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings">http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings</a></span>
<a name="line-6"></a><span class='hs-comment'>-- for details</span>
<a name="line-7"></a>
<a name="line-8"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Match</span> <span class='hs-layout'>(</span> <span class='hs-varid'>match</span><span class='hs-layout'>,</span> <span class='hs-varid'>matchEquations</span><span class='hs-layout'>,</span> <span class='hs-varid'>matchWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>matchSimply</span><span class='hs-layout'>,</span> <span class='hs-varid'>matchSinglePat</span> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-9"></a>
<a name="line-10"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-11"></a>
<a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-comment'>{-#SOURCE#-}</span> <span class='hs-conid'>DsExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>dsLExpr</span><span class='hs-layout'>)</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DynFlags</span>
<a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HsSyn</span>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcHsSyn</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Check</span>
<a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreSyn</span>
<a name="line-19"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Literal</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreUtils</span>
<a name="line-21"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>MkCore</span>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DsMonad</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DsBinds</span>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DsGRHSs</span>
<a name="line-25"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DsUtils</span>
<a name="line-26"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Id</span>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DataCon</span>
<a name="line-28"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>MatchCon</span>
<a name="line-29"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>MatchLit</span>
<a name="line-30"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>PrelInfo</span>
<a name="line-31"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Type</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TysWiredIn</span>
<a name="line-33"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ListSetOps</span>
<a name="line-34"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>SrcLoc</span>
<a name="line-35"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Maybes</span>
<a name="line-36"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Util</span>
<a name="line-37"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span>
<a name="line-38"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FiniteMap</span>
<a name="line-39"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-40"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastString</span>
</pre>\end{code}
This function is a wrapper of @match@, it must be called from all the parts where
it was called match, but only substitutes the firs call, ....
if the associated flags are declared, warnings will be issued.
It can not be called matchWrapper because this name already exists :-(
JJCQ 30-Nov-1997
\begin{code}
<pre><a name="line-1"></a><a name="matchCheck"></a><span class='hs-definition'>matchCheck</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DsMatchContext</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Vars rep'ing the exprs we're matching with</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- Type of the case expression</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>EquationInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Info about patterns, etc. (type synonym below)</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>MatchResult</span> <span class='hs-comment'>-- Desugared result!</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-definition'>matchCheck</span> <span class='hs-varid'>ctx</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>qs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-8"></a> <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getDOptsDs</span>
<a name="line-9"></a> <span class='hs-varid'>matchCheck_really</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>ctx</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>qs</span>
<a name="line-10"></a>
<a name="line-11"></a><a name="matchCheck_really"></a><span class='hs-definition'>matchCheck_really</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DynFlags</span>
<a name="line-12"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsMatchContext</span>
<a name="line-13"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span>
<a name="line-14"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span>
<a name="line-15"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>EquationInfo</span><span class='hs-keyglyph'>]</span>
<a name="line-16"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>MatchResult</span>
<a name="line-17"></a><span class='hs-definition'>matchCheck_really</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>ctx</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>qs</span>
<a name="line-18"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>incomplete</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>shadow</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-19"></a> <span class='hs-varid'>dsShadowWarn</span> <span class='hs-varid'>ctx</span> <span class='hs-varid'>eqns_shadow</span>
<a name="line-20"></a> <span class='hs-varid'>dsIncompleteWarn</span> <span class='hs-varid'>ctx</span> <span class='hs-varid'>pats</span>
<a name="line-21"></a> <span class='hs-varid'>match</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>qs</span>
<a name="line-22"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>incomplete</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-23"></a> <span class='hs-varid'>dsIncompleteWarn</span> <span class='hs-varid'>ctx</span> <span class='hs-varid'>pats</span>
<a name="line-24"></a> <span class='hs-varid'>match</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>qs</span>
<a name="line-25"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>shadow</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-26"></a> <span class='hs-varid'>dsShadowWarn</span> <span class='hs-varid'>ctx</span> <span class='hs-varid'>eqns_shadow</span>
<a name="line-27"></a> <span class='hs-varid'>match</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>qs</span>
<a name="line-28"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span>
<a name="line-29"></a> <span class='hs-varid'>match</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>qs</span>
<a name="line-30"></a> <span class='hs-keyword'>where</span> <span class='hs-layout'>(</span><span class='hs-varid'>pats</span><span class='hs-layout'>,</span> <span class='hs-varid'>eqns_shadow</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>check</span> <span class='hs-varid'>qs</span>
<a name="line-31"></a> <span class='hs-varid'>incomplete</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>want_incomplete</span> <span class='hs-varop'>&&</span> <span class='hs-layout'>(</span><span class='hs-varid'>notNull</span> <span class='hs-varid'>pats</span><span class='hs-layout'>)</span>
<a name="line-32"></a> <span class='hs-varid'>want_incomplete</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>ctx</span> <span class='hs-keyword'>of</span>
<a name="line-33"></a> <span class='hs-conid'>DsMatchContext</span> <span class='hs-conid'>RecUpd</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span>
<a name="line-34"></a> <span class='hs-varid'>dopt</span> <span class='hs-conid'>Opt_WarnIncompletePatternsRecUpd</span> <span class='hs-varid'>dflags</span>
<a name="line-35"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span>
<a name="line-36"></a> <span class='hs-varid'>dopt</span> <span class='hs-conid'>Opt_WarnIncompletePatterns</span> <span class='hs-varid'>dflags</span>
<a name="line-37"></a> <span class='hs-varid'>shadow</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dopt</span> <span class='hs-conid'>Opt_WarnOverlappingPatterns</span> <span class='hs-varid'>dflags</span>
<a name="line-38"></a> <span class='hs-varop'>&&</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>eqns_shadow</span><span class='hs-layout'>)</span>
</pre>\end{code}
This variable shows the maximum number of lines of output generated for warnings.
It will limit the number of patterns/equations displayed to@ maximum_output@.
(ToDo: add command-line option?)
\begin{code}
<pre><a name="line-1"></a><a name="maximum_output"></a><span class='hs-definition'>maximum_output</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span>
<a name="line-2"></a><span class='hs-definition'>maximum_output</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>4</span>
</pre>\end{code}
The next two functions create the warning message.
\begin{code}
<pre><a name="line-1"></a><a name="dsShadowWarn"></a><span class='hs-definition'>dsShadowWarn</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DsMatchContext</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>EquationInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>()</span>
<a name="line-2"></a><span class='hs-definition'>dsShadowWarn</span> <span class='hs-varid'>ctx</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>DsMatchContext</span> <span class='hs-varid'>kind</span> <span class='hs-varid'>loc</span><span class='hs-layout'>)</span> <span class='hs-varid'>qs</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>putSrcSpanDs</span> <span class='hs-varid'>loc</span> <span class='hs-layout'>(</span><span class='hs-varid'>warnDs</span> <span class='hs-varid'>warn</span><span class='hs-layout'>)</span>
<a name="line-4"></a> <span class='hs-keyword'>where</span>
<a name="line-5"></a> <span class='hs-varid'>warn</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>qs</span> <span class='hs-varop'>`lengthExceeds`</span> <span class='hs-varid'>maximum_output</span>
<a name="line-6"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pp_context</span> <span class='hs-varid'>ctx</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"are overlapped"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-7"></a> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>vcat</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr_eqn</span> <span class='hs-varid'>f</span> <span class='hs-varid'>kind</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>take</span> <span class='hs-varid'>maximum_output</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>$$</span>
<a name="line-8"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"..."</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-10"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pp_context</span> <span class='hs-varid'>ctx</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"are overlapped"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-11"></a> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>vcat</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr_eqn</span> <span class='hs-varid'>f</span> <span class='hs-varid'>kind</span><span class='hs-layout'>)</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span>
<a name="line-12"></a>
<a name="line-13"></a>
<a name="line-14"></a><a name="dsIncompleteWarn"></a><span class='hs-definition'>dsIncompleteWarn</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DsMatchContext</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>ExhaustivePat</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>()</span>
<a name="line-15"></a><span class='hs-definition'>dsIncompleteWarn</span> <span class='hs-varid'>ctx</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>DsMatchContext</span> <span class='hs-varid'>kind</span> <span class='hs-varid'>loc</span><span class='hs-layout'>)</span> <span class='hs-varid'>pats</span>
<a name="line-16"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>putSrcSpanDs</span> <span class='hs-varid'>loc</span> <span class='hs-layout'>(</span><span class='hs-varid'>warnDs</span> <span class='hs-varid'>warn</span><span class='hs-layout'>)</span>
<a name="line-17"></a> <span class='hs-keyword'>where</span>
<a name="line-18"></a> <span class='hs-varid'>warn</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pp_context</span> <span class='hs-varid'>ctx</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"are non-exhaustive"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-19"></a> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>hang</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Patterns not matched:"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-20"></a> <span class='hs-num'>4</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>vcat</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr_incomplete_pats</span> <span class='hs-varid'>kind</span><span class='hs-layout'>)</span>
<a name="line-21"></a> <span class='hs-layout'>(</span><span class='hs-varid'>take</span> <span class='hs-varid'>maximum_output</span> <span class='hs-varid'>pats</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-22"></a> <span class='hs-varop'>$$</span> <span class='hs-varid'>dots</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-23"></a>
<a name="line-24"></a> <span class='hs-varid'>dots</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>pats</span> <span class='hs-varop'>`lengthExceeds`</span> <span class='hs-varid'>maximum_output</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"..."</span><span class='hs-layout'>)</span>
<a name="line-25"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>empty</span>
<a name="line-26"></a>
<a name="line-27"></a><a name="pp_context"></a><span class='hs-definition'>pp_context</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DsMatchContext</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>SDoc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-28"></a><span class='hs-definition'>pp_context</span> <span class='hs-layout'>(</span><span class='hs-conid'>DsMatchContext</span> <span class='hs-varid'>kind</span> <span class='hs-sel'>_loc</span><span class='hs-layout'>)</span> <span class='hs-varid'>msg</span> <span class='hs-varid'>rest_of_msg_fun</span>
<a name="line-29"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Pattern match(es)"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>msg</span><span class='hs-layout'>,</span>
<a name="line-30"></a> <span class='hs-varid'>sep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"In"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr_match</span> <span class='hs-varop'><></span> <span class='hs-varid'>char</span> <span class='hs-chr'>':'</span><span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>4</span> <span class='hs-layout'>(</span><span class='hs-varid'>rest_of_msg_fun</span> <span class='hs-varid'>pref</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span>
<a name="line-31"></a> <span class='hs-keyword'>where</span>
<a name="line-32"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ppr_match</span><span class='hs-layout'>,</span> <span class='hs-varid'>pref</span><span class='hs-layout'>)</span>
<a name="line-33"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>kind</span> <span class='hs-keyword'>of</span>
<a name="line-34"></a> <span class='hs-conid'>FunRhs</span> <span class='hs-varid'>fun</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>pprMatchContext</span> <span class='hs-varid'>kind</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>pp</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>fun</span> <span class='hs-varop'><+></span> <span class='hs-varid'>pp</span><span class='hs-layout'>)</span>
<a name="line-35"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>pprMatchContext</span> <span class='hs-varid'>kind</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>pp</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pp</span><span class='hs-layout'>)</span>
<a name="line-36"></a>
<a name="line-37"></a><a name="ppr_pats"></a><span class='hs-definition'>ppr_pats</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Outputable</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-38"></a><span class='hs-definition'>ppr_pats</span> <span class='hs-varid'>pats</span> <span class='hs-keyglyph'>=</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'>pats</span><span class='hs-layout'>)</span>
<a name="line-39"></a>
<a name="line-40"></a><a name="ppr_shadow_pats"></a><span class='hs-definition'>ppr_shadow_pats</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HsMatchContext</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Pat</span> <span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-41"></a><span class='hs-definition'>ppr_shadow_pats</span> <span class='hs-varid'>kind</span> <span class='hs-varid'>pats</span>
<a name="line-42"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ppr_pats</span> <span class='hs-varid'>pats</span><span class='hs-layout'>,</span> <span class='hs-varid'>matchSeparator</span> <span class='hs-varid'>kind</span><span class='hs-layout'>,</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"..."</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-43"></a>
<a name="line-44"></a><a name="ppr_incomplete_pats"></a><span class='hs-definition'>ppr_incomplete_pats</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HsMatchContext</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ExhaustivePat</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-45"></a><span class='hs-definition'>ppr_incomplete_pats</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-varid'>pats</span><span class='hs-layout'>,</span><span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr_pats</span> <span class='hs-varid'>pats</span>
<a name="line-46"></a><span class='hs-definition'>ppr_incomplete_pats</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-varid'>pats</span><span class='hs-layout'>,</span><span class='hs-varid'>constraints</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-47"></a> <span class='hs-varid'>sep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ppr_pats</span> <span class='hs-varid'>pats</span><span class='hs-layout'>,</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"with"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-48"></a> <span class='hs-varid'>sep</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>ppr_constraint</span> <span class='hs-varid'>constraints</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-49"></a>
<a name="line-50"></a><a name="ppr_constraint"></a><span class='hs-definition'>ppr_constraint</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Name</span><span class='hs-layout'>,</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>HsLit</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-51"></a><span class='hs-definition'>ppr_constraint</span> <span class='hs-layout'>(</span><span class='hs-varid'>var</span><span class='hs-layout'>,</span><span class='hs-varid'>pats</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>var</span><span class='hs-layout'>,</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"`notElem`"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>pats</span><span class='hs-keyglyph'>]</span>
<a name="line-52"></a>
<a name="line-53"></a><a name="ppr_eqn"></a><span class='hs-definition'>ppr_eqn</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>SDoc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HsMatchContext</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>EquationInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-54"></a><span class='hs-definition'>ppr_eqn</span> <span class='hs-varid'>prefixF</span> <span class='hs-varid'>kind</span> <span class='hs-varid'>eqn</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>prefixF</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr_shadow_pats</span> <span class='hs-varid'>kind</span> <span class='hs-layout'>(</span><span class='hs-varid'>eqn_pats</span> <span class='hs-varid'>eqn</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
The main matching function
%* *
%************************************************************************
The function @match@ is basically the same as in the Wadler chapter,
except it is monadised, to carry around the name supply, info about
annotations, etc.
Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
\begin{enumerate}
\item
A list of $n$ variable names, those variables presumably bound to the
$n$ expressions being matched against the $n$ patterns. Using the
list of $n$ expressions as the first argument showed no benefit and
some inelegance.
\item
The second argument, a list giving the ``equation info'' for each of
the $m$ equations:
\begin{itemize}
\item
the $n$ patterns for that equation, and
\item
a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
the front'' of the matching code, as in:
\begin{verbatim}
let <binds>
in <matching-code>
\end{verbatim}
\item
and finally: (ToDo: fill in)
The right way to think about the ``after-match function'' is that it
is an embryonic @CoreExpr@ with a ``hole'' at the end for the
final ``else expression''.
\end{itemize}
There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
An experiment with re-ordering this information about equations (in
particular, having the patterns available in column-major order)
showed no benefit.
\item
A default expression---what to evaluate if the overall pattern-match
fails. This expression will (almost?) always be
a measly expression @Var@, unless we know it will only be used once
(as we do in @glue_success_exprs@).
Leaving out this third argument to @match@ (and slamming in lots of
@Var "fail"@s) is a positively {\em bad} idea, because it makes it
impossible to share the default expressions. (Also, it stands no
chance of working in our post-upheaval world of @Locals@.)
\end{enumerate}
Note: @match@ is often called via @matchWrapper@ (end of this module),
a function that does much of the house-keeping that goes with a call
to @match@.
It is also worth mentioning the {\em typical} way a block of equations
is desugared with @match@. At each stage, it is the first column of
patterns that is examined. The steps carried out are roughly:
\begin{enumerate}
\item
Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
bindings to the second component of the equation-info):
\begin{itemize}
\item
Remove the `as' patterns from column~1.
\item
Make all constructor patterns in column~1 into @ConPats@, notably
@ListPats@ and @TuplePats@.
\item
Handle any irrefutable (or ``twiddle'') @LazyPats@.
\end{itemize}
\item
Now {\em unmix} the equations into {\em blocks} [w\/ local function
@unmix_eqns@], in which the equations in a block all have variable
patterns in column~1, or they all have constructor patterns in ...
(see ``the mixture rule'' in SLPJ).
\item
Call @matchEqnBlock@ on each block of equations; it will do the
appropriate thing for each kind of column-1 pattern, usually ending up
in a recursive call to @match@.
\end{enumerate}
We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
And gluing the ``success expressions'' together isn't quite so pretty.
This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
(a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
(b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
un}mixes the equations], producing a list of equation-info
blocks, each block having as its first column of patterns either all
constructors, or all variables (or similar beasts), etc.
@match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
corresponds roughly to @matchVarCon@.
\begin{code}
<pre><a name="line-1"></a><a name="match"></a><span class='hs-definition'>match</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Variables rep\'ing the exprs we\'re matching with</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- Type of the case expression</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>EquationInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Info about patterns, etc. (type synonym below)</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>MatchResult</span> <span class='hs-comment'>-- Desugared result!</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-definition'>match</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>eqns</span>
<a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT2</span><span class='hs-layout'>(</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>eqns</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>)</span>
<a name="line-8"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>foldr1</span> <span class='hs-varid'>combineMatchResults</span> <span class='hs-varid'>match_results</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-keyword'>where</span>
<a name="line-10"></a> <span class='hs-varid'>match_results</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span> <span class='hs-varid'>null</span> <span class='hs-layout'>(</span><span class='hs-varid'>eqn_pats</span> <span class='hs-varid'>eqn</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-11"></a> <span class='hs-varid'>eqn_rhs</span> <span class='hs-varid'>eqn</span>
<a name="line-12"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>eqn</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>eqns</span> <span class='hs-keyglyph'>]</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-definition'>match</span> <span class='hs-varid'>vars</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-varid'>v</span><span class='hs-conop'>:</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>eqns</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>eqns</span> <span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- Tidy the first pattern, generating</span>
<a name="line-17"></a> <span class='hs-comment'>-- auxiliary bindings if necessary</span>
<a name="line-18"></a> <span class='hs-layout'>(</span><span class='hs-varid'>aux_binds</span><span class='hs-layout'>,</span> <span class='hs-varid'>tidy_eqns</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapAndUnzipM</span> <span class='hs-layout'>(</span><span class='hs-varid'>tidyEqnInfo</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-varid'>eqns</span>
<a name="line-19"></a>
<a name="line-20"></a> <span class='hs-comment'>-- Group the equations and match each group in turn</span>
<a name="line-21"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>grouped</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>groupEquations</span> <span class='hs-varid'>tidy_eqns</span>
<a name="line-22"></a>
<a name="line-23"></a> <span class='hs-comment'>-- print the view patterns that are commoned up to help debug</span>
<a name="line-24"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>ifOptM</span> <span class='hs-conid'>Opt_D_dump_view_pattern_commoning</span> <span class='hs-layout'>(</span><span class='hs-varid'>debug</span> <span class='hs-varid'>grouped</span><span class='hs-layout'>)</span>
<a name="line-25"></a>
<a name="line-26"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>match_results</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>match_group</span> <span class='hs-varid'>grouped</span>
<a name="line-27"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>adjustMatchResult</span> <span class='hs-layout'>(</span><span class='hs-varid'>foldr1</span> <span class='hs-layout'>(</span><span class='hs-varop'>.</span><span class='hs-layout'>)</span> <span class='hs-varid'>aux_binds</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-28"></a> <span class='hs-varid'>foldr1</span> <span class='hs-varid'>combineMatchResults</span> <span class='hs-varid'>match_results</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-29"></a> <span class='hs-keyword'>where</span>
<a name="line-30"></a> <span class='hs-varid'>dropGroup</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>PatGroup</span><span class='hs-layout'>,</span><span class='hs-conid'>EquationInfo</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'>EquationInfo</span><span class='hs-keyglyph'>]</span>
<a name="line-31"></a> <span class='hs-varid'>dropGroup</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>snd</span>
<a name="line-32"></a>
<a name="line-33"></a> <span class='hs-varid'>match_group</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>PatGroup</span><span class='hs-layout'>,</span><span class='hs-conid'>EquationInfo</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>MatchResult</span>
<a name="line-34"></a> <span class='hs-varid'>match_group</span> <span class='hs-varid'>eqns</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>group</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>
<a name="line-35"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>group</span> <span class='hs-keyword'>of</span>
<a name="line-36"></a> <span class='hs-conid'>PgCon</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>matchConFamily</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>subGroup</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>c</span><span class='hs-layout'>,</span><span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgCon</span> <span class='hs-varid'>c</span><span class='hs-layout'>,</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>eqns</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-37"></a> <span class='hs-conid'>PgLit</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>matchLiterals</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>subGroup</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>l</span><span class='hs-layout'>,</span><span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgLit</span> <span class='hs-varid'>l</span><span class='hs-layout'>,</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>eqns</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-38"></a>
<a name="line-39"></a> <span class='hs-conid'>PgAny</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>matchVariables</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>dropGroup</span> <span class='hs-varid'>eqns</span><span class='hs-layout'>)</span>
<a name="line-40"></a> <span class='hs-conid'>PgN</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>matchNPats</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>dropGroup</span> <span class='hs-varid'>eqns</span><span class='hs-layout'>)</span>
<a name="line-41"></a> <span class='hs-conid'>PgNpK</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>matchNPlusKPats</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>dropGroup</span> <span class='hs-varid'>eqns</span><span class='hs-layout'>)</span>
<a name="line-42"></a> <span class='hs-conid'>PgBang</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>matchBangs</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>dropGroup</span> <span class='hs-varid'>eqns</span><span class='hs-layout'>)</span>
<a name="line-43"></a> <span class='hs-conid'>PgCo</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>matchCoercion</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>dropGroup</span> <span class='hs-varid'>eqns</span><span class='hs-layout'>)</span>
<a name="line-44"></a> <span class='hs-conid'>PgView</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>matchView</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>dropGroup</span> <span class='hs-varid'>eqns</span><span class='hs-layout'>)</span>
<a name="line-45"></a>
<a name="line-46"></a> <span class='hs-comment'>-- FIXME: we should also warn about view patterns that should be</span>
<a name="line-47"></a> <span class='hs-comment'>-- commoned up but are not</span>
<a name="line-48"></a>
<a name="line-49"></a> <span class='hs-comment'>-- print some stuff to see what's getting grouped</span>
<a name="line-50"></a> <span class='hs-comment'>-- use -dppr-debug to see the resolution of overloaded lits</span>
<a name="line-51"></a> <span class='hs-varid'>debug</span> <span class='hs-varid'>eqns</span> <span class='hs-keyglyph'>=</span>
<a name="line-52"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>gs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>group</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-layout'>(</span><span class='hs-varid'>p</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>acc</span> <span class='hs-keyglyph'>-></span>
<a name="line-53"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>p</span> <span class='hs-keyword'>of</span> <span class='hs-conid'>PgView</span> <span class='hs-varid'>e</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>e</span><span class='hs-conop'>:</span><span class='hs-varid'>acc</span>
<a name="line-54"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>acc</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>group</span><span class='hs-layout'>)</span> <span class='hs-varid'>eqns</span>
<a name="line-55"></a> <span class='hs-varid'>maybeWarn</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-56"></a> <span class='hs-varid'>maybeWarn</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>warnDs</span> <span class='hs-layout'>(</span><span class='hs-varid'>vcat</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span>
<a name="line-57"></a> <span class='hs-keyword'>in</span>
<a name="line-58"></a> <span class='hs-varid'>maybeWarn</span> <span class='hs-varop'>$</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>g</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>text</span> <span class='hs-str'>"Putting these view expressions into the same case:"</span> <span class='hs-varop'><+></span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>g</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-59"></a> <span class='hs-layout'>(</span><span class='hs-varid'>filter</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-varop'>.</span> <span class='hs-varid'>null</span><span class='hs-layout'>)</span> <span class='hs-varid'>gs</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-60"></a>
<a name="line-61"></a><a name="matchVariables"></a><span class='hs-definition'>matchVariables</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>EquationInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>MatchResult</span>
<a name="line-62"></a><span class='hs-comment'>-- Real true variables, just like in matchVar, SLPJ p 94</span>
<a name="line-63"></a><span class='hs-comment'>-- No binding to do: they'll all be wildcards by now (done in tidy)</span>
<a name="line-64"></a><span class='hs-definition'>matchVariables</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-conop'>:</span><span class='hs-varid'>vars</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>eqns</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>shiftEqns</span> <span class='hs-varid'>eqns</span><span class='hs-layout'>)</span>
<a name="line-65"></a>
<a name="line-66"></a><a name="matchBangs"></a><span class='hs-definition'>matchBangs</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>EquationInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>MatchResult</span>
<a name="line-67"></a><span class='hs-definition'>matchBangs</span> <span class='hs-layout'>(</span><span class='hs-varid'>var</span><span class='hs-conop'>:</span><span class='hs-varid'>vars</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>eqns</span>
<a name="line-68"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>match_result</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>match</span> <span class='hs-layout'>(</span><span class='hs-varid'>var</span><span class='hs-conop'>:</span><span class='hs-varid'>vars</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>decomposeFirst_Bang</span> <span class='hs-varid'>eqns</span><span class='hs-layout'>)</span>
<a name="line-69"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkEvalMatchResult</span> <span class='hs-varid'>var</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>match_result</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-70"></a>
<a name="line-71"></a><a name="matchCoercion"></a><span class='hs-definition'>matchCoercion</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>EquationInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>MatchResult</span>
<a name="line-72"></a><span class='hs-comment'>-- Apply the coercion to the match variable and then match that</span>
<a name="line-73"></a><span class='hs-definition'>matchCoercion</span> <span class='hs-layout'>(</span><span class='hs-varid'>var</span><span class='hs-conop'>:</span><span class='hs-varid'>vars</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>eqns</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-varid'>eqn1</span><span class='hs-conop'>:</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-74"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-keyword'>let</span> <span class='hs-conid'>CoPat</span> <span class='hs-varid'>co</span> <span class='hs-varid'>pat</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>firstPat</span> <span class='hs-varid'>eqn1</span>
<a name="line-75"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>var'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newUniqueId</span> <span class='hs-layout'>(</span><span class='hs-varid'>idName</span> <span class='hs-varid'>var</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>hsPatType</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-76"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>match_result</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>match</span> <span class='hs-layout'>(</span><span class='hs-varid'>var'</span><span class='hs-conop'>:</span><span class='hs-varid'>vars</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>decomposeFirst_Coercion</span> <span class='hs-varid'>eqns</span><span class='hs-layout'>)</span>
<a name="line-77"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>rhs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsCoercion</span> <span class='hs-varid'>co</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>var</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-78"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkCoLetMatchResult</span> <span class='hs-layout'>(</span><span class='hs-conid'>NonRec</span> <span class='hs-varid'>var'</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span> <span class='hs-varid'>match_result</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-79"></a>
<a name="line-80"></a><a name="matchView"></a><span class='hs-definition'>matchView</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>EquationInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>MatchResult</span>
<a name="line-81"></a><span class='hs-comment'>-- Apply the view function to the match variable and then match that</span>
<a name="line-82"></a><span class='hs-definition'>matchView</span> <span class='hs-layout'>(</span><span class='hs-varid'>var</span><span class='hs-conop'>:</span><span class='hs-varid'>vars</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>eqns</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-varid'>eqn1</span><span class='hs-conop'>:</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-83"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- we could pass in the expr from the PgView,</span>
<a name="line-84"></a> <span class='hs-comment'>-- but this needs to extract the pat anyway </span>
<a name="line-85"></a> <span class='hs-comment'>-- to figure out the type of the fresh variable</span>
<a name="line-86"></a> <span class='hs-keyword'>let</span> <span class='hs-conid'>ViewPat</span> <span class='hs-varid'>viewExpr</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>firstPat</span> <span class='hs-varid'>eqn1</span>
<a name="line-87"></a> <span class='hs-comment'>-- do the rest of the compilation </span>
<a name="line-88"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>var'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newUniqueId</span> <span class='hs-layout'>(</span><span class='hs-varid'>idName</span> <span class='hs-varid'>var</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>hsPatType</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-89"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>match_result</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>match</span> <span class='hs-layout'>(</span><span class='hs-varid'>var'</span><span class='hs-conop'>:</span><span class='hs-varid'>vars</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>decomposeFirst_View</span> <span class='hs-varid'>eqns</span><span class='hs-layout'>)</span>
<a name="line-90"></a> <span class='hs-comment'>-- compile the view expressions</span>
<a name="line-91"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>viewExpr'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>viewExpr</span>
<a name="line-92"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkViewMatchResult</span> <span class='hs-varid'>var'</span> <span class='hs-varid'>viewExpr'</span> <span class='hs-varid'>var</span> <span class='hs-varid'>match_result</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-93"></a>
<a name="line-94"></a><a name="decomposeFirstPat"></a><span class='hs-comment'>-- decompose the first pattern and leave the rest alone</span>
<a name="line-95"></a><span class='hs-definition'>decomposeFirstPat</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Pat</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Pat</span> <span class='hs-conid'>Id</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>EquationInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>EquationInfo</span>
<a name="line-96"></a><span class='hs-definition'>decomposeFirstPat</span> <span class='hs-varid'>extractpat</span> <span class='hs-layout'>(</span><span class='hs-varid'>eqn</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>EqnInfo</span> <span class='hs-layout'>{</span> <span class='hs-varid'>eqn_pats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pat</span> <span class='hs-conop'>:</span> <span class='hs-varid'>pats</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-97"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eqn</span> <span class='hs-layout'>{</span> <span class='hs-varid'>eqn_pats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extractpat</span> <span class='hs-varid'>pat</span> <span class='hs-conop'>:</span> <span class='hs-varid'>pats</span><span class='hs-layout'>}</span>
<a name="line-98"></a>
<a name="line-99"></a><a name="decomposeFirst_Coercion"></a><span class='hs-definition'>decomposeFirst_Coercion</span><span class='hs-layout'>,</span> <span class='hs-varid'>decomposeFirst_Bang</span><span class='hs-layout'>,</span> <span class='hs-varid'>decomposeFirst_View</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>EquationInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>EquationInfo</span>
<a name="line-100"></a>
<a name="line-101"></a><span class='hs-definition'>decomposeFirst_Coercion</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>decomposeFirstPat</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoPat</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>pat</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-102"></a><a name="decomposeFirst_Bang"></a><span class='hs-definition'>decomposeFirst_Bang</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>decomposeFirstPat</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-varid'>pat</span> <span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unLoc</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-103"></a><a name="decomposeFirst_View"></a><span class='hs-definition'>decomposeFirst_View</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>decomposeFirstPat</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-layout'>(</span><span class='hs-conid'>ViewPat</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>pat</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unLoc</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-104"></a>
</pre>\end{code}
%************************************************************************
%* *
Tidying patterns
%* *
%************************************************************************
Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
which will be scrutinised. This means:
\begin{itemize}
\item
Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
together with the binding @x = v@.
\item
Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
\item
Removing lazy (irrefutable) patterns (you don't want to know...).
\item
Converting explicit tuple-, list-, and parallel-array-pats into ordinary
@ConPats@.
\item
Convert the literal pat "" to [].
\end{itemize}
The result of this tidying is that the column of patterns will include
{\em only}:
\begin{description}
\item[@WildPats@:]
The @VarPat@ information isn't needed any more after this.
\item[@ConPats@:]
@ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
\item[@LitPats@ and @NPats@:]
@LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
Float, Double, at least) are converted to unboxed form; e.g.,
\tr{(NPat (HsInt i) _ _)} is converted to:
\begin{verbatim}
(ConPat I# _ _ [LitPat (HsIntPrim i)])
\end{verbatim}
\end{description}
\begin{code}
<pre><a name="line-1"></a><a name="tidyEqnInfo"></a><span class='hs-definition'>tidyEqnInfo</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>EquationInfo</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-layout'>(</span><span class='hs-conid'>DsWrapper</span><span class='hs-layout'>,</span> <span class='hs-conid'>EquationInfo</span><span class='hs-layout'>)</span>
<a name="line-3"></a> <span class='hs-comment'>-- DsM'd because of internal call to dsLHsBinds</span>
<a name="line-4"></a> <span class='hs-comment'>-- and mkSelectorBinds.</span>
<a name="line-5"></a> <span class='hs-comment'>-- "tidy1" does the interesting stuff, looking at</span>
<a name="line-6"></a> <span class='hs-comment'>-- one pattern and fiddling the list of bindings.</span>
<a name="line-7"></a> <span class='hs-comment'>--</span>
<a name="line-8"></a> <span class='hs-comment'>-- POST CONDITION: head pattern in the EqnInfo is</span>
<a name="line-9"></a> <span class='hs-comment'>-- WildPat</span>
<a name="line-10"></a> <span class='hs-comment'>-- ConPat</span>
<a name="line-11"></a> <span class='hs-comment'>-- NPat</span>
<a name="line-12"></a> <span class='hs-comment'>-- LitPat</span>
<a name="line-13"></a> <span class='hs-comment'>-- NPlusKPat</span>
<a name="line-14"></a> <span class='hs-comment'>-- but no other</span>
<a name="line-15"></a>
<a name="line-16"></a><span class='hs-definition'>tidyEqnInfo</span> <span class='hs-varid'>v</span> <span class='hs-varid'>eqn</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>EqnInfo</span> <span class='hs-layout'>{</span> <span class='hs-varid'>eqn_pats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pat</span> <span class='hs-conop'>:</span> <span class='hs-varid'>pats</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-17"></a> <span class='hs-layout'>(</span><span class='hs-varid'>wrap</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-varid'>pat</span>
<a name="line-18"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>wrap</span><span class='hs-layout'>,</span> <span class='hs-varid'>eqn</span> <span class='hs-layout'>{</span> <span class='hs-varid'>eqn_pats</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>pat'</span> <span class='hs-conop'>:</span> <span class='hs-varid'>pats</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-19"></a>
<a name="line-20"></a><a name="tidy1"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- The Id being scrutinised</span>
<a name="line-21"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Pat</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- The pattern against which it is to be matched</span>
<a name="line-22"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-layout'>(</span><span class='hs-conid'>DsWrapper</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Extra bindings to do before the match</span>
<a name="line-23"></a> <span class='hs-conid'>Pat</span> <span class='hs-conid'>Id</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Equivalent pattern</span>
<a name="line-24"></a>
<a name="line-25"></a><span class='hs-comment'>-------------------------------------------------------</span>
<a name="line-26"></a><span class='hs-comment'>-- (pat', mr') = tidy1 v pat mr</span>
<a name="line-27"></a><span class='hs-comment'>-- tidies the *outer level only* of pat, giving pat'</span>
<a name="line-28"></a><span class='hs-comment'>-- It eliminates many pattern forms (as-patterns, variable patterns,</span>
<a name="line-29"></a><span class='hs-comment'>-- list patterns, etc) yielding one of:</span>
<a name="line-30"></a><span class='hs-comment'>-- WildPat</span>
<a name="line-31"></a><span class='hs-comment'>-- ConPatOut</span>
<a name="line-32"></a><span class='hs-comment'>-- LitPat</span>
<a name="line-33"></a><span class='hs-comment'>-- NPat</span>
<a name="line-34"></a><span class='hs-comment'>-- NPlusKPat</span>
<a name="line-35"></a>
<a name="line-36"></a><span class='hs-definition'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>ParPat</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-37"></a><span class='hs-definition'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>SigPatOut</span> <span class='hs-varid'>pat</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-38"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>WildPat</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-conid'>WildPat</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-39"></a>
<a name="line-40"></a> <span class='hs-comment'>-- case v of { x -> mr[] }</span>
<a name="line-41"></a> <span class='hs-comment'>-- = case v of { _ -> let x=v in mr[] }</span>
<a name="line-42"></a><span class='hs-definition'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>VarPat</span> <span class='hs-varid'>var</span><span class='hs-layout'>)</span>
<a name="line-43"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>wrapBind</span> <span class='hs-varid'>var</span> <span class='hs-varid'>v</span><span class='hs-layout'>,</span> <span class='hs-conid'>WildPat</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>var</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-44"></a>
<a name="line-45"></a><span class='hs-definition'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>VarPatOut</span> <span class='hs-varid'>var</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span>
<a name="line-46"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>prs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLHsBinds</span> <span class='hs-varid'>binds</span>
<a name="line-47"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>wrapBind</span> <span class='hs-varid'>var</span> <span class='hs-varid'>v</span> <span class='hs-varop'>.</span> <span class='hs-varid'>mkCoreLet</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-layout'>,</span>
<a name="line-48"></a> <span class='hs-conid'>WildPat</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>var</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-49"></a>
<a name="line-50"></a> <span class='hs-comment'>-- case v of { x@p -> mr[] }</span>
<a name="line-51"></a> <span class='hs-comment'>-- = case v of { p -> let x=v in mr[] }</span>
<a name="line-52"></a><span class='hs-definition'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>AsPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>var</span><span class='hs-layout'>)</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-53"></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'>wrap</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-54"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>wrapBind</span> <span class='hs-varid'>var</span> <span class='hs-varid'>v</span> <span class='hs-varop'>.</span> <span class='hs-varid'>wrap</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-55"></a>
<a name="line-56"></a><span class='hs-comment'>{- now, here we handle lazy patterns:
<a name="line-57"></a> tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
<a name="line-58"></a> v2 = case v of p -> v2 : ... : bs )
<a name="line-59"></a>
<a name="line-60"></a> where the v_i's are the binders in the pattern.
<a name="line-61"></a>
<a name="line-62"></a> ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
<a name="line-63"></a>
<a name="line-64"></a> The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
<a name="line-65"></a>-}</span>
<a name="line-66"></a>
<a name="line-67"></a><span class='hs-definition'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>LazyPat</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-68"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>sel_prs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mkSelectorBinds</span> <span class='hs-varid'>pat</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span>
<a name="line-69"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>sel_binds</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>NonRec</span> <span class='hs-varid'>b</span> <span class='hs-varid'>rhs</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span><span class='hs-varid'>rhs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>sel_prs</span><span class='hs-keyglyph'>]</span>
<a name="line-70"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkCoreLets</span> <span class='hs-varid'>sel_binds</span><span class='hs-layout'>,</span> <span class='hs-conid'>WildPat</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-71"></a>
<a name="line-72"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>ListPat</span> <span class='hs-varid'>pats</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-73"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>unLoc</span> <span class='hs-varid'>list_ConPat</span><span class='hs-layout'>)</span>
<a name="line-74"></a> <span class='hs-keyword'>where</span>
<a name="line-75"></a> <span class='hs-varid'>list_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkListTy</span> <span class='hs-varid'>ty</span>
<a name="line-76"></a> <span class='hs-varid'>list_ConPat</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mkPrefixConPat</span> <span class='hs-varid'>consDataCon</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span> <span class='hs-varid'>y</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>list_ty</span><span class='hs-layout'>)</span>
<a name="line-77"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkNilPat</span> <span class='hs-varid'>list_ty</span><span class='hs-layout'>)</span>
<a name="line-78"></a> <span class='hs-varid'>pats</span>
<a name="line-79"></a>
<a name="line-80"></a><span class='hs-comment'>-- Introduce fake parallel array constructors to be able to handle parallel</span>
<a name="line-81"></a><span class='hs-comment'>-- arrays with the existing machinery for constructor pattern</span>
<a name="line-82"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>PArrPat</span> <span class='hs-varid'>pats</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-83"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>unLoc</span> <span class='hs-varid'>parrConPat</span><span class='hs-layout'>)</span>
<a name="line-84"></a> <span class='hs-keyword'>where</span>
<a name="line-85"></a> <span class='hs-varid'>arity</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>pats</span>
<a name="line-86"></a> <span class='hs-varid'>parrConPat</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkPrefixConPat</span> <span class='hs-layout'>(</span><span class='hs-varid'>parrFakeCon</span> <span class='hs-varid'>arity</span><span class='hs-layout'>)</span> <span class='hs-varid'>pats</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkPArrTy</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-87"></a>
<a name="line-88"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>TuplePat</span> <span class='hs-varid'>pats</span> <span class='hs-varid'>boxity</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-89"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>unLoc</span> <span class='hs-varid'>tuple_ConPat</span><span class='hs-layout'>)</span>
<a name="line-90"></a> <span class='hs-keyword'>where</span>
<a name="line-91"></a> <span class='hs-varid'>arity</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>pats</span>
<a name="line-92"></a> <span class='hs-varid'>tuple_ConPat</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkPrefixConPat</span> <span class='hs-layout'>(</span><span class='hs-varid'>tupleCon</span> <span class='hs-varid'>boxity</span> <span class='hs-varid'>arity</span><span class='hs-layout'>)</span> <span class='hs-varid'>pats</span> <span class='hs-varid'>ty</span>
<a name="line-93"></a>
<a name="line-94"></a><span class='hs-comment'>-- LitPats: we *might* be able to replace these w/ a simpler form</span>
<a name="line-95"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>LitPat</span> <span class='hs-varid'>lit</span><span class='hs-layout'>)</span>
<a name="line-96"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>tidyLitPat</span> <span class='hs-varid'>lit</span><span class='hs-layout'>)</span>
<a name="line-97"></a>
<a name="line-98"></a><span class='hs-comment'>-- NPats: we *might* be able to replace these w/ a simpler form</span>
<a name="line-99"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>NPat</span> <span class='hs-varid'>lit</span> <span class='hs-varid'>mb_neg</span> <span class='hs-varid'>eq</span><span class='hs-layout'>)</span>
<a name="line-100"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>tidyNPat</span> <span class='hs-varid'>lit</span> <span class='hs-varid'>mb_neg</span> <span class='hs-varid'>eq</span><span class='hs-layout'>)</span>
<a name="line-101"></a>
<a name="line-102"></a><span class='hs-comment'>-- BangPatterns: Pattern matching is already strict in constructors,</span>
<a name="line-103"></a><span class='hs-comment'>-- tuples etc, so the last case strips off the bang for thoses patterns.</span>
<a name="line-104"></a><span class='hs-definition'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>LazyPat</span> <span class='hs-varid'>p</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'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span>
<a name="line-105"></a><span class='hs-definition'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>ParPat</span> <span class='hs-varid'>p</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'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span>
<a name="line-106"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>p</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span><span class='hs-layout'>(</span><span class='hs-conid'>VarPat</span> <span class='hs-keyword'>_</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'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span>
<a name="line-107"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>p</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span><span class='hs-layout'>(</span><span class='hs-conid'>VarPatOut</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</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'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span>
<a name="line-108"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>p</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>WildPat</span> <span class='hs-keyword'>_</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'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span>
<a name="line-109"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>p</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoPat</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</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'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span>
<a name="line-110"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>p</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>SigPatIn</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</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'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span>
<a name="line-111"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>p</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>SigPatOut</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</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'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span>
<a name="line-112"></a><span class='hs-definition'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>AsPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>var</span><span class='hs-layout'>)</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-113"></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'>wrap</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-114"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>wrapBind</span> <span class='hs-varid'>var</span> <span class='hs-varid'>v</span> <span class='hs-varop'>.</span> <span class='hs-varid'>wrap</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-115"></a><span class='hs-definition'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-conid'>BangPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tidy1</span> <span class='hs-varid'>v</span> <span class='hs-varid'>p</span>
<a name="line-116"></a>
<a name="line-117"></a><span class='hs-comment'>-- Everything else goes through unchanged...</span>
<a name="line-118"></a>
<a name="line-119"></a><span class='hs-definition'>tidy1</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>non_interesting_pat</span>
<a name="line-120"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>idDsWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>non_interesting_pat</span><span class='hs-layout'>)</span>
</pre>\end{code}
\noindent
{\bf Previous @matchTwiddled@ stuff:}
Now we get to the only interesting part; note: there are choices for
translation [from Simon's notes]; translation~1:
\begin{verbatim}
deTwiddle [s,t] e
\end{verbatim}
returns
\begin{verbatim}
[ w = e,
s = case w of [s,t] -> s
t = case w of [s,t] -> t
]
\end{verbatim}
Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
evaluation of \tr{e}. An alternative translation (No.~2):
\begin{verbatim}
[ w = case e of [s,t] -> (s,t)
s = case w of (s,t) -> s
t = case w of (s,t) -> t
]
\end{verbatim}
%************************************************************************
%* *
\subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
%* *
%************************************************************************
We might be able to optimise unmixing when confronted by
only-one-constructor-possible, of which tuples are the most notable
examples. Consider:
\begin{verbatim}
f (a,b,c) ... = ...
f d ... (e:f) = ...
f (g,h,i) ... = ...
f j ... = ...
\end{verbatim}
This definition would normally be unmixed into four equation blocks,
one per equation. But it could be unmixed into just one equation
block, because if the one equation matches (on the first column),
the others certainly will.
You have to be careful, though; the example
\begin{verbatim}
f j ... = ...
-------------------
f (a,b,c) ... = ...
f d ... (e:f) = ...
f (g,h,i) ... = ...
\end{verbatim}
{\em must} be broken into two blocks at the line shown; otherwise, you
are forcing unnecessary evaluation. In any case, the top-left pattern
always gives the cue. You could then unmix blocks into groups of...
\begin{description}
\item[all variables:]
As it is now.
\item[constructors or variables (mixed):]
Need to make sure the right names get bound for the variable patterns.
\item[literals or variables (mixed):]
Presumably just a variant on the constructor case (as it is now).
\end{description}
%************************************************************************
%* *
%* matchWrapper: a convenient way to call @match@ *
%* *
%************************************************************************
\subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
Calls to @match@ often involve similar (non-trivial) work; that work
is collected here, in @matchWrapper@. This function takes as
arguments:
\begin{itemize}
\item
Typchecked @Matches@ (of a function definition, or a case or lambda
expression)---the main input;
\item
An error message to be inserted into any (runtime) pattern-matching
failure messages.
\end{itemize}
As results, @matchWrapper@ produces:
\begin{itemize}
\item
A list of variables (@Locals@) that the caller must ``promise'' to
bind to appropriate values; and
\item
a @CoreExpr@, the desugared output (main result).
\end{itemize}
The main actions of @matchWrapper@ include:
\begin{enumerate}
\item
Flatten the @[TypecheckedMatch]@ into a suitable list of
@EquationInfo@s.
\item
Create as many new variables as there are patterns in a pattern-list
(in any one of the @EquationInfo@s).
\item
Create a suitable ``if it fails'' expression---a call to @error@ using
the error-string input; the {\em type} of this fail value can be found
by examining one of the RHS expressions in one of the @EquationInfo@s.
\item
Call @match@ with all of this information!
\end{enumerate}
\begin{code}
<pre><a name="line-1"></a><a name="matchWrapper"></a><span class='hs-definition'>matchWrapper</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HsMatchContext</span> <span class='hs-conid'>Name</span> <span class='hs-comment'>-- For shadowing warning messages</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MatchGroup</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Matches being desugared</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</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-layout'>,</span> <span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Results</span>
</pre>\end{code}
There is one small problem with the Lambda Patterns, when somebody
writes something similar to:
\begin{verbatim}
(\ (x:xs) -> ...)
\end{verbatim}
he/she don't want a warning about incomplete patterns, that is done with
the flag @opt_WarnSimplePatterns@.
This problem also appears in the:
\begin{itemize}
\item @do@ patterns, but if the @do@ can fail
it creates another equation if the match can fail
(see @DsExpr.doDo@ function)
\item @let@ patterns, are treated by @matchSimply@
List Comprension Patterns, are treated by @matchSimply@ also
\end{itemize}
We can't call @matchSimply@ with Lambda patterns,
due to the fact that lambda patterns can have more than
one pattern, and match simply only accepts one pattern.
JJQC 30-Nov-1997
\begin{code}
<pre><a name="line-1"></a><a name="matchWrapper"></a><span class='hs-definition'>matchWrapper</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-conid'>MatchGroup</span> <span class='hs-varid'>matches</span> <span class='hs-varid'>match_ty</span><span class='hs-layout'>)</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span> <span class='hs-varid'>notNull</span> <span class='hs-varid'>matches</span> <span class='hs-layout'>)</span>
<a name="line-3"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>eqns_info</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>mk_eqn_info</span> <span class='hs-varid'>matches</span>
<a name="line-4"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>new_vars</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>selectMatchVars</span> <span class='hs-varid'>arg_pats</span>
<a name="line-5"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>result_expr</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>matchEquations</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>new_vars</span> <span class='hs-varid'>eqns_info</span> <span class='hs-varid'>rhs_ty</span>
<a name="line-6"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>new_vars</span><span class='hs-layout'>,</span> <span class='hs-varid'>result_expr</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-7"></a> <span class='hs-keyword'>where</span>
<a name="line-8"></a> <span class='hs-varid'>arg_pats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>unLoc</span> <span class='hs-layout'>(</span><span class='hs-varid'>hsLMatchPats</span> <span class='hs-layout'>(</span><span class='hs-varid'>head</span> <span class='hs-varid'>matches</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-varid'>n_pats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>arg_pats</span>
<a name="line-10"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitFunTysN</span> <span class='hs-varid'>n_pats</span> <span class='hs-varid'>match_ty</span>
<a name="line-11"></a>
<a name="line-12"></a> <span class='hs-varid'>mk_eqn_info</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>Match</span> <span class='hs-varid'>pats</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>grhss</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-13"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>upats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>unLoc</span> <span class='hs-varid'>pats</span>
<a name="line-14"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>match_result</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsGRHSs</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>upats</span> <span class='hs-varid'>grhss</span> <span class='hs-varid'>rhs_ty</span>
<a name="line-15"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>EqnInfo</span> <span class='hs-layout'>{</span> <span class='hs-varid'>eqn_pats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>upats</span><span class='hs-layout'>,</span> <span class='hs-varid'>eqn_rhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match_result</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-16"></a>
<a name="line-17"></a>
<a name="line-18"></a><a name="matchEquations"></a><span class='hs-definition'>matchEquations</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HsMatchContext</span> <span class='hs-conid'>Name</span>
<a name="line-19"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>EquationInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span>
<a name="line-20"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-21"></a><span class='hs-definition'>matchEquations</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>eqns_info</span> <span class='hs-varid'>rhs_ty</span>
<a name="line-22"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getDOptsDs</span>
<a name="line-23"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>locn</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getSrcSpanDs</span>
<a name="line-24"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>ds_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>DsMatchContext</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>locn</span>
<a name="line-25"></a> <span class='hs-varid'>error_doc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>matchContextErrString</span> <span class='hs-varid'>ctxt</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>match_result</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>match_fun</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>ds_ctxt</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-varid'>eqns_info</span>
<a name="line-28"></a>
<a name="line-29"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>fail_expr</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mkErrorAppDs</span> <span class='hs-varid'>pAT_ERROR_ID</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-varid'>error_doc</span>
<a name="line-30"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>extractMatchResult</span> <span class='hs-varid'>match_result</span> <span class='hs-varid'>fail_expr</span> <span class='hs-layout'>}</span>
<a name="line-31"></a> <span class='hs-keyword'>where</span>
<a name="line-32"></a> <span class='hs-varid'>match_fun</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>ds_ctxt</span>
<a name="line-33"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>ctxt</span> <span class='hs-keyword'>of</span>
<a name="line-34"></a> <span class='hs-conid'>LambdaExpr</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>dopt</span> <span class='hs-conid'>Opt_WarnSimplePatterns</span> <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>matchCheck</span> <span class='hs-varid'>ds_ctxt</span>
<a name="line-35"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>match</span>
<a name="line-36"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>matchCheck</span> <span class='hs-varid'>ds_ctxt</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
%* *
%************************************************************************
@mkSimpleMatch@ is a wrapper for @match@ which deals with the
situation where we want to match a single expression against a single
pattern. It returns an expression.
\begin{code}
<pre><a name="line-1"></a><a name="matchSimply"></a><span class='hs-definition'>matchSimply</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Scrutinee</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HsMatchContext</span> <span class='hs-conid'>Name</span> <span class='hs-comment'>-- Match kind</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LPat</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Pattern it should match</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Return this if it matches</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Return this if it doesn't</span>
<a name="line-6"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-7"></a>
<a name="line-8"></a><span class='hs-definition'>matchSimply</span> <span class='hs-varid'>scrut</span> <span class='hs-varid'>hs_ctx</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>result_expr</span> <span class='hs-varid'>fail_expr</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-9"></a> <span class='hs-keyword'>let</span>
<a name="line-10"></a> <span class='hs-varid'>match_result</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cantFailMatchResult</span> <span class='hs-varid'>result_expr</span>
<a name="line-11"></a> <span class='hs-varid'>rhs_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>exprType</span> <span class='hs-varid'>fail_expr</span>
<a name="line-12"></a> <span class='hs-comment'>-- Use exprType of fail_expr, because won't refine in the case of failure!</span>
<a name="line-13"></a> <span class='hs-varid'>match_result'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>matchSinglePat</span> <span class='hs-varid'>scrut</span> <span class='hs-varid'>hs_ctx</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-varid'>match_result</span>
<a name="line-14"></a> <span class='hs-varid'>extractMatchResult</span> <span class='hs-varid'>match_result'</span> <span class='hs-varid'>fail_expr</span>
<a name="line-15"></a>
<a name="line-16"></a>
<a name="line-17"></a><a name="matchSinglePat"></a><span class='hs-definition'>matchSinglePat</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HsMatchContext</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LPat</span> <span class='hs-conid'>Id</span>
<a name="line-18"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MatchResult</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>MatchResult</span>
<a name="line-19"></a><span class='hs-definition'>matchSinglePat</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>var</span><span class='hs-layout'>)</span> <span class='hs-varid'>hs_ctx</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>match_result</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-20"></a> <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getDOptsDs</span>
<a name="line-21"></a> <span class='hs-varid'>locn</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getSrcSpanDs</span>
<a name="line-22"></a> <span class='hs-keyword'>let</span>
<a name="line-23"></a> <span class='hs-varid'>match_fn</span> <span class='hs-varid'>dflags</span>
<a name="line-24"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>dopt</span> <span class='hs-conid'>Opt_WarnSimplePatterns</span> <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>matchCheck</span> <span class='hs-varid'>ds_ctx</span>
<a name="line-25"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match</span>
<a name="line-26"></a> <span class='hs-keyword'>where</span>
<a name="line-27"></a> <span class='hs-varid'>ds_ctx</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>DsMatchContext</span> <span class='hs-varid'>hs_ctx</span> <span class='hs-varid'>locn</span>
<a name="line-28"></a> <span class='hs-varid'>match_fn</span> <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>var</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>EqnInfo</span> <span class='hs-layout'>{</span> <span class='hs-varid'>eqn_pats</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>pat</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-varid'>eqn_rhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>match_result</span> <span class='hs-layout'>}</span><span class='hs-keyglyph'>]</span>
<a name="line-29"></a>
<a name="line-30"></a><span class='hs-definition'>matchSinglePat</span> <span class='hs-varid'>scrut</span> <span class='hs-varid'>hs_ctx</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>match_result</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-31"></a> <span class='hs-varid'>var</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>selectSimpleMatchVarL</span> <span class='hs-varid'>pat</span>
<a name="line-32"></a> <span class='hs-varid'>match_result'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>matchSinglePat</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>var</span><span class='hs-layout'>)</span> <span class='hs-varid'>hs_ctx</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>match_result</span>
<a name="line-33"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>adjustMatchResult</span> <span class='hs-layout'>(</span><span class='hs-varid'>bindNonRec</span> <span class='hs-varid'>var</span> <span class='hs-varid'>scrut</span><span class='hs-layout'>)</span> <span class='hs-varid'>match_result'</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
Pattern classification
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="PatGroup"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>PatGroup</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PgAny</span> <span class='hs-comment'>-- Immediate match: variables, wildcards, </span>
<a name="line-3"></a> <span class='hs-comment'>-- lazy patterns</span>
<a name="line-4"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>PgCon</span> <span class='hs-conid'>DataCon</span> <span class='hs-comment'>-- Constructor patterns (incl list, tuple)</span>
<a name="line-5"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>PgLit</span> <span class='hs-conid'>Literal</span> <span class='hs-comment'>-- Literal patterns</span>
<a name="line-6"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>PgN</span> <span class='hs-conid'>Literal</span> <span class='hs-comment'>-- Overloaded literals</span>
<a name="line-7"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>PgNpK</span> <span class='hs-conid'>Literal</span> <span class='hs-comment'>-- n+k patterns</span>
<a name="line-8"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>PgBang</span> <span class='hs-comment'>-- Bang patterns</span>
<a name="line-9"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>PgCo</span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- Coercion patterns; the type is the type</span>
<a name="line-10"></a> <span class='hs-comment'>-- of the pattern *inside*</span>
<a name="line-11"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>PgView</span> <span class='hs-layout'>(</span><span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Id</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- view pattern (e -> p):</span>
<a name="line-12"></a> <span class='hs-comment'>-- the LHsExpr is the expression e</span>
<a name="line-13"></a> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- the Type is the type of p (equivalently, the result type of e)</span>
<a name="line-14"></a>
<a name="line-15"></a><a name="groupEquations"></a><span class='hs-definition'>groupEquations</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>EquationInfo</span><span class='hs-keyglyph'>]</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'>PatGroup</span><span class='hs-layout'>,</span> <span class='hs-conid'>EquationInfo</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span>
<a name="line-16"></a><span class='hs-comment'>-- If the result is of form [g1, g2, g3], </span>
<a name="line-17"></a><span class='hs-comment'>-- (a) all the (pg,eq) pairs in g1 have the same pg</span>
<a name="line-18"></a><span class='hs-comment'>-- (b) none of the gi are empty</span>
<a name="line-19"></a><span class='hs-comment'>-- The ordering of equations is unchanged</span>
<a name="line-20"></a><span class='hs-definition'>groupEquations</span> <span class='hs-varid'>eqns</span>
<a name="line-21"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>runs</span> <span class='hs-varid'>same_gp</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>patGroup</span> <span class='hs-layout'>(</span><span class='hs-varid'>firstPat</span> <span class='hs-varid'>eqn</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>eqn</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>eqn</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>eqns</span><span class='hs-keyglyph'>]</span>
<a name="line-22"></a> <span class='hs-keyword'>where</span>
<a name="line-23"></a> <span class='hs-varid'>same_gp</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>PatGroup</span><span class='hs-layout'>,</span><span class='hs-conid'>EquationInfo</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>PatGroup</span><span class='hs-layout'>,</span><span class='hs-conid'>EquationInfo</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-24"></a> <span class='hs-layout'>(</span><span class='hs-varid'>pg1</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varop'>`same_gp`</span> <span class='hs-layout'>(</span><span class='hs-varid'>pg2</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'>pg1</span> <span class='hs-varop'>`sameGroup`</span> <span class='hs-varid'>pg2</span>
<a name="line-25"></a>
<a name="line-26"></a><a name="subGroup"></a><span class='hs-definition'>subGroup</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Ord</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>EquationInfo</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>EquationInfo</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span>
<a name="line-27"></a><span class='hs-comment'>-- Input is a particular group. The result sub-groups the </span>
<a name="line-28"></a><span class='hs-comment'>-- equations by with particular constructor, literal etc they match.</span>
<a name="line-29"></a><span class='hs-comment'>-- Each sub-list in the result has the same PatGroup</span>
<a name="line-30"></a><span class='hs-comment'>-- See Note [Take care with pattern order]</span>
<a name="line-31"></a><span class='hs-definition'>subGroup</span> <span class='hs-varid'>group</span>
<a name="line-32"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>reverse</span> <span class='hs-varop'>$</span> <span class='hs-varid'>eltsFM</span> <span class='hs-varop'>$</span> <span class='hs-varid'>foldl</span> <span class='hs-varid'>accumulate</span> <span class='hs-varid'>emptyFM</span> <span class='hs-varid'>group</span>
<a name="line-33"></a> <span class='hs-keyword'>where</span>
<a name="line-34"></a> <span class='hs-varid'>accumulate</span> <span class='hs-varid'>pg_map</span> <span class='hs-layout'>(</span><span class='hs-varid'>pg</span><span class='hs-layout'>,</span> <span class='hs-varid'>eqn</span><span class='hs-layout'>)</span>
<a name="line-35"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupFM</span> <span class='hs-varid'>pg_map</span> <span class='hs-varid'>pg</span> <span class='hs-keyword'>of</span>
<a name="line-36"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>eqns</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>addToFM</span> <span class='hs-varid'>pg_map</span> <span class='hs-varid'>pg</span> <span class='hs-layout'>(</span><span class='hs-varid'>eqn</span><span class='hs-conop'>:</span><span class='hs-varid'>eqns</span><span class='hs-layout'>)</span>
<a name="line-37"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>addToFM</span> <span class='hs-varid'>pg_map</span> <span class='hs-varid'>pg</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>eqn</span><span class='hs-keyglyph'>]</span>
<a name="line-38"></a>
<a name="line-39"></a> <span class='hs-comment'>-- pg_map :: FiniteMap a [EquationInfo]</span>
<a name="line-40"></a> <span class='hs-comment'>-- Equations seen so far in reverse order of appearance</span>
</pre>\end{code}
Note [Take care with pattern order]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In the subGroup function we must be very careful about pattern re-ordering,
Consider the patterns [ (True, Nothing), (False, x), (True, y) ]
Then in bringing together the patterns for True, we must not
swap the Nothing and y!
\begin{code}
<pre><a name="line-1"></a><a name="sameGroup"></a><span class='hs-definition'>sameGroup</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>PatGroup</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PatGroup</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-2"></a><span class='hs-comment'>-- Same group means that a single case expression </span>
<a name="line-3"></a><span class='hs-comment'>-- or test will suffice to match both, *and* the order</span>
<a name="line-4"></a><span class='hs-comment'>-- of testing within the group is insignificant.</span>
<a name="line-5"></a><span class='hs-definition'>sameGroup</span> <span class='hs-conid'>PgAny</span> <span class='hs-conid'>PgAny</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-6"></a><span class='hs-definition'>sameGroup</span> <span class='hs-conid'>PgBang</span> <span class='hs-conid'>PgBang</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-7"></a><span class='hs-definition'>sameGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgCon</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgCon</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span> <span class='hs-comment'>-- One case expression</span>
<a name="line-8"></a><span class='hs-definition'>sameGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgLit</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgLit</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span> <span class='hs-comment'>-- One case expression</span>
<a name="line-9"></a><span class='hs-definition'>sameGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgN</span> <span class='hs-varid'>l1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgN</span> <span class='hs-varid'>l2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>l1</span><span class='hs-varop'>==</span><span class='hs-varid'>l2</span> <span class='hs-comment'>-- Order is significant</span>
<a name="line-10"></a><span class='hs-definition'>sameGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgNpK</span> <span class='hs-varid'>l1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgNpK</span> <span class='hs-varid'>l2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>l1</span><span class='hs-varop'>==</span><span class='hs-varid'>l2</span> <span class='hs-comment'>-- See Note [Grouping overloaded literal patterns]</span>
<a name="line-11"></a><span class='hs-definition'>sameGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgCo</span> <span class='hs-varid'>t1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgCo</span> <span class='hs-varid'>t2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>t1</span> <span class='hs-varop'>`coreEqType`</span> <span class='hs-varid'>t2</span>
<a name="line-12"></a> <span class='hs-comment'>-- CoPats are in the same goup only if the type of the</span>
<a name="line-13"></a> <span class='hs-comment'>-- enclosed pattern is the same. The patterns outside the CoPat</span>
<a name="line-14"></a> <span class='hs-comment'>-- always have the same type, so this boils down to saying that</span>
<a name="line-15"></a> <span class='hs-comment'>-- the two coercions are identical.</span>
<a name="line-16"></a><span class='hs-definition'>sameGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgView</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>t1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>PgView</span> <span class='hs-varid'>e2</span> <span class='hs-varid'>t2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>viewLExprEq</span> <span class='hs-layout'>(</span><span class='hs-varid'>e1</span><span class='hs-layout'>,</span><span class='hs-varid'>t1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>e2</span><span class='hs-layout'>,</span><span class='hs-varid'>t2</span><span class='hs-layout'>)</span>
<a name="line-17"></a> <span class='hs-comment'>-- ViewPats are in the same gorup iff the expressions</span>
<a name="line-18"></a> <span class='hs-comment'>-- are "equal"---conservatively, we use syntactic equality</span>
<a name="line-19"></a><span class='hs-definition'>sameGroup</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-20"></a>
<a name="line-21"></a><a name="viewLExprEq"></a><span class='hs-comment'>-- An approximation of syntactic equality used for determining when view</span>
<a name="line-22"></a><span class='hs-comment'>-- exprs are in the same group.</span>
<a name="line-23"></a><span class='hs-comment'>-- This function can always safely return false;</span>
<a name="line-24"></a><span class='hs-comment'>-- but doing so will result in the application of the view function being repeated.</span>
<a name="line-25"></a><span class='hs-comment'>--</span>
<a name="line-26"></a><span class='hs-comment'>-- Currently: compare applications of literals and variables</span>
<a name="line-27"></a><span class='hs-comment'>-- and anything else that we can do without involving other</span>
<a name="line-28"></a><span class='hs-comment'>-- HsSyn types in the recursion</span>
<a name="line-29"></a><span class='hs-comment'>--</span>
<a name="line-30"></a><span class='hs-comment'>-- NB we can't assume that the two view expressions have the same type. Consider</span>
<a name="line-31"></a><span class='hs-comment'>-- f (e1 -> True) = ...</span>
<a name="line-32"></a><span class='hs-comment'>-- f (e2 -> "hi") = ...</span>
<a name="line-33"></a><span class='hs-definition'>viewLExprEq</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Id</span><span class='hs-layout'>,</span><span class='hs-conid'>Type</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Id</span><span class='hs-layout'>,</span><span class='hs-conid'>Type</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-34"></a><span class='hs-definition'>viewLExprEq</span> <span class='hs-layout'>(</span><span class='hs-varid'>e1</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'>e2</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-35"></a> <span class='hs-keyword'>let</span>
<a name="line-36"></a> <span class='hs-comment'>-- short name for recursive call on unLoc</span>
<a name="line-37"></a> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e</span> <span class='hs-varid'>e'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-varid'>e'</span><span class='hs-layout'>)</span>
<a name="line-38"></a>
<a name="line-39"></a> <span class='hs-varid'>eq_list</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>-></span><span class='hs-varid'>a</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-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-40"></a> <span class='hs-varid'>eq_list</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-41"></a> <span class='hs-varid'>eq_list</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-conop'>:</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-42"></a> <span class='hs-varid'>eq_list</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-conop'>:</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-43"></a> <span class='hs-varid'>eq_list</span> <span class='hs-varid'>eq</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-conop'>:</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>y</span><span class='hs-conop'>:</span><span class='hs-varid'>ys</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eq</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>eq_list</span> <span class='hs-varid'>eq</span> <span class='hs-varid'>xs</span> <span class='hs-varid'>ys</span>
<a name="line-44"></a>
<a name="line-45"></a> <span class='hs-comment'>-- conservative, in that it demands that wrappers be</span>
<a name="line-46"></a> <span class='hs-comment'>-- syntactically identical and doesn't look under binders</span>
<a name="line-47"></a> <span class='hs-comment'>--</span>
<a name="line-48"></a> <span class='hs-comment'>-- coarser notions of equality are possible</span>
<a name="line-49"></a> <span class='hs-comment'>-- (e.g., reassociating compositions,</span>
<a name="line-50"></a> <span class='hs-comment'>-- equating different ways of writing a coercion)</span>
<a name="line-51"></a> <span class='hs-varid'>wrap</span> <span class='hs-conid'>WpHole</span> <span class='hs-conid'>WpHole</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-52"></a> <span class='hs-varid'>wrap</span> <span class='hs-layout'>(</span><span class='hs-conid'>WpCompose</span> <span class='hs-varid'>w1</span> <span class='hs-varid'>w2</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>WpCompose</span> <span class='hs-varid'>w1'</span> <span class='hs-varid'>w2'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>wrap</span> <span class='hs-varid'>w1</span> <span class='hs-varid'>w1'</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>wrap</span> <span class='hs-varid'>w2</span> <span class='hs-varid'>w2'</span>
<a name="line-53"></a> <span class='hs-varid'>wrap</span> <span class='hs-layout'>(</span><span class='hs-conid'>WpCast</span> <span class='hs-varid'>c</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>WpCast</span> <span class='hs-varid'>c'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcEqType</span> <span class='hs-varid'>c</span> <span class='hs-varid'>c'</span>
<a name="line-54"></a> <span class='hs-varid'>wrap</span> <span class='hs-layout'>(</span><span class='hs-conid'>WpApp</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>WpApp</span> <span class='hs-varid'>d'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>d</span> <span class='hs-varop'>==</span> <span class='hs-varid'>d'</span>
<a name="line-55"></a> <span class='hs-varid'>wrap</span> <span class='hs-layout'>(</span><span class='hs-conid'>WpTyApp</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>WpTyApp</span> <span class='hs-varid'>t'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcEqType</span> <span class='hs-varid'>t</span> <span class='hs-varid'>t'</span>
<a name="line-56"></a> <span class='hs-comment'>-- Enhancement: could implement equality for more wrappers</span>
<a name="line-57"></a> <span class='hs-comment'>-- if it seems useful (lams and lets)</span>
<a name="line-58"></a> <span class='hs-varid'>wrap</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-59"></a>
<a name="line-60"></a> <span class='hs-comment'>-- real comparison is on HsExpr's</span>
<a name="line-61"></a> <span class='hs-comment'>-- strip parens </span>
<a name="line-62"></a> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsPar</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>e'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>exp</span> <span class='hs-varid'>e</span> <span class='hs-varid'>e'</span>
<a name="line-63"></a> <span class='hs-varid'>exp</span> <span class='hs-varid'>e</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsPar</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>e'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>exp</span> <span class='hs-varid'>e</span> <span class='hs-varid'>e'</span>
<a name="line-64"></a> <span class='hs-comment'>-- because the expressions do not necessarily have the same type,</span>
<a name="line-65"></a> <span class='hs-comment'>-- we have to compare the wrappers</span>
<a name="line-66"></a> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsWrap</span> <span class='hs-varid'>h</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsWrap</span> <span class='hs-varid'>h'</span> <span class='hs-varid'>e'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>wrap</span> <span class='hs-varid'>h</span> <span class='hs-varid'>h'</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>exp</span> <span class='hs-varid'>e</span> <span class='hs-varid'>e'</span>
<a name="line-67"></a> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsVar</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsVar</span> <span class='hs-varid'>i'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>i</span> <span class='hs-varop'>==</span> <span class='hs-varid'>i'</span>
<a name="line-68"></a> <span class='hs-comment'>-- the instance for IPName derives using the id, so this works if the</span>
<a name="line-69"></a> <span class='hs-comment'>-- above does</span>
<a name="line-70"></a> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsIPVar</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsIPVar</span> <span class='hs-varid'>i'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>i</span> <span class='hs-varop'>==</span> <span class='hs-varid'>i'</span>
<a name="line-71"></a> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsOverLit</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsOverLit</span> <span class='hs-varid'>l'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-72"></a> <span class='hs-comment'>-- Overloaded lits are equal if they have the same type</span>
<a name="line-73"></a> <span class='hs-comment'>-- and the data is the same.</span>
<a name="line-74"></a> <span class='hs-comment'>-- this is coarser than comparing the SyntaxExpr's in l and l',</span>
<a name="line-75"></a> <span class='hs-comment'>-- which resolve the overloading (e.g., fromInteger 1),</span>
<a name="line-76"></a> <span class='hs-comment'>-- because these expressions get written as a bunch of different variables</span>
<a name="line-77"></a> <span class='hs-comment'>-- (presumably to improve sharing)</span>
<a name="line-78"></a> <span class='hs-varid'>tcEqType</span> <span class='hs-layout'>(</span><span class='hs-varid'>overLitType</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>overLitType</span> <span class='hs-varid'>l'</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>l</span> <span class='hs-varop'>==</span> <span class='hs-varid'>l'</span>
<a name="line-79"></a> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsApp</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsApp</span> <span class='hs-varid'>e1'</span> <span class='hs-varid'>e2'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e1'</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e2</span> <span class='hs-varid'>e2'</span>
<a name="line-80"></a> <span class='hs-comment'>-- the fixities have been straightened out by now, so it's safe</span>
<a name="line-81"></a> <span class='hs-comment'>-- to ignore them?</span>
<a name="line-82"></a> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-conid'>OpApp</span> <span class='hs-varid'>l</span> <span class='hs-varid'>o</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>ri</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>OpApp</span> <span class='hs-varid'>l'</span> <span class='hs-varid'>o'</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>ri'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-83"></a> <span class='hs-varid'>lexp</span> <span class='hs-varid'>l</span> <span class='hs-varid'>l'</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>lexp</span> <span class='hs-varid'>o</span> <span class='hs-varid'>o'</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>lexp</span> <span class='hs-varid'>ri</span> <span class='hs-varid'>ri'</span>
<a name="line-84"></a> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-conid'>NegApp</span> <span class='hs-varid'>e</span> <span class='hs-varid'>n</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>NegApp</span> <span class='hs-varid'>e'</span> <span class='hs-varid'>n'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e</span> <span class='hs-varid'>e'</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>exp</span> <span class='hs-varid'>n</span> <span class='hs-varid'>n'</span>
<a name="line-85"></a> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-conid'>SectionL</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>SectionL</span> <span class='hs-varid'>e1'</span> <span class='hs-varid'>e2'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-86"></a> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e1'</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e2</span> <span class='hs-varid'>e2'</span>
<a name="line-87"></a> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-conid'>SectionR</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>SectionR</span> <span class='hs-varid'>e1'</span> <span class='hs-varid'>e2'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-88"></a> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e1'</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e2</span> <span class='hs-varid'>e2'</span>
<a name="line-89"></a> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExplicitTuple</span> <span class='hs-varid'>es1</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExplicitTuple</span> <span class='hs-varid'>es2</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-90"></a> <span class='hs-varid'>eq_list</span> <span class='hs-varid'>tup_arg</span> <span class='hs-varid'>es1</span> <span class='hs-varid'>es2</span>
<a name="line-91"></a> <span class='hs-varid'>exp</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsIf</span> <span class='hs-varid'>e</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsIf</span> <span class='hs-varid'>e'</span> <span class='hs-varid'>e1'</span> <span class='hs-varid'>e2'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-92"></a> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e</span> <span class='hs-varid'>e'</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e1'</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e2</span> <span class='hs-varid'>e2'</span>
<a name="line-93"></a>
<a name="line-94"></a> <span class='hs-comment'>-- Enhancement: could implement equality for more expressions</span>
<a name="line-95"></a> <span class='hs-comment'>-- if it seems useful</span>
<a name="line-96"></a> <span class='hs-comment'>-- But no need for HsLit, ExplicitList, ExplicitTuple, </span>
<a name="line-97"></a> <span class='hs-comment'>-- because they cannot be functions</span>
<a name="line-98"></a> <span class='hs-varid'>exp</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-99"></a>
<a name="line-100"></a> <span class='hs-varid'>tup_arg</span> <span class='hs-layout'>(</span><span class='hs-conid'>Present</span> <span class='hs-varid'>e1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Present</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span>
<a name="line-101"></a> <span class='hs-varid'>tup_arg</span> <span class='hs-layout'>(</span><span class='hs-conid'>Missing</span> <span class='hs-varid'>t1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Missing</span> <span class='hs-varid'>t2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcEqType</span> <span class='hs-varid'>t1</span> <span class='hs-varid'>t2</span>
<a name="line-102"></a> <span class='hs-varid'>tup_arg</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-103"></a> <span class='hs-keyword'>in</span>
<a name="line-104"></a> <span class='hs-varid'>lexp</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>e2</span>
<a name="line-105"></a>
<a name="line-106"></a><a name="patGroup"></a><span class='hs-definition'>patGroup</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Pat</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PatGroup</span>
<a name="line-107"></a><span class='hs-definition'>patGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>WildPat</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'>PgAny</span>
<a name="line-108"></a><span class='hs-definition'>patGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>BangPat</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'>PgBang</span>
<a name="line-109"></a><span class='hs-definition'>patGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>ConPatOut</span> <span class='hs-layout'>{</span> <span class='hs-varid'>pat_con</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dc</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PgCon</span> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span>
<a name="line-110"></a><span class='hs-definition'>patGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>LitPat</span> <span class='hs-varid'>lit</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PgLit</span> <span class='hs-layout'>(</span><span class='hs-varid'>hsLitKey</span> <span class='hs-varid'>lit</span><span class='hs-layout'>)</span>
<a name="line-111"></a><span class='hs-definition'>patGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>NPat</span> <span class='hs-varid'>olit</span> <span class='hs-varid'>mb_neg</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PgN</span> <span class='hs-layout'>(</span><span class='hs-varid'>hsOverLitKey</span> <span class='hs-varid'>olit</span> <span class='hs-layout'>(</span><span class='hs-varid'>isJust</span> <span class='hs-varid'>mb_neg</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-112"></a><span class='hs-definition'>patGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>NPlusKPat</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>olit</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PgNpK</span> <span class='hs-layout'>(</span><span class='hs-varid'>hsOverLitKey</span> <span class='hs-varid'>olit</span> <span class='hs-conid'>False</span><span class='hs-layout'>)</span>
<a name="line-113"></a><span class='hs-definition'>patGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoPat</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>p</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PgCo</span> <span class='hs-layout'>(</span><span class='hs-varid'>hsPatType</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Type of innelexp pattern</span>
<a name="line-114"></a><span class='hs-definition'>patGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>ViewPat</span> <span class='hs-varid'>expr</span> <span class='hs-varid'>p</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PgView</span> <span class='hs-varid'>expr</span> <span class='hs-layout'>(</span><span class='hs-varid'>hsPatType</span> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-115"></a><span class='hs-definition'>patGroup</span> <span class='hs-varid'>pat</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"patGroup"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
</pre>\end{code}
Note [Grouping overloaded literal patterns]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
WATCH OUT! Consider
f (n+1) = ...
f (n+2) = ...
f (n+1) = ...
We can't group the first and third together, because the second may match
the same thing as the first. Same goes for *overloaded* literal patterns
f 1 True = ...
f 2 False = ...
f 1 False = ...
If the first arg matches '1' but the second does not match 'True', we
cannot jump to the third equation! Because the same argument might
match '2'!
Hence we don't regard 1 and 2, or (n+1) and (n+2), as part of the same group.
</body>
</html>
