<?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/Tests.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></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'>Tests</span> <span class='hs-keyword'>where</span>
<a name="line-2"></a>
<a name="line-3"></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'>Utils</span><span class='hs-varop'>.</span><span class='hs-conid'>VarSet</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>Set</span>
<a name="line-4"></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'>QuickCheck</span>
<a name="line-5"></a>
<a name="line-6"></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-7"></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'>Test</span><span class='hs-varop'>.</span><span class='hs-conid'>Generators</span>
<a name="line-8"></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-9"></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-10"></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-11"></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-12"></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'>TestHelpers</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-comment'>---------------------------------------------------------------------------</span>
<a name="line-15"></a><span class='hs-comment'>-- * Tests for "Agda.Utils.Permutation"</span>
<a name="line-16"></a><span class='hs-comment'>---------------------------------------------------------------------------</span>
<a name="line-17"></a>
<a name="line-18"></a><span class='hs-comment'>---------------------------------------------------------------------------</span>
<a name="line-19"></a><span class='hs-comment'>-- * Tests for "Agda.TypeChecking.Telescope"</span>
<a name="line-20"></a><span class='hs-comment'>---------------------------------------------------------------------------</span>
<a name="line-21"></a>
<a name="line-22"></a><a name="prop_telToListInv"></a><span class='hs-comment'>-- | @telFromList . telToList == id@</span>
<a name="line-23"></a><span class='hs-definition'>prop_telToListInv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TermConfiguration</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Property</span>
<a name="line-24"></a><span class='hs-definition'>prop_telToListInv</span> <span class='hs-varid'>conf</span> <span class='hs-keyglyph'>=</span>
<a name="line-25"></a> <span class='hs-varid'>forAll</span> <span class='hs-layout'>(</span><span class='hs-varid'>genC</span> <span class='hs-varid'>conf</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>tel</span> <span class='hs-keyglyph'>-></span>
<a name="line-26"></a> <span class='hs-varid'>telFromList</span> <span class='hs-layout'>(</span><span class='hs-varid'>telToList</span> <span class='hs-varid'>tel</span><span class='hs-layout'>)</span> <span class='hs-varop'>==</span> <span class='hs-varid'>tel</span>
<a name="line-27"></a>
<a name="line-28"></a><a name="prop_flattenTelScope"></a><span class='hs-comment'>-- | All elements of 'flattenTel' are well-scoped under the original telescope.</span>
<a name="line-29"></a><span class='hs-definition'>prop_flattenTelScope</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TermConfiguration</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Property</span>
<a name="line-30"></a><span class='hs-definition'>prop_flattenTelScope</span> <span class='hs-varid'>conf</span> <span class='hs-keyglyph'>=</span>
<a name="line-31"></a> <span class='hs-varid'>forAll</span> <span class='hs-layout'>(</span><span class='hs-varid'>genC</span> <span class='hs-varid'>conf</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>tel</span> <span class='hs-keyglyph'>-></span>
<a name="line-32"></a> <span class='hs-varid'>all</span> <span class='hs-layout'>(</span><span class='hs-varid'>isWellScoped</span> <span class='hs-varop'>$</span> <span class='hs-varid'>extendWithTelConf</span> <span class='hs-varid'>tel</span> <span class='hs-varid'>conf</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>flattenTel</span> <span class='hs-varid'>tel</span><span class='hs-layout'>)</span>
<a name="line-33"></a>
<a name="line-34"></a><a name="prop_flattenTelInv"></a><span class='hs-comment'>-- | @unflattenTel . flattenTel == id@</span>
<a name="line-35"></a><span class='hs-definition'>prop_flattenTelInv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TermConfiguration</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Property</span>
<a name="line-36"></a><span class='hs-definition'>prop_flattenTelInv</span> <span class='hs-varid'>conf</span> <span class='hs-keyglyph'>=</span>
<a name="line-37"></a> <span class='hs-varid'>forAll</span> <span class='hs-layout'>(</span><span class='hs-varid'>genC</span> <span class='hs-varid'>conf</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>tel</span> <span class='hs-keyglyph'>-></span>
<a name="line-38"></a> <span class='hs-varid'>unflattenTel</span> <span class='hs-layout'>(</span><span class='hs-varid'>teleNames</span> <span class='hs-varid'>tel</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>flattenTel</span> <span class='hs-varid'>tel</span><span class='hs-layout'>)</span> <span class='hs-varop'>==</span> <span class='hs-varid'>tel</span>
<a name="line-39"></a>
<a name="line-40"></a><a name="prop_reorderTelStable"></a><span class='hs-comment'>-- | 'reorderTel' is stable.</span>
<a name="line-41"></a><span class='hs-definition'>prop_reorderTelStable</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TermConfiguration</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Property</span>
<a name="line-42"></a><span class='hs-definition'>prop_reorderTelStable</span> <span class='hs-varid'>conf</span> <span class='hs-keyglyph'>=</span>
<a name="line-43"></a> <span class='hs-varid'>forAll</span> <span class='hs-layout'>(</span><span class='hs-varid'>genC</span> <span class='hs-varid'>conf</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>tel</span> <span class='hs-keyglyph'>-></span>
<a name="line-44"></a> <span class='hs-varid'>reorderTel</span> <span class='hs-layout'>(</span><span class='hs-varid'>flattenTel</span> <span class='hs-varid'>tel</span><span class='hs-layout'>)</span> <span class='hs-varop'>==</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>idP</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>
<a name="line-45"></a>
<a name="line-46"></a><a name="prop_splitTelescopeScope"></a><span class='hs-comment'>-- | The result of splitting a telescope is well-scoped.</span>
<a name="line-47"></a><span class='hs-definition'>prop_splitTelescopeScope</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TermConfiguration</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Property</span>
<a name="line-48"></a><span class='hs-definition'>prop_splitTelescopeScope</span> <span class='hs-varid'>conf</span> <span class='hs-keyglyph'>=</span>
<a name="line-49"></a> <span class='hs-varid'>forAll</span> <span class='hs-layout'>(</span><span class='hs-varid'>genC</span> <span class='hs-varid'>conf</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>tel</span> <span class='hs-keyglyph'>-></span>
<a name="line-50"></a> <span class='hs-varid'>forAll</span> <span class='hs-layout'>(</span><span class='hs-varid'>listOfElements</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span><span class='hs-keyglyph'>..</span><span class='hs-varid'>size</span> <span class='hs-varid'>tel</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>vs</span> <span class='hs-keyglyph'>-></span>
<a name="line-51"></a> <span class='hs-keyword'>let</span> <span class='hs-conid'>SplitTel</span> <span class='hs-varid'>tel1</span> <span class='hs-varid'>tel2</span> <span class='hs-varid'>perm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitTelescope</span> <span class='hs-layout'>(</span><span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>fromList</span> <span class='hs-varid'>vs</span><span class='hs-layout'>)</span> <span class='hs-varid'>tel</span>
<a name="line-52"></a> <span class='hs-varid'>tel'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>telFromList</span> <span class='hs-layout'>(</span><span class='hs-varid'>telToList</span> <span class='hs-varid'>tel1</span> <span class='hs-varop'>++</span> <span class='hs-varid'>telToList</span> <span class='hs-varid'>tel2</span><span class='hs-layout'>)</span>
<a name="line-53"></a> <span class='hs-keyword'>in</span> <span class='hs-varid'>isWellScoped</span> <span class='hs-varid'>conf</span> <span class='hs-varid'>tel'</span>
<a name="line-54"></a>
<a name="line-55"></a><a name="prop_splitTelescopePermScope"></a><span class='hs-comment'>-- | The permutation generated when splitting a telescope preserves scoping.</span>
<a name="line-56"></a><span class='hs-definition'>prop_splitTelescopePermScope</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TermConfiguration</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Property</span>
<a name="line-57"></a><span class='hs-definition'>prop_splitTelescopePermScope</span> <span class='hs-varid'>conf</span> <span class='hs-keyglyph'>=</span>
<a name="line-58"></a> <span class='hs-varid'>forAllShrink</span> <span class='hs-layout'>(</span><span class='hs-varid'>genC</span> <span class='hs-varid'>conf</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>shrinkC</span> <span class='hs-varid'>conf</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>tel</span> <span class='hs-keyglyph'>-></span>
<a name="line-59"></a> <span class='hs-varid'>forAllShrink</span> <span class='hs-layout'>(</span><span class='hs-varid'>listOfElements</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span><span class='hs-keyglyph'>..</span><span class='hs-varid'>size</span> <span class='hs-varid'>tel</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-varid'>shrink</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>vs</span> <span class='hs-keyglyph'>-></span>
<a name="line-60"></a> <span class='hs-keyword'>let</span> <span class='hs-conid'>SplitTel</span> <span class='hs-varid'>tel1</span> <span class='hs-varid'>tel2</span> <span class='hs-varid'>perm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitTelescope</span> <span class='hs-layout'>(</span><span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>fromList</span> <span class='hs-varid'>vs</span><span class='hs-layout'>)</span> <span class='hs-varid'>tel</span>
<a name="line-61"></a> <span class='hs-varid'>conf1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendWithTelConf</span> <span class='hs-varid'>tel1</span> <span class='hs-varid'>conf</span>
<a name="line-62"></a> <span class='hs-varid'>conf2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>conf1</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcFreeVariables</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>tel2</span> <span class='hs-varop'>+</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcFreeVariables</span> <span class='hs-varid'>conf1</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-63"></a> <span class='hs-varid'>conf'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>conf</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcFreeVariables</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>size</span> <span class='hs-varid'>tel</span> <span class='hs-varop'>+</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcFreeVariables</span> <span class='hs-varid'>conf</span><span class='hs-layout'>)</span> <span class='hs-varop'>++</span> <span class='hs-varid'>vs</span> <span class='hs-layout'>}</span>
<a name="line-64"></a> <span class='hs-keyword'>in</span> <span class='hs-varid'>forAllShrink</span> <span class='hs-layout'>(</span><span class='hs-varid'>genC</span> <span class='hs-varid'>conf'</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>shrinkC</span> <span class='hs-varid'>conf'</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span>
<a name="line-65"></a> <span class='hs-varid'>isWellScoped</span> <span class='hs-varid'>conf2</span> <span class='hs-layout'>(</span><span class='hs-varid'>applySubst</span> <span class='hs-layout'>(</span><span class='hs-varid'>renamingR</span> <span class='hs-varop'>$</span> <span class='hs-varid'>invertP</span> <span class='hs-varid'>perm</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>t</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Term</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-66"></a>
<a name="line-67"></a><span class='hs-comment'>{-
<a name="line-68"></a>-- | The permutation generated when splitting a telescope correctly translates
<a name="line-69"></a>-- between the old and the new telescope.
<a name="line-70"></a>prop_splitTelescopePermInv :: TermConfiguration -> Property
<a name="line-71"></a>prop_splitTelescopePermInv conf =
<a name="line-72"></a> forAll (wellScopedTel conf) $ \tel ->
<a name="line-73"></a> forAll (listOfElements [0..size tel - 1]) $ \vs ->
<a name="line-74"></a> let SplitTel tel1 tel2 perm = splitTelescope (Set.fromList vs) tel
<a name="line-75"></a> tel' = telFromList (telToList tel1 ++ telToList tel2)
<a name="line-76"></a> conf1 = extendWithTelConf tel conf
<a name="line-77"></a> conf2 = extendWithTelConf tel' conf
<a name="line-78"></a> in forAll (wellScopedTerm conf1) $ \t1 ->
<a name="line-79"></a> forAll (wellScopedTerm conf2) $ \t2 ->
<a name="line-80"></a> let t1' = rename (invertP perm) $ rename perm t1
<a name="line-81"></a> t2' = rename perm $ rename (invertP perm) t2
<a name="line-82"></a> in t1 == t1' && t2 == t2'
<a name="line-83"></a>-}</span>
<a name="line-84"></a>
<a name="line-85"></a><a name="tests"></a><span class='hs-definition'>tests</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>Bool</span>
<a name="line-86"></a><span class='hs-definition'>tests</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>runTests</span> <span class='hs-str'>"Agda.TypeChecking.Tests"</span>
<a name="line-87"></a> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>quickCheck'</span> <span class='hs-varid'>prop_telToListInv</span>
<a name="line-88"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>quickCheck'</span> <span class='hs-varid'>prop_flattenTelScope</span>
<a name="line-89"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>quickCheck'</span> <span class='hs-varid'>prop_flattenTelInv</span>
<a name="line-90"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>quickCheck'</span> <span class='hs-varid'>prop_reorderTelStable</span>
<a name="line-91"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>quickCheck'</span> <span class='hs-varid'>prop_splitTelescopeScope</span>
<a name="line-92"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>quickCheck'</span> <span class='hs-varid'>prop_splitTelescopePermScope</span>
<a name="line-93"></a> <span class='hs-keyglyph'>]</span>
</pre></body>
</html>
