<?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://code.haskell.org/~malcolm/hscolour/ -->
<title>src/full/Agda/TypeChecking/With.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>{-# LANGUAGE CPP #-}</span>
<a name="line-2"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>TypeChecking</span><span class='hs-varop'>.</span><span class='hs-conid'>With</span> <span class='hs-keyword'>where</span>
<a name="line-3"></a>
<a name="line-4"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Applicative</span>
<a name="line-5"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>
<a name="line-6"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span>
<a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Traversable</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>T</span> <span class='hs-layout'>(</span><span class='hs-varid'>mapM</span><span class='hs-layout'>)</span>
<a name="line-8"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span>
<a name="line-9"></a>
<a name="line-10"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>Syntax</span><span class='hs-varop'>.</span><span class='hs-conid'>Common</span>
<a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>Syntax</span><span class='hs-varop'>.</span><span class='hs-conid'>Internal</span>
<a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>Syntax</span><span class='hs-varop'>.</span><span class='hs-conid'>Abstract</span> <span class='hs-layout'>(</span><span class='hs-conid'>LHS</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>RHS</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>Syntax</span><span class='hs-varop'>.</span><span class='hs-conid'>Abstract</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>A</span>
<a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>Syntax</span><span class='hs-varop'>.</span><span class='hs-conid'>Position</span>
<a name="line-15"></a>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>TypeChecking</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>TypeChecking</span><span class='hs-varop'>.</span><span class='hs-conid'>Substitute</span>
<a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>TypeChecking</span><span class='hs-varop'>.</span><span class='hs-conid'>Reduce</span>
<a name="line-19"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>TypeChecking</span><span class='hs-varop'>.</span><span class='hs-conid'>Primitive</span> <span class='hs-varid'>hiding</span> <span class='hs-layout'>(</span><span class='hs-conid'>Nat</span><span class='hs-layout'>)</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>TypeChecking</span><span class='hs-varop'>.</span><span class='hs-conid'>Pretty</span>
<a name="line-21"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>TypeChecking</span><span class='hs-varop'>.</span><span class='hs-conid'>Rules</span><span class='hs-varop'>.</span><span class='hs-conid'>LHS</span><span class='hs-varop'>.</span><span class='hs-conid'>Implicit</span>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>TypeChecking</span><span class='hs-varop'>.</span><span class='hs-conid'>Rules</span><span class='hs-varop'>.</span><span class='hs-conid'>LHS</span><span class='hs-varop'>.</span><span class='hs-conid'>Split</span> <span class='hs-layout'>(</span><span class='hs-varid'>expandLitPattern</span><span class='hs-layout'>)</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>TypeChecking</span><span class='hs-varop'>.</span><span class='hs-conid'>Abstract</span>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>TypeChecking</span><span class='hs-varop'>.</span><span class='hs-conid'>EtaContract</span>
<a name="line-25"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>TypeChecking</span><span class='hs-varop'>.</span><span class='hs-conid'>Telescope</span>
<a name="line-26"></a>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span>
<a name="line-28"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span><span class='hs-varop'>.</span><span class='hs-conid'>Permutation</span>
<a name="line-29"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span><span class='hs-varop'>.</span><span class='hs-conid'>Size</span>
<a name="line-30"></a>
<a name="line-31"></a><span class='hs-cpp'>#include "../undefined.h"</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Agda</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span><span class='hs-varop'>.</span><span class='hs-conid'>Impossible</span>
<a name="line-33"></a>
<a name="line-34"></a><a name="showPat"></a><span class='hs-definition'>showPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>VarP</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-varid'>x</span>
<a name="line-35"></a><span class='hs-definition'>showPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>DotP</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>comma</span> <span class='hs-varop'><></span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>showsPrec</span> <span class='hs-num'>10</span> <span class='hs-varid'>t</span> <span class='hs-str'>""</span><span class='hs-layout'>)</span>
<a name="line-36"></a><span class='hs-definition'>showPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>ConP</span> <span class='hs-varid'>c</span> <span class='hs-conid'>Nothing</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parens</span> <span class='hs-varop'>$</span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>c</span> <span class='hs-varop'><+></span> <span class='hs-varid'>fsep</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>showPat</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unArg</span><span class='hs-layout'>)</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span>
<a name="line-37"></a><span class='hs-definition'>showPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>ConP</span> <span class='hs-varid'>c</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parens</span> <span class='hs-varop'>$</span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>c</span> <span class='hs-varop'><+></span> <span class='hs-varid'>fsep</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>showPat</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unArg</span><span class='hs-layout'>)</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-str'>":"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>t</span>
<a name="line-38"></a><span class='hs-definition'>showPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>LitP</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>show</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span>
<a name="line-39"></a>
<a name="line-40"></a><a name="withFunctionType"></a><span class='hs-definition'>withFunctionType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Telescope</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Term</span><span class='hs-keyglyph'>]</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'>Telescope</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TCM</span> <span class='hs-conid'>Type</span>
<a name="line-41"></a><span class='hs-definition'>withFunctionType</span> <span class='hs-varid'>delta1</span> <span class='hs-varid'>vs</span> <span class='hs-keyword'>as</span> <span class='hs-varid'>delta2</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>{-dontEtaContractImplicit $-}</span> <span class='hs-keyword'>do</span>
<a name="line-42"></a> <span class='hs-layout'>(</span><span class='hs-varid'>vas</span><span class='hs-layout'>,</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>addCtxTel</span> <span class='hs-varid'>delta1</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-43"></a> <span class='hs-varid'>vs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>etaContract</span> <span class='hs-varop'>=<<</span> <span class='hs-varid'>normalise</span> <span class='hs-varid'>vs</span>
<a name="line-44"></a> <span class='hs-keyword'>as</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>etaContract</span> <span class='hs-varop'>=<<</span> <span class='hs-varid'>normalise</span> <span class='hs-keyword'>as</span>
<a name="line-45"></a> <span class='hs-varid'>b</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>etaContract</span> <span class='hs-varop'>=<<</span> <span class='hs-varid'>normalise</span> <span class='hs-layout'>(</span><span class='hs-varid'>telePi_</span> <span class='hs-varid'>delta2</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span>
<a name="line-46"></a> <span class='hs-varid'>reportSDoc</span> <span class='hs-str'>"tc.with.abstract"</span> <span class='hs-num'>40</span> <span class='hs-varop'>$</span>
<a name="line-47"></a> <span class='hs-varid'>sep</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>text</span> <span class='hs-str'>"abstracting"</span>
<a name="line-48"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>vcat</span> <span class='hs-varop'>$</span>
<a name="line-49"></a> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>text</span> <span class='hs-str'>"vs = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>vs</span>
<a name="line-50"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"as = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyTCM</span> <span class='hs-keyword'>as</span>
<a name="line-51"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"b = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>]</span>
<a name="line-52"></a> <span class='hs-keyglyph'>]</span>
<a name="line-53"></a> <span class='hs-varid'>reportSLn</span> <span class='hs-str'>"tc.with.abstract"</span> <span class='hs-num'>50</span> <span class='hs-varop'>$</span> <span class='hs-str'>" raw vs = "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-varid'>vs</span> <span class='hs-varop'>++</span> <span class='hs-str'>"\n raw b = "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-varid'>b</span>
<a name="line-54"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>zip</span> <span class='hs-varid'>vs</span> <span class='hs-keyword'>as</span><span class='hs-layout'>,</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span>
<a name="line-55"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>telePi_</span> <span class='hs-varid'>delta1</span> <span class='hs-varop'>$</span> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-varid'>uncurry</span> <span class='hs-varid'>piAbstractTerm</span><span class='hs-layout'>)</span> <span class='hs-varid'>b</span> <span class='hs-varid'>vas</span>
<a name="line-56"></a>
<a name="line-57"></a><a name="buildWithFunction"></a><span class='hs-comment'>-- | Compute the clauses for the with-function given the original patterns.</span>
<a name="line-58"></a><span class='hs-definition'>buildWithFunction</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>QName</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Telescope</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Arg</span> <span class='hs-conid'>Pattern</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Permutation</span> <span class='hs-keyglyph'>-></span>
<a name="line-59"></a> <span class='hs-conid'>Nat</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Nat</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>Clause</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TCM</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>Clause</span><span class='hs-keyglyph'>]</span>
<a name="line-60"></a><span class='hs-definition'>buildWithFunction</span> <span class='hs-varid'>aux</span> <span class='hs-varid'>gamma</span> <span class='hs-varid'>qs</span> <span class='hs-varid'>perm</span> <span class='hs-varid'>n1</span> <span class='hs-varid'>n</span> <span class='hs-varid'>cs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>buildWithClause</span> <span class='hs-varid'>cs</span>
<a name="line-61"></a> <span class='hs-keyword'>where</span>
<a name="line-62"></a> <span class='hs-varid'>buildWithClause</span> <span class='hs-layout'>(</span><span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>Clause</span> <span class='hs-layout'>(</span><span class='hs-conid'>LHS</span> <span class='hs-varid'>i</span> <span class='hs-layout'>(</span><span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>LHSProj</span><span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-varid'>wps</span><span class='hs-layout'>)</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>wh</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-63"></a> <span class='hs-varid'>typeError</span> <span class='hs-varop'>$</span> <span class='hs-conid'>NotImplemented</span> <span class='hs-str'>"with clauses for definitions by copatterns"</span>
<a name="line-64"></a> <span class='hs-varid'>buildWithClause</span> <span class='hs-layout'>(</span><span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>Clause</span> <span class='hs-layout'>(</span><span class='hs-conid'>LHS</span> <span class='hs-varid'>i</span> <span class='hs-layout'>(</span><span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>LHSHead</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-varid'>wps</span><span class='hs-layout'>)</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>wh</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-65"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>wps0</span><span class='hs-layout'>,</span> <span class='hs-varid'>wps1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>genericSplitAt</span> <span class='hs-varid'>n</span> <span class='hs-varid'>wps</span>
<a name="line-66"></a> <span class='hs-varid'>ps0</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>defaultNamedArg</span> <span class='hs-varid'>wps0</span>
<a name="line-67"></a> <span class='hs-varid'>rhs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>buildRHS</span> <span class='hs-varid'>rhs</span>
<a name="line-68"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ps1</span><span class='hs-layout'>,</span> <span class='hs-varid'>ps2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>genericSplitAt</span> <span class='hs-varid'>n1</span> <span class='hs-varop'><$></span> <span class='hs-varid'>stripWithClausePatterns</span> <span class='hs-varid'>gamma</span> <span class='hs-varid'>qs</span> <span class='hs-varid'>perm</span> <span class='hs-varid'>ps</span>
<a name="line-69"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>result</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>Clause</span> <span class='hs-layout'>(</span><span class='hs-conid'>LHS</span> <span class='hs-varid'>i</span> <span class='hs-layout'>(</span><span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>LHSHead</span> <span class='hs-varid'>aux</span> <span class='hs-layout'>(</span><span class='hs-varid'>ps1</span> <span class='hs-varop'>++</span> <span class='hs-varid'>ps0</span> <span class='hs-varop'>++</span> <span class='hs-varid'>ps2</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>wps1</span><span class='hs-layout'>)</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>wh</span>
<a name="line-70"></a> <span class='hs-varid'>reportSDoc</span> <span class='hs-str'>"tc.with"</span> <span class='hs-num'>20</span> <span class='hs-varop'>$</span> <span class='hs-varid'>vcat</span>
<a name="line-71"></a> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>text</span> <span class='hs-str'>"buildWithClause returns"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyA</span> <span class='hs-varid'>result</span>
<a name="line-72"></a> <span class='hs-keyglyph'>]</span>
<a name="line-73"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>result</span>
<a name="line-74"></a>
<a name="line-75"></a> <span class='hs-varid'>buildRHS</span> <span class='hs-varid'>rhs</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>RHS</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varid'>rhs</span>
<a name="line-76"></a> <span class='hs-varid'>buildRHS</span> <span class='hs-varid'>rhs</span><span class='hs-keyglyph'>@</span><span class='hs-conid'>AbsurdRHS</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varid'>rhs</span>
<a name="line-77"></a> <span class='hs-varid'>buildRHS</span> <span class='hs-layout'>(</span><span class='hs-conid'>WithRHS</span> <span class='hs-varid'>q</span> <span class='hs-varid'>es</span> <span class='hs-varid'>cs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>WithRHS</span> <span class='hs-varid'>q</span> <span class='hs-varid'>es</span> <span class='hs-varop'><$></span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>buildWithClause</span> <span class='hs-varid'>cs</span>
<a name="line-78"></a> <span class='hs-varid'>buildRHS</span> <span class='hs-layout'>(</span><span class='hs-conid'>RewriteRHS</span> <span class='hs-varid'>q</span> <span class='hs-varid'>eqs</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>wh</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>flip</span> <span class='hs-layout'>(</span><span class='hs-conid'>RewriteRHS</span> <span class='hs-varid'>q</span> <span class='hs-varid'>eqs</span><span class='hs-layout'>)</span> <span class='hs-varid'>wh</span> <span class='hs-varop'><$></span> <span class='hs-varid'>buildRHS</span> <span class='hs-varid'>rhs</span>
<a name="line-79"></a>
<a name="line-80"></a><a name="stripWithClausePatterns"></a><span class='hs-comment'>{-| @stripWithClausePatterns Γ qs π ps = ps'@
<a name="line-81"></a>
<a name="line-82"></a> @Δ@ - context bound by lhs of original function (not an argument)
<a name="line-83"></a>
<a name="line-84"></a> @Γ@ - type of arguments to original function
<a name="line-85"></a>
<a name="line-86"></a> @qs@ - internal patterns for original function
<a name="line-87"></a>
<a name="line-88"></a> @π@ - permutation taking @vars(qs)@ to @support(Δ)@
<a name="line-89"></a>
<a name="line-90"></a> @ps@ - patterns in with clause (presumably of type @Γ@)
<a name="line-91"></a>
<a name="line-92"></a> @ps'@ - patterns for with function (presumably of type @Δ@)
<a name="line-93"></a>-}</span>
<a name="line-94"></a><span class='hs-definition'>stripWithClausePatterns</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Telescope</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Arg</span> <span class='hs-conid'>Pattern</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Permutation</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>NamedArg</span> <span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>Pattern</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TCM</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>NamedArg</span> <span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>Pattern</span><span class='hs-keyglyph'>]</span>
<a name="line-95"></a><span class='hs-definition'>stripWithClausePatterns</span> <span class='hs-varid'>gamma</span> <span class='hs-varid'>qs</span> <span class='hs-varid'>perm</span> <span class='hs-varid'>ps</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-96"></a> <span class='hs-varid'>psi</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>insertImplicitPatterns</span> <span class='hs-conid'>ExpandLast</span> <span class='hs-varid'>ps</span> <span class='hs-varid'>gamma</span>
<a name="line-97"></a> <span class='hs-varid'>unless</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>psi</span> <span class='hs-varop'>==</span> <span class='hs-varid'>size</span> <span class='hs-varid'>gamma</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>fail</span> <span class='hs-varop'>$</span> <span class='hs-str'>"wrong number of arguments in with clause: given "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>psi</span><span class='hs-layout'>)</span> <span class='hs-varop'>++</span> <span class='hs-str'>", expected "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>gamma</span><span class='hs-layout'>)</span>
<a name="line-98"></a> <span class='hs-varid'>reportSDoc</span> <span class='hs-str'>"tc.with.strip"</span> <span class='hs-num'>10</span> <span class='hs-varop'>$</span> <span class='hs-varid'>vcat</span>
<a name="line-99"></a> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>text</span> <span class='hs-str'>"stripping patterns"</span>
<a name="line-100"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>text</span> <span class='hs-str'>"gamma = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>gamma</span>
<a name="line-101"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>text</span> <span class='hs-str'>"psi = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>fsep</span> <span class='hs-layout'>(</span><span class='hs-varid'>punctuate</span> <span class='hs-varid'>comma</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-varid'>prettyA</span> <span class='hs-varid'>psi</span><span class='hs-layout'>)</span>
<a name="line-102"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>text</span> <span class='hs-str'>"qs = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>fsep</span> <span class='hs-layout'>(</span><span class='hs-varid'>punctuate</span> <span class='hs-varid'>comma</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>showPat</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unArg</span><span class='hs-layout'>)</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span>
<a name="line-103"></a> <span class='hs-keyglyph'>]</span>
<a name="line-104"></a> <span class='hs-varid'>ps'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>strip</span> <span class='hs-varid'>gamma</span> <span class='hs-varid'>psi</span> <span class='hs-varid'>qs</span>
<a name="line-105"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>psp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>permute</span> <span class='hs-varid'>perm</span> <span class='hs-varid'>ps'</span>
<a name="line-106"></a> <span class='hs-varid'>reportSDoc</span> <span class='hs-str'>"tc.with.strip"</span> <span class='hs-num'>10</span> <span class='hs-varop'>$</span> <span class='hs-varid'>vcat</span>
<a name="line-107"></a> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>text</span> <span class='hs-str'>"ps' = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>fsep</span> <span class='hs-layout'>(</span><span class='hs-varid'>punctuate</span> <span class='hs-varid'>comma</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-varid'>prettyA</span> <span class='hs-varid'>ps'</span><span class='hs-layout'>)</span>
<a name="line-108"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>text</span> <span class='hs-str'>"psp = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>fsep</span> <span class='hs-layout'>(</span><span class='hs-varid'>punctuate</span> <span class='hs-varid'>comma</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-varid'>prettyA</span> <span class='hs-varop'>$</span> <span class='hs-varid'>psp</span><span class='hs-layout'>)</span>
<a name="line-109"></a> <span class='hs-keyglyph'>]</span>
<a name="line-110"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>psp</span>
<a name="line-111"></a> <span class='hs-keyword'>where</span>
<a name="line-112"></a> <span class='hs-comment'>-- implicit args inserted at top level</span>
<a name="line-113"></a> <span class='hs-comment'>-- all three arguments should have the same size</span>
<a name="line-114"></a> <span class='hs-varid'>strip</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Telescope</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>NamedArg</span> <span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>Pattern</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Arg</span> <span class='hs-conid'>Pattern</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TCM</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>NamedArg</span> <span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>Pattern</span><span class='hs-keyglyph'>]</span>
<a name="line-115"></a> <span class='hs-varid'>strip</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-sel'>__IMPOSSIBLE__</span>
<a name="line-116"></a> <span class='hs-varid'>strip</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-sel'>__IMPOSSIBLE__</span>
<a name="line-117"></a> <span class='hs-varid'>strip</span> <span class='hs-conid'>EmptyTel</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-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-sel'>__IMPOSSIBLE__</span>
<a name="line-118"></a> <span class='hs-varid'>strip</span> <span class='hs-conid'>ExtendTel</span><span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-conid'>[]</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-sel'>__IMPOSSIBLE__</span>
<a name="line-119"></a> <span class='hs-varid'>strip</span> <span class='hs-conid'>EmptyTel</span> <span class='hs-conid'>[]</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>|</span> <span class='hs-num'>0</span> <span class='hs-varop'>==</span> <span class='hs-num'>0</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>[]</span>
<a name="line-120"></a> <span class='hs-varid'>strip</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExtendTel</span> <span class='hs-varid'>a</span> <span class='hs-varid'>tel</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>p0</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>q</span> <span class='hs-conop'>:</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-121"></a> <span class='hs-varid'>p</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>expandLitPattern</span> <span class='hs-varid'>p0</span>
<a name="line-122"></a> <span class='hs-varid'>reportSDoc</span> <span class='hs-str'>"tc.with.strip"</span> <span class='hs-num'>15</span> <span class='hs-varop'>$</span> <span class='hs-varid'>vcat</span>
<a name="line-123"></a> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>text</span> <span class='hs-str'>"strip"</span>
<a name="line-124"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>text</span> <span class='hs-str'>"ps ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>fsep</span> <span class='hs-layout'>(</span><span class='hs-varid'>punctuate</span> <span class='hs-varid'>comma</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-varid'>prettyA</span> <span class='hs-layout'>(</span><span class='hs-varid'>p0</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-125"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>text</span> <span class='hs-str'>"exp ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyA</span> <span class='hs-varid'>p</span>
<a name="line-126"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>text</span> <span class='hs-str'>"qs ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>fsep</span> <span class='hs-layout'>(</span><span class='hs-varid'>punctuate</span> <span class='hs-varid'>comma</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>showPat</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unArg</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>q</span> <span class='hs-conop'>:</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-127"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>text</span> <span class='hs-str'>"tel ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyTCM</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExtendTel</span> <span class='hs-varid'>a</span> <span class='hs-varid'>tel</span><span class='hs-layout'>)</span>
<a name="line-128"></a> <span class='hs-keyglyph'>]</span>
<a name="line-129"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>unArg</span> <span class='hs-varid'>q</span> <span class='hs-keyword'>of</span>
<a name="line-130"></a> <span class='hs-conid'>VarP</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-131"></a> <span class='hs-varid'>ps</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>underAbstraction</span> <span class='hs-varid'>a</span> <span class='hs-varid'>tel</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>tel</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>strip</span> <span class='hs-varid'>tel</span> <span class='hs-varid'>ps</span> <span class='hs-varid'>qs</span>
<a name="line-132"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>p</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ps</span>
<a name="line-133"></a>
<a name="line-134"></a> <span class='hs-conid'>DotP</span> <span class='hs-varid'>v</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>case</span> <span class='hs-varid'>namedArg</span> <span class='hs-varid'>p</span> <span class='hs-keyword'>of</span>
<a name="line-135"></a> <span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>DotP</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>ok</span>
<a name="line-136"></a> <span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>ImplicitP</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>ok</span>
<a name="line-137"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-138"></a> <span class='hs-varid'>d</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>prettyA</span> <span class='hs-varid'>p</span>
<a name="line-139"></a> <span class='hs-varid'>typeError</span> <span class='hs-varop'>$</span> <span class='hs-conid'>GenericError</span> <span class='hs-varop'>$</span>
<a name="line-140"></a> <span class='hs-str'>"Inaccessible (dotted) patterns from the parent clause must "</span> <span class='hs-varop'>++</span>
<a name="line-141"></a> <span class='hs-str'>"also be inaccessible in the with clause, when checking the "</span> <span class='hs-varop'>++</span>
<a name="line-142"></a> <span class='hs-str'>"pattern "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-varid'>d</span> <span class='hs-varop'>++</span> <span class='hs-str'>","</span>
<a name="line-143"></a> <span class='hs-keyword'>where</span>
<a name="line-144"></a> <span class='hs-varid'>ok</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-145"></a> <span class='hs-varid'>ps</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>strip</span> <span class='hs-layout'>(</span><span class='hs-varid'>tel</span> <span class='hs-varop'>`absApp`</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-varid'>ps</span> <span class='hs-varid'>qs</span>
<a name="line-146"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>p</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ps</span>
<a name="line-147"></a>
<a name="line-148"></a> <span class='hs-conid'>ConP</span> <span class='hs-varid'>c</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>qs'</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>case</span> <span class='hs-varid'>namedArg</span> <span class='hs-varid'>p</span> <span class='hs-keyword'>of</span>
<a name="line-149"></a> <span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>ConP</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>AmbQ</span> <span class='hs-varid'>cs'</span><span class='hs-layout'>)</span> <span class='hs-varid'>ps'</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-150"></a>
<a name="line-151"></a> <span class='hs-conid'>Con</span> <span class='hs-varid'>c'</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ignoreSharing</span> <span class='hs-varop'><$></span> <span class='hs-layout'>(</span><span class='hs-varid'>constructorForm</span> <span class='hs-varop'>=<<</span> <span class='hs-varid'>reduce</span> <span class='hs-layout'>(</span><span class='hs-conid'>Con</span> <span class='hs-varid'>c</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-152"></a> <span class='hs-varid'>c</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>c'</span> <span class='hs-varop'>`withRangeOf`</span> <span class='hs-varid'>c</span>
<a name="line-153"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>getCon</span> <span class='hs-layout'>(</span><span class='hs-conid'>Con</span> <span class='hs-varid'>c</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>c</span>
<a name="line-154"></a> <span class='hs-varid'>getCon</span> <span class='hs-layout'>(</span><span class='hs-conid'>Shared</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>getCon</span> <span class='hs-layout'>(</span><span class='hs-varid'>derefPtr</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span>
<a name="line-155"></a> <span class='hs-varid'>getCon</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-sel'>__IMPOSSIBLE__</span>
<a name="line-156"></a> <span class='hs-varid'>cs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>map</span> <span class='hs-varid'>getCon</span> <span class='hs-varop'><$></span> <span class='hs-layout'>(</span><span class='hs-varid'>mapM</span> <span class='hs-varid'>constructorForm</span> <span class='hs-varop'>=<<</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>c'</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>reduce</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Con</span> <span class='hs-varid'>c'</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-varid'>cs'</span><span class='hs-layout'>)</span>
<a name="line-157"></a>
<a name="line-158"></a> <span class='hs-varid'>unless</span> <span class='hs-layout'>(</span><span class='hs-varid'>elem</span> <span class='hs-varid'>c</span> <span class='hs-varid'>cs'</span><span class='hs-layout'>)</span> <span class='hs-varid'>mismatch</span>
<a name="line-159"></a>
<a name="line-160"></a> <span class='hs-comment'>-- The type is a datatype</span>
<a name="line-161"></a> <span class='hs-conid'>Def</span> <span class='hs-varid'>d</span> <span class='hs-varid'>us</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ignoreSharing</span> <span class='hs-varop'><$></span> <span class='hs-varid'>normalise</span> <span class='hs-layout'>(</span><span class='hs-varid'>unEl</span> <span class='hs-varop'>$</span> <span class='hs-varid'>unDom</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-162"></a>
<a name="line-163"></a> <span class='hs-comment'>-- Compute the argument telescope for the constructor</span>
<a name="line-164"></a> <span class='hs-conid'>Con</span> <span class='hs-varid'>c</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ignoreSharing</span> <span class='hs-varop'><$></span> <span class='hs-layout'>(</span><span class='hs-varid'>constructorForm</span> <span class='hs-varop'>=<<</span> <span class='hs-varid'>normalise</span> <span class='hs-layout'>(</span><span class='hs-conid'>Con</span> <span class='hs-varid'>c</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-165"></a> <span class='hs-conid'>Defn</span> <span class='hs-layout'>{</span><span class='hs-varid'>defType</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ct</span><span class='hs-layout'>,</span> <span class='hs-varid'>theDef</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Constructor</span><span class='hs-layout'>{</span><span class='hs-varid'>conPars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>np</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getConstInfo</span> <span class='hs-varid'>c</span>
<a name="line-166"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>ct'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ct</span> <span class='hs-varop'>`apply`</span> <span class='hs-varid'>genericTake</span> <span class='hs-varid'>np</span> <span class='hs-varid'>us</span>
<a name="line-167"></a> <span class='hs-conid'>TelV</span> <span class='hs-varid'>tel'</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>telView</span> <span class='hs-varid'>ct'</span>
<a name="line-168"></a>
<a name="line-169"></a> <span class='hs-varid'>reportSDoc</span> <span class='hs-str'>"tc.with.strip"</span> <span class='hs-num'>20</span> <span class='hs-varop'>$</span>
<a name="line-170"></a> <span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>text</span> <span class='hs-str'>"ct = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>ct</span>
<a name="line-171"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"ct' = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>ct'</span>
<a name="line-172"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"np = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>show</span> <span class='hs-varid'>np</span><span class='hs-layout'>)</span>
<a name="line-173"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"us = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyList</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>us</span><span class='hs-layout'>)</span>
<a name="line-174"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"us' = "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyList</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varop'>$</span> <span class='hs-varid'>genericTake</span> <span class='hs-varid'>np</span> <span class='hs-varid'>us</span><span class='hs-layout'>)</span>
<a name="line-175"></a> <span class='hs-keyglyph'>]</span>
<a name="line-176"></a>
<a name="line-177"></a> <span class='hs-comment'>-- Compute the new telescope</span>
<a name="line-178"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>v</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Con</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>[</span> <span class='hs-conid'>Arg</span> <span class='hs-varid'>h</span> <span class='hs-varid'>r</span> <span class='hs-layout'>(</span><span class='hs-varid'>var</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>i</span><span class='hs-layout'>,</span> <span class='hs-conid'>Arg</span> <span class='hs-varid'>h</span> <span class='hs-varid'>r</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zip</span> <span class='hs-layout'>(</span><span class='hs-varid'>downFrom</span> <span class='hs-varop'>$</span> <span class='hs-varid'>size</span> <span class='hs-varid'>qs'</span><span class='hs-layout'>)</span> <span class='hs-varid'>qs'</span> <span class='hs-keyglyph'>]</span>
<a name="line-179"></a><span class='hs-comment'>-- let v = Con c $ reverse [ Arg h r (var i) | (i, Arg h r _) <- zip [0..] $ reverse qs' ]</span>
<a name="line-180"></a> <span class='hs-varid'>tel''</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tel'</span> <span class='hs-varop'>`abstract`</span> <span class='hs-varid'>absApp</span> <span class='hs-layout'>(</span><span class='hs-varid'>raise</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>tel'</span><span class='hs-layout'>)</span> <span class='hs-varid'>tel</span><span class='hs-layout'>)</span> <span class='hs-varid'>v</span>
<a name="line-181"></a>
<a name="line-182"></a> <span class='hs-varid'>reportSDoc</span> <span class='hs-str'>"tc.with.strip"</span> <span class='hs-num'>15</span> <span class='hs-varop'>$</span> <span class='hs-varid'>sep</span>
<a name="line-183"></a> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>text</span> <span class='hs-str'>"inserting implicit"</span>
<a name="line-184"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>prettyList</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-varid'>prettyA</span> <span class='hs-layout'>(</span><span class='hs-varid'>ps'</span> <span class='hs-varop'>++</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span>
<a name="line-185"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>text</span> <span class='hs-str'>":"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>tel''</span>
<a name="line-186"></a> <span class='hs-keyglyph'>]</span>
<a name="line-187"></a>
<a name="line-188"></a> <span class='hs-comment'>-- Insert implicit patterns (just for the constructor arguments)</span>
<a name="line-189"></a> <span class='hs-varid'>psi'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>insertImplicitPatterns</span> <span class='hs-conid'>ExpandLast</span> <span class='hs-varid'>ps'</span> <span class='hs-varid'>tel'</span>
<a name="line-190"></a> <span class='hs-varid'>unless</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>psi'</span> <span class='hs-varop'>==</span> <span class='hs-varid'>size</span> <span class='hs-varid'>tel'</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>typeError</span> <span class='hs-varop'>$</span> <span class='hs-conid'>WrongNumberOfConstructorArguments</span> <span class='hs-varid'>c</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>tel'</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>psi'</span><span class='hs-layout'>)</span>
<a name="line-191"></a>
<a name="line-192"></a> <span class='hs-comment'>-- Do it again for everything (is this necessary?)</span>
<a name="line-193"></a> <span class='hs-varid'>psi'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>insertImplicitPatterns</span> <span class='hs-conid'>ExpandLast</span> <span class='hs-layout'>(</span><span class='hs-varid'>psi'</span> <span class='hs-varop'>++</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-varid'>tel''</span>
<a name="line-194"></a>
<a name="line-195"></a> <span class='hs-comment'>-- Keep going</span>
<a name="line-196"></a> <span class='hs-varid'>strip</span> <span class='hs-varid'>tel''</span> <span class='hs-varid'>psi'</span> <span class='hs-layout'>(</span><span class='hs-varid'>qs'</span> <span class='hs-varop'>++</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span>
<a name="line-197"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mismatch</span>
<a name="line-198"></a>
<a name="line-199"></a> <span class='hs-conid'>LitP</span> <span class='hs-varid'>lit</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>case</span> <span class='hs-varid'>namedArg</span> <span class='hs-varid'>p</span> <span class='hs-keyword'>of</span>
<a name="line-200"></a> <span class='hs-conid'>A</span><span class='hs-varop'>.</span><span class='hs-conid'>LitP</span> <span class='hs-varid'>lit'</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>lit</span> <span class='hs-varop'>==</span> <span class='hs-varid'>lit'</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>strip</span> <span class='hs-layout'>(</span><span class='hs-varid'>tel</span> <span class='hs-varop'>`absApp`</span> <span class='hs-conid'>Lit</span> <span class='hs-varid'>lit</span><span class='hs-layout'>)</span> <span class='hs-varid'>ps</span> <span class='hs-varid'>qs</span>
<a name="line-201"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mismatch</span>
<a name="line-202"></a> <span class='hs-keyword'>where</span>
<a name="line-203"></a> <span class='hs-varid'>mismatch</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>typeError</span> <span class='hs-varop'>$</span> <span class='hs-conid'>WithClausePatternMismatch</span> <span class='hs-layout'>(</span><span class='hs-varid'>namedArg</span> <span class='hs-varid'>p0</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>unArg</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span>
<a name="line-204"></a> <span class='hs-varid'>strip</span> <span class='hs-varid'>tel</span> <span class='hs-varid'>ps</span> <span class='hs-varid'>qs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>error</span> <span class='hs-varop'>$</span> <span class='hs-str'>"huh? "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>tel</span><span class='hs-layout'>)</span> <span class='hs-varop'>++</span> <span class='hs-str'>" "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-varop'>++</span> <span class='hs-str'>" "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span>
<a name="line-205"></a>
<a name="line-206"></a><a name="withDisplayForm"></a><span class='hs-comment'>-- | Construct the display form for a with function. It will display</span>
<a name="line-207"></a><span class='hs-comment'>-- applications of the with function as applications to the original function.</span>
<a name="line-208"></a><span class='hs-comment'>-- For instance, @aux a b c@ as @f (suc a) (suc b) | c@</span>
<a name="line-209"></a><span class='hs-comment'>--</span>
<a name="line-210"></a><span class='hs-comment'>-- @n@ is the number of with arguments.</span>
<a name="line-211"></a><span class='hs-definition'>withDisplayForm</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>QName</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>QName</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Telescope</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Telescope</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Nat</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Arg</span> <span class='hs-conid'>Pattern</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Permutation</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TCM</span> <span class='hs-conid'>DisplayForm</span>
<a name="line-212"></a><span class='hs-definition'>withDisplayForm</span> <span class='hs-varid'>f</span> <span class='hs-varid'>aux</span> <span class='hs-varid'>delta1</span> <span class='hs-varid'>delta2</span> <span class='hs-varid'>n</span> <span class='hs-varid'>qs</span> <span class='hs-varid'>perm</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Perm</span> <span class='hs-varid'>m</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-213"></a> <span class='hs-varid'>topArgs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>raise</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span> <span class='hs-varop'>+</span> <span class='hs-varid'>size</span> <span class='hs-varid'>delta1</span> <span class='hs-varop'>+</span> <span class='hs-varid'>size</span> <span class='hs-varid'>delta2</span><span class='hs-layout'>)</span> <span class='hs-varop'><$></span> <span class='hs-varid'>getContextArgs</span>
<a name="line-214"></a> <span class='hs-varid'>x</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>freshNoName_</span>
<a name="line-215"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>wild</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Def</span> <span class='hs-layout'>(</span><span class='hs-varid'>qualify</span> <span class='hs-layout'>(</span><span class='hs-varid'>mnameFromList</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span>
<a name="line-216"></a>
<a name="line-217"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>top</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>genericLength</span> <span class='hs-varid'>topArgs</span>
<a name="line-218"></a> <span class='hs-varid'>vs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>fmap</span> <span class='hs-conid'>DTerm</span><span class='hs-layout'>)</span> <span class='hs-varid'>topArgs</span> <span class='hs-varop'>++</span> <span class='hs-layout'>(</span><span class='hs-varid'>applySubst</span> <span class='hs-layout'>(</span><span class='hs-varid'>sub</span> <span class='hs-varid'>ys</span> <span class='hs-varid'>wild</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>patsToTerms</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span>
<a name="line-219"></a> <span class='hs-varid'>dt</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>DWithApp</span> <span class='hs-layout'>(</span><span class='hs-conid'>DDef</span> <span class='hs-varid'>f</span> <span class='hs-varid'>vs</span> <span class='hs-conop'>:</span> <span class='hs-varid'>map</span> <span class='hs-conid'>DTerm</span> <span class='hs-varid'>withArgs</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span>
<a name="line-220"></a> <span class='hs-varid'>withArgs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>var</span> <span class='hs-varop'>$</span> <span class='hs-varid'>genericTake</span> <span class='hs-varid'>n</span> <span class='hs-varop'>$</span> <span class='hs-varid'>downFrom</span> <span class='hs-varop'>$</span> <span class='hs-varid'>size</span> <span class='hs-varid'>delta2</span> <span class='hs-varop'>+</span> <span class='hs-varid'>n</span>
<a name="line-221"></a><span class='hs-comment'>-- withArgs = reverse $ map var [size delta2..size delta2 + n - 1]</span>
<a name="line-222"></a> <span class='hs-varid'>pats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>genericReplicate</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span> <span class='hs-varop'>+</span> <span class='hs-varid'>size</span> <span class='hs-varid'>delta1</span> <span class='hs-varop'>+</span> <span class='hs-varid'>size</span> <span class='hs-varid'>delta2</span> <span class='hs-varop'>+</span> <span class='hs-varid'>top</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>var</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-223"></a> <span class='hs-comment'>-- Building the arguments to the with function</span>
<a name="line-224"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ys0</span><span class='hs-layout'>,</span> <span class='hs-varid'>ys1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitAt</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>delta1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>permute</span> <span class='hs-varid'>perm</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-conid'>Just</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>m</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span><span class='hs-layout'>,</span> <span class='hs-varid'>m</span> <span class='hs-comment'>-</span> <span class='hs-num'>2</span><span class='hs-keyglyph'>..</span><span class='hs-num'>0</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-225"></a> <span class='hs-varid'>ys</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>reverse</span> <span class='hs-varop'>$</span> <span class='hs-varid'>ys0</span> <span class='hs-varop'>++</span> <span class='hs-varid'>genericReplicate</span> <span class='hs-varid'>n</span> <span class='hs-conid'>Nothing</span> <span class='hs-varop'>++</span> <span class='hs-varid'>ys1</span>
<a name="line-226"></a>
<a name="line-227"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>display</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Display</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span> <span class='hs-varop'>+</span> <span class='hs-varid'>size</span> <span class='hs-varid'>delta1</span> <span class='hs-varop'>+</span> <span class='hs-varid'>size</span> <span class='hs-varid'>delta2</span> <span class='hs-varop'>+</span> <span class='hs-varid'>top</span><span class='hs-layout'>)</span> <span class='hs-varid'>pats</span> <span class='hs-varid'>dt</span>
<a name="line-228"></a> <span class='hs-varid'>addFullCtx</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addCtxTel</span> <span class='hs-varid'>delta1</span>
<a name="line-229"></a> <span class='hs-varop'>.</span> <span class='hs-varid'>flip</span> <span class='hs-layout'>(</span><span class='hs-varid'>foldr</span> <span class='hs-varid'>addCtxString_</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-str'>"w"</span> <span class='hs-varop'>++</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-varid'>show</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>1</span><span class='hs-keyglyph'>..</span><span class='hs-varid'>n</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-230"></a> <span class='hs-varop'>.</span> <span class='hs-varid'>addCtxTel</span> <span class='hs-varid'>delta2</span>
<a name="line-231"></a> <span class='hs-comment'>-- Andreas 2012-09-17: this seems to be the right order of contexts</span>
<a name="line-232"></a>
<a name="line-233"></a> <span class='hs-varid'>reportSDoc</span> <span class='hs-str'>"tc.with.display"</span> <span class='hs-num'>20</span> <span class='hs-varop'>$</span> <span class='hs-varid'>vcat</span>
<a name="line-234"></a> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>text</span> <span class='hs-str'>"withDisplayForm"</span>
<a name="line-235"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>vcat</span>
<a name="line-236"></a> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>text</span> <span class='hs-str'>"f ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>show</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span>
<a name="line-237"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"aux ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>show</span> <span class='hs-varid'>aux</span><span class='hs-layout'>)</span>
<a name="line-238"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"delta1 ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>delta1</span>
<a name="line-239"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"delta2 ="</span> <span class='hs-varop'><+></span> <span class='hs-keyword'>do</span> <span class='hs-varid'>addCtxTel</span> <span class='hs-varid'>delta1</span> <span class='hs-varop'>$</span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>delta2</span>
<a name="line-240"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"n ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>show</span> <span class='hs-varid'>n</span><span class='hs-layout'>)</span>
<a name="line-241"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"perm ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>show</span> <span class='hs-varid'>perm</span><span class='hs-layout'>)</span>
<a name="line-242"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"top ="</span> <span class='hs-varop'><+></span> <span class='hs-keyword'>do</span> <span class='hs-varid'>addFullCtx</span> <span class='hs-varop'>$</span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>topArgs</span>
<a name="line-243"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"qs ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>show</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span>
<a name="line-244"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"dt ="</span> <span class='hs-varop'><+></span> <span class='hs-keyword'>do</span> <span class='hs-varid'>addFullCtx</span> <span class='hs-varop'>$</span> <span class='hs-varid'>prettyTCM</span> <span class='hs-varid'>dt</span>
<a name="line-245"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"ys ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>show</span> <span class='hs-varid'>ys</span><span class='hs-layout'>)</span>
<a name="line-246"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"raw ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>show</span> <span class='hs-varid'>display</span><span class='hs-layout'>)</span>
<a name="line-247"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"qsToTm ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyTCM</span> <span class='hs-layout'>(</span><span class='hs-varid'>patsToTerms</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- ctx would be permuted form of delta1 ++ delta2</span>
<a name="line-248"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>text</span> <span class='hs-str'>"sub qs ="</span> <span class='hs-varop'><+></span> <span class='hs-varid'>prettyTCM</span> <span class='hs-layout'>(</span><span class='hs-varid'>applySubst</span> <span class='hs-layout'>(</span><span class='hs-varid'>sub</span> <span class='hs-varid'>ys</span> <span class='hs-varid'>wild</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>patsToTerms</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span>
<a name="line-249"></a> <span class='hs-keyglyph'>]</span>
<a name="line-250"></a> <span class='hs-keyglyph'>]</span>
<a name="line-251"></a>
<a name="line-252"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>display</span>
<a name="line-253"></a> <span class='hs-keyword'>where</span>
<a name="line-254"></a> <span class='hs-comment'>-- Note: The upper bound (m - 1) was previously commented out. I</span>
<a name="line-255"></a> <span class='hs-comment'>-- restored it in order to make the substitution finite.</span>
<a name="line-256"></a> <span class='hs-varid'>sub</span> <span class='hs-varid'>rho</span> <span class='hs-varid'>wild</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parallelS</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-varid'>term</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span> <span class='hs-keyglyph'>..</span> <span class='hs-varid'>m</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span><span class='hs-keyglyph'>]</span>
<a name="line-257"></a> <span class='hs-keyword'>where</span>
<a name="line-258"></a> <span class='hs-comment'>-- thinking required.. but ignored</span>
<a name="line-259"></a> <span class='hs-comment'>-- dropping the reverse seems to work better</span>
<a name="line-260"></a> <span class='hs-comment'>-- Andreas, 2010-09-09: I DISAGREE.</span>
<a name="line-261"></a> <span class='hs-comment'>-- Ulf, 2011-09-02: Thinking done. Neither was correct.</span>
<a name="line-262"></a> <span class='hs-comment'>-- We had the wrong permutation and we used it incorrectly. Should work now.</span>
<a name="line-263"></a> <span class='hs-varid'>term</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>maybe</span> <span class='hs-varid'>wild</span> <span class='hs-varid'>var</span> <span class='hs-varop'>$</span> <span class='hs-varid'>findIndex</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>i</span> <span class='hs-varop'>==</span><span class='hs-layout'>)</span> <span class='hs-varid'>rho</span>
<a name="line-264"></a>
<a name="line-265"></a><a name="patsToTerms"></a><span class='hs-definition'>patsToTerms</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Arg</span> <span class='hs-conid'>Pattern</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Arg</span> <span class='hs-conid'>DisplayTerm</span><span class='hs-keyglyph'>]</span>
<a name="line-266"></a><span class='hs-definition'>patsToTerms</span> <span class='hs-varid'>ps</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>evalState</span> <span class='hs-layout'>(</span><span class='hs-varid'>toTerms</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-num'>0</span>
<a name="line-267"></a> <span class='hs-keyword'>where</span>
<a name="line-268"></a> <span class='hs-varid'>mapMr</span> <span class='hs-varid'>f</span> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>reverse</span> <span class='hs-varop'><$></span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-varid'>reverse</span> <span class='hs-varid'>xs</span><span class='hs-layout'>)</span>
<a name="line-269"></a>
<a name="line-270"></a> <span class='hs-varid'>nextVar</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>State</span> <span class='hs-conid'>Nat</span> <span class='hs-conid'>Nat</span>
<a name="line-271"></a> <span class='hs-varid'>nextVar</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-272"></a> <span class='hs-varid'>i</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-273"></a> <span class='hs-varid'>put</span> <span class='hs-layout'>(</span><span class='hs-varid'>i</span> <span class='hs-varop'>+</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-274"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>i</span>
<a name="line-275"></a>
<a name="line-276"></a> <span class='hs-varid'>toTerms</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Arg</span> <span class='hs-conid'>Pattern</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>State</span> <span class='hs-conid'>Nat</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Arg</span> <span class='hs-conid'>DisplayTerm</span><span class='hs-keyglyph'>]</span>
<a name="line-277"></a> <span class='hs-varid'>toTerms</span> <span class='hs-varid'>ps</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapMr</span> <span class='hs-varid'>toArg</span> <span class='hs-varid'>ps</span>
<a name="line-278"></a>
<a name="line-279"></a> <span class='hs-varid'>toArg</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Arg</span> <span class='hs-conid'>Pattern</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>State</span> <span class='hs-conid'>Nat</span> <span class='hs-layout'>(</span><span class='hs-conid'>Arg</span> <span class='hs-conid'>DisplayTerm</span><span class='hs-layout'>)</span>
<a name="line-280"></a> <span class='hs-varid'>toArg</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>T</span><span class='hs-varop'>.</span><span class='hs-varid'>mapM</span> <span class='hs-varid'>toTerm</span>
<a name="line-281"></a>
<a name="line-282"></a> <span class='hs-varid'>toTerm</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Pattern</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>State</span> <span class='hs-conid'>Nat</span> <span class='hs-conid'>DisplayTerm</span>
<a name="line-283"></a> <span class='hs-varid'>toTerm</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>p</span> <span class='hs-keyword'>of</span>
<a name="line-284"></a> <span class='hs-conid'>VarP</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>nextVar</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>i</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>DTerm</span> <span class='hs-layout'>(</span><span class='hs-varid'>var</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span>
<a name="line-285"></a> <span class='hs-conid'>DotP</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>DDot</span> <span class='hs-varid'>t</span>
<a name="line-286"></a> <span class='hs-conid'>ConP</span> <span class='hs-varid'>c</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>ps</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DCon</span> <span class='hs-varid'>c</span> <span class='hs-varop'><$></span> <span class='hs-varid'>toTerms</span> <span class='hs-varid'>ps</span>
<a name="line-287"></a> <span class='hs-conid'>LitP</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>DTerm</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lit</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span>
</pre></body>
</html>
