<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>deSugar/DsListComp.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
Desugaring list comprehensions and array comprehensions
\begin{code}
<pre><a name="line-1"></a><span class='hs-comment'>{-# OPTIONS -fno-warn-incomplete-patterns #-}</span>
<a name="line-2"></a><span class='hs-comment'>-- The above warning supression flag is a temporary kludge.</span>
<a name="line-3"></a><span class='hs-comment'>-- While working on this module you are encouraged to remove it and fix</span>
<a name="line-4"></a><span class='hs-comment'>-- any warnings in the module. See</span>
<a name="line-5"></a><span class='hs-comment'>-- <a href="http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings">http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings</a></span>
<a name="line-6"></a><span class='hs-comment'>-- for details</span>
<a name="line-7"></a>
<a name="line-8"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>DsListComp</span> <span class='hs-layout'>(</span> <span class='hs-varid'>dsListComp</span><span class='hs-layout'>,</span> <span class='hs-varid'>dsPArrComp</span> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-9"></a>
<a name="line-10"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-11"></a>
<a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-comment'>{-# SOURCE #-}</span> <span class='hs-conid'>DsExpr</span> <span class='hs-layout'>(</span> <span class='hs-varid'>dsLExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>dsLocalBinds</span> <span class='hs-layout'>)</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HsSyn</span>
<a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcHsSyn</span>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreSyn</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>MkCore</span>
<a name="line-18"></a>
<a name="line-19"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DsMonad</span> <span class='hs-comment'>-- the monadery used in the desugarer</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DsUtils</span>
<a name="line-21"></a>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DynFlags</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreUtils</span>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Id</span>
<a name="line-25"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Type</span>
<a name="line-26"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TysWiredIn</span>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Match</span>
<a name="line-28"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>PrelNames</span>
<a name="line-29"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>PrelInfo</span>
<a name="line-30"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>SrcLoc</span>
<a name="line-31"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastString</span>
<a name="line-33"></a>
<a name="line-34"></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-layout'>(</span> <span class='hs-varid'>liftM2</span> <span class='hs-layout'>)</span>
</pre>\end{code}
List comprehensions may be desugared in one of two ways: ``ordinary''
(as you would expect if you read SLPJ's book) and ``with foldr/build
turned on'' (if you read Gill {\em et al.}'s paper on the subject).
There will be at least one ``qualifier'' in the input.
\begin{code}
<pre><a name="line-1"></a><a name="dsListComp"></a><span class='hs-definition'>dsListComp</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LStmt</span> <span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Id</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- Type of list elements</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-5"></a><span class='hs-definition'>dsListComp</span> <span class='hs-varid'>lquals</span> <span class='hs-varid'>body</span> <span class='hs-varid'>elt_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-6"></a> <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getDOptsDs</span>
<a name="line-7"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>quals</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>unLoc</span> <span class='hs-varid'>lquals</span>
<a name="line-8"></a>
<a name="line-9"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>dopt</span> <span class='hs-conid'>Opt_EnableRewriteRules</span> <span class='hs-varid'>dflags</span><span class='hs-layout'>)</span> <span class='hs-varop'>||</span> <span class='hs-varid'>dopt</span> <span class='hs-conid'>Opt_IgnoreInterfacePragmas</span> <span class='hs-varid'>dflags</span>
<a name="line-10"></a> <span class='hs-comment'>-- Either rules are switched off, or we are ignoring what there are;</span>
<a name="line-11"></a> <span class='hs-comment'>-- Either way foldr/build won't happen, so use the more efficient</span>
<a name="line-12"></a> <span class='hs-comment'>-- Wadler-style desugaring</span>
<a name="line-13"></a> <span class='hs-varop'>||</span> <span class='hs-varid'>isParallelComp</span> <span class='hs-varid'>quals</span>
<a name="line-14"></a> <span class='hs-comment'>-- Foldr-style desugaring can't handle parallel list comprehensions</span>
<a name="line-15"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>deListComp</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkNilExpr</span> <span class='hs-varid'>elt_ty</span><span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>mkBuildExpr</span> <span class='hs-varid'>elt_ty</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>c</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>dfListComp</span> <span class='hs-varid'>c</span> <span class='hs-varid'>n</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span>
<a name="line-17"></a> <span class='hs-comment'>-- Foldr/build should be enabled, so desugar </span>
<a name="line-18"></a> <span class='hs-comment'>-- into foldrs and builds</span>
<a name="line-19"></a>
<a name="line-20"></a> <span class='hs-keyword'>where</span>
<a name="line-21"></a> <span class='hs-comment'>-- We must test for ParStmt anywhere, not just at the head, because an extension</span>
<a name="line-22"></a> <span class='hs-comment'>-- to list comprehensions would be to add brackets to specify the associativity</span>
<a name="line-23"></a> <span class='hs-comment'>-- of qualifier lists. This is really easy to do by adding extra ParStmts into the</span>
<a name="line-24"></a> <span class='hs-comment'>-- mix of possibly a single element in length, so we do this to leave the possibility open</span>
<a name="line-25"></a> <span class='hs-varid'>isParallelComp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>any</span> <span class='hs-varid'>isParallelStmt</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-varid'>isParallelStmt</span> <span class='hs-layout'>(</span><span class='hs-conid'>ParStmt</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-28"></a> <span class='hs-varid'>isParallelStmt</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-29"></a>
<a name="line-30"></a>
<a name="line-31"></a><a name="dsInnerListComp"></a><span class='hs-comment'>-- This function lets you desugar a inner list comprehension and a list of the binders</span>
<a name="line-32"></a><span class='hs-comment'>-- of that comprehension that we need in the outer comprehension into such an expression</span>
<a name="line-33"></a><span class='hs-comment'>-- and the type of the elements that it outputs (tuples of binders)</span>
<a name="line-34"></a><span class='hs-definition'>dsInnerListComp</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>LStmt</span> <span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span>
<a name="line-35"></a><span class='hs-definition'>dsInnerListComp</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts</span><span class='hs-layout'>,</span> <span class='hs-varid'>bndrs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-36"></a> <span class='hs-varid'>expr</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsListComp</span> <span class='hs-varid'>stmts</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkBigLHsVarTup</span> <span class='hs-varid'>bndrs</span><span class='hs-layout'>)</span> <span class='hs-varid'>bndrs_tuple_type</span>
<a name="line-37"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>expr</span><span class='hs-layout'>,</span> <span class='hs-varid'>bndrs_tuple_type</span><span class='hs-layout'>)</span>
<a name="line-38"></a> <span class='hs-keyword'>where</span>
<a name="line-39"></a> <span class='hs-varid'>bndrs_types</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>bndrs</span>
<a name="line-40"></a> <span class='hs-varid'>bndrs_tuple_type</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBigCoreTupTy</span> <span class='hs-varid'>bndrs_types</span>
<a name="line-41"></a>
<a name="line-42"></a>
<a name="line-43"></a><a name="dsTransformStmt"></a><span class='hs-comment'>-- This function factors out commonality between the desugaring strategies for TransformStmt.</span>
<a name="line-44"></a><span class='hs-comment'>-- Given such a statement it gives you back an expression representing how to compute the transformed</span>
<a name="line-45"></a><span class='hs-comment'>-- list and the tuple that you need to bind from that list in order to proceed with your desugaring</span>
<a name="line-46"></a><span class='hs-definition'>dsTransformStmt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Stmt</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>,</span> <span class='hs-conid'>LPat</span> <span class='hs-conid'>Id</span><span class='hs-layout'>)</span>
<a name="line-47"></a><span class='hs-definition'>dsTransformStmt</span> <span class='hs-layout'>(</span><span class='hs-conid'>TransformStmt</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts</span><span class='hs-layout'>,</span> <span class='hs-varid'>binders</span><span class='hs-layout'>)</span> <span class='hs-varid'>usingExpr</span> <span class='hs-varid'>maybeByExpr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-48"></a> <span class='hs-layout'>(</span><span class='hs-varid'>expr</span><span class='hs-layout'>,</span> <span class='hs-varid'>binders_tuple_type</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsInnerListComp</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts</span><span class='hs-layout'>,</span> <span class='hs-varid'>binders</span><span class='hs-layout'>)</span>
<a name="line-49"></a> <span class='hs-varid'>usingExpr'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>usingExpr</span>
<a name="line-50"></a>
<a name="line-51"></a> <span class='hs-varid'>using_args</span> <span class='hs-keyglyph'><-</span>
<a name="line-52"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>maybeByExpr</span> <span class='hs-keyword'>of</span>
<a name="line-53"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>expr</span><span class='hs-keyglyph'>]</span>
<a name="line-54"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>byExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-55"></a> <span class='hs-varid'>byExpr'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>byExpr</span>
<a name="line-56"></a>
<a name="line-57"></a> <span class='hs-varid'>us</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newUniqueSupply</span>
<a name="line-58"></a> <span class='hs-keyglyph'>[</span><span class='hs-varid'>tuple_binder</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalsDs</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>binders_tuple_type</span><span class='hs-keyglyph'>]</span>
<a name="line-59"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>byExprWrapper</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTupleCase</span> <span class='hs-varid'>us</span> <span class='hs-varid'>binders</span> <span class='hs-varid'>byExpr'</span> <span class='hs-varid'>tuple_binder</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>tuple_binder</span><span class='hs-layout'>)</span>
<a name="line-60"></a>
<a name="line-61"></a> <span class='hs-varid'>return</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Lam</span> <span class='hs-varid'>tuple_binder</span> <span class='hs-varid'>byExprWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>expr</span><span class='hs-keyglyph'>]</span>
<a name="line-62"></a>
<a name="line-63"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>inner_list_expr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkApps</span> <span class='hs-varid'>usingExpr'</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>binders_tuple_type</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>using_args</span><span class='hs-layout'>)</span>
<a name="line-64"></a>
<a name="line-65"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>pat</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBigLHsVarPatTup</span> <span class='hs-varid'>binders</span>
<a name="line-66"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>inner_list_expr</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-67"></a>
<a name="line-68"></a><a name="dsGroupStmt"></a><span class='hs-comment'>-- This function factors out commonality between the desugaring strategies for GroupStmt.</span>
<a name="line-69"></a><span class='hs-comment'>-- Given such a statement it gives you back an expression representing how to compute the transformed</span>
<a name="line-70"></a><span class='hs-comment'>-- list and the tuple that you need to bind from that list in order to proceed with your desugaring</span>
<a name="line-71"></a><span class='hs-definition'>dsGroupStmt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Stmt</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>,</span> <span class='hs-conid'>LPat</span> <span class='hs-conid'>Id</span><span class='hs-layout'>)</span>
<a name="line-72"></a><span class='hs-definition'>dsGroupStmt</span> <span class='hs-layout'>(</span><span class='hs-conid'>GroupStmt</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts</span><span class='hs-layout'>,</span> <span class='hs-varid'>binderMap</span><span class='hs-layout'>)</span> <span class='hs-varid'>groupByClause</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-73"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromBinders</span><span class='hs-layout'>,</span> <span class='hs-varid'>toBinders</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unzip</span> <span class='hs-varid'>binderMap</span>
<a name="line-74"></a>
<a name="line-75"></a> <span class='hs-varid'>fromBindersTypes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>fromBinders</span>
<a name="line-76"></a> <span class='hs-varid'>toBindersTypes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>toBinders</span>
<a name="line-77"></a>
<a name="line-78"></a> <span class='hs-varid'>toBindersTupleType</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBigCoreTupTy</span> <span class='hs-varid'>toBindersTypes</span>
<a name="line-79"></a>
<a name="line-80"></a> <span class='hs-comment'>-- Desugar an inner comprehension which outputs a list of tuples of the "from" binders</span>
<a name="line-81"></a> <span class='hs-layout'>(</span><span class='hs-varid'>expr</span><span class='hs-layout'>,</span> <span class='hs-varid'>fromBindersTupleType</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsInnerListComp</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts</span><span class='hs-layout'>,</span> <span class='hs-varid'>fromBinders</span><span class='hs-layout'>)</span>
<a name="line-82"></a>
<a name="line-83"></a> <span class='hs-comment'>-- Work out what arguments should be supplied to that expression: i.e. is an extraction</span>
<a name="line-84"></a> <span class='hs-comment'>-- function required? If so, create that desugared function and add to arguments</span>
<a name="line-85"></a> <span class='hs-layout'>(</span><span class='hs-varid'>usingExpr'</span><span class='hs-layout'>,</span> <span class='hs-varid'>usingArgs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span>
<a name="line-86"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>groupByClause</span> <span class='hs-keyword'>of</span>
<a name="line-87"></a> <span class='hs-conid'>GroupByNothing</span> <span class='hs-varid'>usingExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>liftM2</span> <span class='hs-conid'>(,)</span> <span class='hs-layout'>(</span><span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>usingExpr</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>expr</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-88"></a> <span class='hs-conid'>GroupBySomething</span> <span class='hs-varid'>usingExpr</span> <span class='hs-varid'>byExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-89"></a> <span class='hs-varid'>usingExpr'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>either</span> <span class='hs-varid'>id</span> <span class='hs-varid'>noLoc</span> <span class='hs-varid'>usingExpr</span><span class='hs-layout'>)</span>
<a name="line-90"></a>
<a name="line-91"></a> <span class='hs-varid'>byExpr'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>byExpr</span>
<a name="line-92"></a>
<a name="line-93"></a> <span class='hs-varid'>us</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newUniqueSupply</span>
<a name="line-94"></a> <span class='hs-keyglyph'>[</span><span class='hs-varid'>fromBindersTuple</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalsDs</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>fromBindersTupleType</span><span class='hs-keyglyph'>]</span>
<a name="line-95"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>byExprWrapper</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTupleCase</span> <span class='hs-varid'>us</span> <span class='hs-varid'>fromBinders</span> <span class='hs-varid'>byExpr'</span> <span class='hs-varid'>fromBindersTuple</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>fromBindersTuple</span><span class='hs-layout'>)</span>
<a name="line-96"></a>
<a name="line-97"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>usingExpr'</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Lam</span> <span class='hs-varid'>fromBindersTuple</span> <span class='hs-varid'>byExprWrapper</span><span class='hs-layout'>,</span> <span class='hs-varid'>expr</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-98"></a>
<a name="line-99"></a> <span class='hs-comment'>-- Create an unzip function for the appropriate arity and element types and find "map"</span>
<a name="line-100"></a> <span class='hs-layout'>(</span><span class='hs-varid'>unzip_fn</span><span class='hs-layout'>,</span> <span class='hs-varid'>unzip_rhs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mkUnzipBind</span> <span class='hs-varid'>fromBindersTypes</span>
<a name="line-101"></a> <span class='hs-varid'>map_id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLookupGlobalId</span> <span class='hs-varid'>mapName</span>
<a name="line-102"></a>
<a name="line-103"></a> <span class='hs-comment'>-- Generate the expressions to build the grouped list</span>
<a name="line-104"></a> <span class='hs-keyword'>let</span> <span class='hs-comment'>-- First we apply the grouping function to the inner list</span>
<a name="line-105"></a> <span class='hs-varid'>inner_list_expr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkApps</span> <span class='hs-varid'>usingExpr'</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>fromBindersTupleType</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>usingArgs</span><span class='hs-layout'>)</span>
<a name="line-106"></a> <span class='hs-comment'>-- Then we map our "unzip" across it to turn the lists of tuples into tuples of lists</span>
<a name="line-107"></a> <span class='hs-comment'>-- We make sure we instantiate the type variable "a" to be a list of "from" tuples and</span>
<a name="line-108"></a> <span class='hs-comment'>-- the "b" to be a tuple of "to" lists!</span>
<a name="line-109"></a> <span class='hs-varid'>unzipped_inner_list_expr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>map_id</span><span class='hs-layout'>)</span>
<a name="line-110"></a> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkListTy</span> <span class='hs-varid'>fromBindersTupleType</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span> <span class='hs-varid'>toBindersTupleType</span><span class='hs-layout'>,</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>unzip_fn</span><span class='hs-layout'>,</span> <span class='hs-varid'>inner_list_expr</span><span class='hs-keyglyph'>]</span>
<a name="line-111"></a> <span class='hs-comment'>-- Then finally we bind the unzip function around that expression</span>
<a name="line-112"></a> <span class='hs-varid'>bound_unzipped_inner_list_expr</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Let</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rec</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>unzip_fn</span><span class='hs-layout'>,</span> <span class='hs-varid'>unzip_rhs</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-varid'>unzipped_inner_list_expr</span>
<a name="line-113"></a>
<a name="line-114"></a> <span class='hs-comment'>-- Build a pattern that ensures the consumer binds into the NEW binders, which hold lists rather than single values</span>
<a name="line-115"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>pat</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBigLHsVarPatTup</span> <span class='hs-varid'>toBinders</span>
<a name="line-116"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>bound_unzipped_inner_list_expr</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span>
<a name="line-117"></a>
</pre>\end{code}
%************************************************************************
%* *
\subsection[DsListComp-ordinary]{Ordinary desugaring of list comprehensions}
%* *
%************************************************************************
Just as in Phil's chapter~7 in SLPJ, using the rules for
optimally-compiled list comprehensions. This is what Kevin followed
as well, and I quite happily do the same. The TQ translation scheme
transforms a list of qualifiers (either boolean expressions or
generators) into a single expression which implements the list
comprehension. Because we are generating 2nd-order polymorphic
lambda-calculus, calls to NIL and CONS must be applied to a type
argument, as well as their usual value arguments.
\begin{verbatim}
TE << [ e | qs ] >> = TQ << [ e | qs ] ++ Nil (typeOf e) >>
(Rule C)
TQ << [ e | ] ++ L >> = Cons (typeOf e) TE <<e>> TE <<L>>
(Rule B)
TQ << [ e | b , qs ] ++ L >> =
if TE << b >> then TQ << [ e | qs ] ++ L >> else TE << L >>
(Rule A')
TQ << [ e | p <- L1, qs ] ++ L2 >> =
letrec
h = \ u1 ->
case u1 of
[] -> TE << L2 >>
(u2 : u3) ->
(( \ TE << p >> -> ( TQ << [e | qs] ++ (h u3) >> )) u2)
[] (h u3)
in
h ( TE << L1 >> )
"h", "u1", "u2", and "u3" are new variables.
\end{verbatim}
@deListComp@ is the TQ translation scheme. Roughly speaking, @dsExpr@
is the TE translation scheme. Note that we carry around the @L@ list
already desugared. @dsListComp@ does the top TE rule mentioned above.
To the above, we add an additional rule to deal with parallel list
comprehensions. The translation goes roughly as follows:
[ e | p1 <- e11, let v1 = e12, p2 <- e13
| q1 <- e21, let v2 = e22, q2 <- e23]
=>
[ e | ((x1, .., xn), (y1, ..., ym)) <-
zip [(x1,..,xn) | p1 <- e11, let v1 = e12, p2 <- e13]
[(y1,..,ym) | q1 <- e21, let v2 = e22, q2 <- e23]]
where (x1, .., xn) are the variables bound in p1, v1, p2
(y1, .., ym) are the variables bound in q1, v2, q2
In the translation below, the ParStmt branch translates each parallel branch
into a sub-comprehension, and desugars each independently. The resulting lists
are fed to a zip function, we create a binding for all the variables bound in all
the comprehensions, and then we hand things off the the desugarer for bindings.
The zip function is generated here a) because it's small, and b) because then we
don't have to deal with arbitrary limits on the number of zip functions in the
prelude, nor which library the zip function came from.
The introduced tuples are Boxed, but only because I couldn't get it to work
with the Unboxed variety.
\begin{code}
<pre><a name="line-1"></a>
<a name="line-2"></a><a name="deListComp"></a><span class='hs-definition'>deListComp</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Stmt</span> <span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-3"></a>
<a name="line-4"></a><span class='hs-definition'>deListComp</span> <span class='hs-layout'>(</span><span class='hs-conid'>ParStmt</span> <span class='hs-varid'>stmtss_w_bndrs</span> <span class='hs-conop'>:</span> <span class='hs-varid'>quals</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-varid'>list</span>
<a name="line-5"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-6"></a> <span class='hs-varid'>exps_and_qual_tys</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>dsInnerListComp</span> <span class='hs-varid'>stmtss_w_bndrs</span>
<a name="line-7"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>exps</span><span class='hs-layout'>,</span> <span class='hs-varid'>qual_tys</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unzip</span> <span class='hs-varid'>exps_and_qual_tys</span>
<a name="line-8"></a>
<a name="line-9"></a> <span class='hs-layout'>(</span><span class='hs-varid'>zip_fn</span><span class='hs-layout'>,</span> <span class='hs-varid'>zip_rhs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mkZipBind</span> <span class='hs-varid'>qual_tys</span>
<a name="line-10"></a>
<a name="line-11"></a> <span class='hs-comment'>-- Deal with [e | pat <- zip l1 .. ln] in example above</span>
<a name="line-12"></a> <span class='hs-varid'>deBindComp</span> <span class='hs-varid'>pat</span> <span class='hs-layout'>(</span><span class='hs-conid'>Let</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rec</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>zip_fn</span><span class='hs-layout'>,</span> <span class='hs-varid'>zip_rhs</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>zip_fn</span><span class='hs-layout'>)</span> <span class='hs-varid'>exps</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-13"></a> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span> <span class='hs-varid'>list</span>
<a name="line-14"></a>
<a name="line-15"></a> <span class='hs-keyword'>where</span>
<a name="line-16"></a> <span class='hs-varid'>bndrs_s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>snd</span> <span class='hs-varid'>stmtss_w_bndrs</span>
<a name="line-17"></a>
<a name="line-18"></a> <span class='hs-comment'>-- pat is the pattern ((x1,..,xn), (y1,..,ym)) in the example above</span>
<a name="line-19"></a> <span class='hs-varid'>pat</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBigLHsPatTup</span> <span class='hs-varid'>pats</span>
<a name="line-20"></a> <span class='hs-varid'>pats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>mkBigLHsVarPatTup</span> <span class='hs-varid'>bndrs_s</span>
<a name="line-21"></a>
<a name="line-22"></a> <span class='hs-comment'>-- Last: the one to return</span>
<a name="line-23"></a><span class='hs-definition'>deListComp</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>body</span> <span class='hs-varid'>list</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-comment'>-- Figure 7.4, SLPJ, p 135, rule C above</span>
<a name="line-24"></a> <span class='hs-varid'>core_body</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>body</span>
<a name="line-25"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkConsExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>exprType</span> <span class='hs-varid'>core_body</span><span class='hs-layout'>)</span> <span class='hs-varid'>core_body</span> <span class='hs-varid'>list</span><span class='hs-layout'>)</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-comment'>-- Non-last: must be a guard</span>
<a name="line-28"></a><span class='hs-definition'>deListComp</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExprStmt</span> <span class='hs-varid'>guard</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conop'>:</span> <span class='hs-varid'>quals</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-varid'>list</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-comment'>-- rule B above</span>
<a name="line-29"></a> <span class='hs-varid'>core_guard</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>guard</span>
<a name="line-30"></a> <span class='hs-varid'>core_rest</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>deListComp</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span> <span class='hs-varid'>list</span>
<a name="line-31"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkIfThenElse</span> <span class='hs-varid'>core_guard</span> <span class='hs-varid'>core_rest</span> <span class='hs-varid'>list</span><span class='hs-layout'>)</span>
<a name="line-32"></a>
<a name="line-33"></a><span class='hs-comment'>-- [e | let B, qs] = let B in [e | qs]</span>
<a name="line-34"></a><span class='hs-definition'>deListComp</span> <span class='hs-layout'>(</span><span class='hs-conid'>LetStmt</span> <span class='hs-varid'>binds</span> <span class='hs-conop'>:</span> <span class='hs-varid'>quals</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-varid'>list</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-35"></a> <span class='hs-varid'>core_rest</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>deListComp</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span> <span class='hs-varid'>list</span>
<a name="line-36"></a> <span class='hs-varid'>dsLocalBinds</span> <span class='hs-varid'>binds</span> <span class='hs-varid'>core_rest</span>
<a name="line-37"></a>
<a name="line-38"></a><span class='hs-definition'>deListComp</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmt</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>TransformStmt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>quals</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-varid'>list</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-39"></a> <span class='hs-layout'>(</span><span class='hs-varid'>inner_list_expr</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsTransformStmt</span> <span class='hs-varid'>stmt</span>
<a name="line-40"></a> <span class='hs-varid'>deBindComp</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>inner_list_expr</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span> <span class='hs-varid'>list</span>
<a name="line-41"></a>
<a name="line-42"></a><span class='hs-definition'>deListComp</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmt</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>GroupStmt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>quals</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-varid'>list</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-43"></a> <span class='hs-layout'>(</span><span class='hs-varid'>inner_list_expr</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsGroupStmt</span> <span class='hs-varid'>stmt</span>
<a name="line-44"></a> <span class='hs-varid'>deBindComp</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>inner_list_expr</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span> <span class='hs-varid'>list</span>
<a name="line-45"></a>
<a name="line-46"></a><span class='hs-definition'>deListComp</span> <span class='hs-layout'>(</span><span class='hs-conid'>BindStmt</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>list1</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conop'>:</span> <span class='hs-varid'>quals</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-varid'>core_list2</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-comment'>-- rule A' above</span>
<a name="line-47"></a> <span class='hs-varid'>core_list1</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>list1</span>
<a name="line-48"></a> <span class='hs-varid'>deBindComp</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>core_list1</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span> <span class='hs-varid'>core_list2</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="deBindComp"></a><span class='hs-definition'>deBindComp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OutPat</span> <span class='hs-conid'>Id</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Stmt</span> <span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Id</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-6"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Expr</span> <span class='hs-conid'>Id</span><span class='hs-layout'>)</span>
<a name="line-7"></a><span class='hs-definition'>deBindComp</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>core_list1</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span> <span class='hs-varid'>core_list2</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-8"></a> <span class='hs-keyword'>let</span>
<a name="line-9"></a> <span class='hs-varid'>u3_ty</span><span class='hs-keyglyph'>@</span><span class='hs-varid'>u1_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>exprType</span> <span class='hs-varid'>core_list1</span> <span class='hs-comment'>-- two names, same thing</span>
<a name="line-10"></a>
<a name="line-11"></a> <span class='hs-comment'>-- u1_ty is a [alpha] type, and u2_ty = alpha</span>
<a name="line-12"></a> <span class='hs-varid'>u2_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hsLPatType</span> <span class='hs-varid'>pat</span>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-varid'>res_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>exprType</span> <span class='hs-varid'>core_list2</span>
<a name="line-15"></a> <span class='hs-varid'>h_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>u1_ty</span> <span class='hs-varop'>`mkFunTy`</span> <span class='hs-varid'>res_ty</span>
<a name="line-16"></a>
<a name="line-17"></a> <span class='hs-keyglyph'>[</span><span class='hs-varid'>h</span><span class='hs-layout'>,</span> <span class='hs-varid'>u1</span><span class='hs-layout'>,</span> <span class='hs-varid'>u2</span><span class='hs-layout'>,</span> <span class='hs-varid'>u3</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalsDs</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>h_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>u1_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>u2_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>u3_ty</span><span class='hs-keyglyph'>]</span>
<a name="line-18"></a>
<a name="line-19"></a> <span class='hs-comment'>-- the "fail" value ...</span>
<a name="line-20"></a> <span class='hs-keyword'>let</span>
<a name="line-21"></a> <span class='hs-varid'>core_fail</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>App</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>u3</span><span class='hs-layout'>)</span>
<a name="line-22"></a> <span class='hs-varid'>letrec_body</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>App</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span> <span class='hs-varid'>core_list1</span>
<a name="line-23"></a>
<a name="line-24"></a> <span class='hs-varid'>rest_expr</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>deListComp</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span> <span class='hs-varid'>core_fail</span>
<a name="line-25"></a> <span class='hs-varid'>core_match</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>matchSimply</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>u2</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>StmtCtxt</span> <span class='hs-conid'>ListComp</span><span class='hs-layout'>)</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>rest_expr</span> <span class='hs-varid'>core_fail</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-keyword'>let</span>
<a name="line-28"></a> <span class='hs-varid'>rhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Lam</span> <span class='hs-varid'>u1</span> <span class='hs-varop'>$</span>
<a name="line-29"></a> <span class='hs-conid'>Case</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>u1</span><span class='hs-layout'>)</span> <span class='hs-varid'>u1</span> <span class='hs-varid'>res_ty</span>
<a name="line-30"></a> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>DataAlt</span> <span class='hs-varid'>nilDataCon</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>core_list2</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-31"></a> <span class='hs-layout'>(</span><span class='hs-conid'>DataAlt</span> <span class='hs-varid'>consDataCon</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>u2</span><span class='hs-layout'>,</span> <span class='hs-varid'>u3</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-varid'>core_match</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-32"></a> <span class='hs-comment'>-- Increasing order of tag</span>
<a name="line-33"></a>
<a name="line-34"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Let</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rec</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>h</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-varid'>letrec_body</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[DsListComp-foldr-build]{Foldr/Build desugaring of list comprehensions}
%* *
%************************************************************************
@dfListComp@ are the rules used with foldr/build turned on:
\begin{verbatim}
TE[ e | ] c n = c e n
TE[ e | b , q ] c n = if b then TE[ e | q ] c n else n
TE[ e | p <- l , q ] c n = let
f = \ x b -> case x of
p -> TE[ e | q ] c b
_ -> b
in
foldr f n l
\end{verbatim}
\begin{code}
<pre><a name="line-1"></a><a name="dfListComp"></a><span class='hs-definition'>dfListComp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- 'c' and 'n'</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Stmt</span> <span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- the rest of the qual's</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Id</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-5"></a>
<a name="line-6"></a> <span class='hs-comment'>-- Last: the one to return</span>
<a name="line-7"></a><span class='hs-definition'>dfListComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>n_id</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>body</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-8"></a> <span class='hs-varid'>core_body</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>body</span>
<a name="line-9"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>c_id</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>core_body</span><span class='hs-layout'>,</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>n_id</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-10"></a>
<a name="line-11"></a> <span class='hs-comment'>-- Non-last: must be a guard</span>
<a name="line-12"></a><span class='hs-definition'>dfListComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>n_id</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExprStmt</span> <span class='hs-varid'>guard</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conop'>:</span> <span class='hs-varid'>quals</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-13"></a> <span class='hs-varid'>core_guard</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>guard</span>
<a name="line-14"></a> <span class='hs-varid'>core_rest</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dfListComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>n_id</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span>
<a name="line-15"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkIfThenElse</span> <span class='hs-varid'>core_guard</span> <span class='hs-varid'>core_rest</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>n_id</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-16"></a>
<a name="line-17"></a><span class='hs-definition'>dfListComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>n_id</span> <span class='hs-layout'>(</span><span class='hs-conid'>LetStmt</span> <span class='hs-varid'>binds</span> <span class='hs-conop'>:</span> <span class='hs-varid'>quals</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-18"></a> <span class='hs-comment'>-- new in 1.3, local bindings</span>
<a name="line-19"></a> <span class='hs-varid'>core_rest</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dfListComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>n_id</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span>
<a name="line-20"></a> <span class='hs-varid'>dsLocalBinds</span> <span class='hs-varid'>binds</span> <span class='hs-varid'>core_rest</span>
<a name="line-21"></a>
<a name="line-22"></a><span class='hs-definition'>dfListComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>n_id</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmt</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>TransformStmt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>quals</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-23"></a> <span class='hs-layout'>(</span><span class='hs-varid'>inner_list_expr</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsTransformStmt</span> <span class='hs-varid'>stmt</span>
<a name="line-24"></a> <span class='hs-comment'>-- Anyway, we bind the newly transformed list via the generic binding function</span>
<a name="line-25"></a> <span class='hs-varid'>dfBindComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>n_id</span> <span class='hs-layout'>(</span><span class='hs-varid'>pat</span><span class='hs-layout'>,</span> <span class='hs-varid'>inner_list_expr</span><span class='hs-layout'>)</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span>
<a name="line-26"></a>
<a name="line-27"></a><span class='hs-definition'>dfListComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>n_id</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmt</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>GroupStmt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>quals</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-28"></a> <span class='hs-layout'>(</span><span class='hs-varid'>inner_list_expr</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsGroupStmt</span> <span class='hs-varid'>stmt</span>
<a name="line-29"></a> <span class='hs-comment'>-- Anyway, we bind the newly grouped list via the generic binding function</span>
<a name="line-30"></a> <span class='hs-varid'>dfBindComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>n_id</span> <span class='hs-layout'>(</span><span class='hs-varid'>pat</span><span class='hs-layout'>,</span> <span class='hs-varid'>inner_list_expr</span><span class='hs-layout'>)</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span>
<a name="line-31"></a>
<a name="line-32"></a><span class='hs-definition'>dfListComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>n_id</span> <span class='hs-layout'>(</span><span class='hs-conid'>BindStmt</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>list1</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conop'>:</span> <span class='hs-varid'>quals</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-33"></a> <span class='hs-comment'>-- evaluate the two lists</span>
<a name="line-34"></a> <span class='hs-varid'>core_list1</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>list1</span>
<a name="line-35"></a>
<a name="line-36"></a> <span class='hs-comment'>-- Do the rest of the work in the generic binding builder</span>
<a name="line-37"></a> <span class='hs-varid'>dfBindComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>n_id</span> <span class='hs-layout'>(</span><span class='hs-varid'>pat</span><span class='hs-layout'>,</span> <span class='hs-varid'>core_list1</span><span class='hs-layout'>)</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span>
<a name="line-38"></a>
<a name="line-39"></a><a name="dfBindComp"></a><span class='hs-definition'>dfBindComp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- 'c' and 'n'</span>
<a name="line-40"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>LPat</span> <span class='hs-conid'>Id</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span>
<a name="line-41"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Stmt</span> <span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- the rest of the qual's</span>
<a name="line-42"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Id</span>
<a name="line-43"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-44"></a><span class='hs-definition'>dfBindComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>n_id</span> <span class='hs-layout'>(</span><span class='hs-varid'>pat</span><span class='hs-layout'>,</span> <span class='hs-varid'>core_list1</span><span class='hs-layout'>)</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-45"></a> <span class='hs-comment'>-- find the required type</span>
<a name="line-46"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>x_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hsLPatType</span> <span class='hs-varid'>pat</span>
<a name="line-47"></a> <span class='hs-varid'>b_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>n_id</span>
<a name="line-48"></a>
<a name="line-49"></a> <span class='hs-comment'>-- create some new local id's</span>
<a name="line-50"></a> <span class='hs-keyglyph'>[</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>x</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalsDs</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>b_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>x_ty</span><span class='hs-keyglyph'>]</span>
<a name="line-51"></a>
<a name="line-52"></a> <span class='hs-comment'>-- build rest of the comprehesion</span>
<a name="line-53"></a> <span class='hs-varid'>core_rest</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dfListComp</span> <span class='hs-varid'>c_id</span> <span class='hs-varid'>b</span> <span class='hs-varid'>quals</span> <span class='hs-varid'>body</span>
<a name="line-54"></a>
<a name="line-55"></a> <span class='hs-comment'>-- build the pattern match</span>
<a name="line-56"></a> <span class='hs-varid'>core_expr</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>matchSimply</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>StmtCtxt</span> <span class='hs-conid'>ListComp</span><span class='hs-layout'>)</span>
<a name="line-57"></a> <span class='hs-varid'>pat</span> <span class='hs-varid'>core_rest</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span>
<a name="line-58"></a>
<a name="line-59"></a> <span class='hs-comment'>-- now build the outermost foldr, and return</span>
<a name="line-60"></a> <span class='hs-varid'>mkFoldrExpr</span> <span class='hs-varid'>x_ty</span> <span class='hs-varid'>b_ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkLams</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span> <span class='hs-varid'>b</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>core_expr</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>n_id</span><span class='hs-layout'>)</span> <span class='hs-varid'>core_list1</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[DsFunGeneration]{Generation of zip/unzip functions for use in desugaring}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a>
<a name="line-2"></a><a name="mkZipBind"></a><span class='hs-definition'>mkZipBind</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'>DsM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span>
<a name="line-3"></a><span class='hs-comment'>-- mkZipBind [t1, t2] </span>
<a name="line-4"></a><span class='hs-comment'>-- = (zip, \as1:[t1] as2:[t2] </span>
<a name="line-5"></a><span class='hs-comment'>-- -> case as1 of </span>
<a name="line-6"></a><span class='hs-comment'>-- [] -> []</span>
<a name="line-7"></a><span class='hs-comment'>-- (a1:as'1) -> case as2 of</span>
<a name="line-8"></a><span class='hs-comment'>-- [] -> []</span>
<a name="line-9"></a><span class='hs-comment'>-- (a2:as'2) -> (a1, a2) : zip as'1 as'2)]</span>
<a name="line-10"></a>
<a name="line-11"></a><span class='hs-definition'>mkZipBind</span> <span class='hs-varid'>elt_tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-12"></a> <span class='hs-varid'>ass</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>elt_list_tys</span>
<a name="line-13"></a> <span class='hs-varid'>as'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>elt_tys</span>
<a name="line-14"></a> <span class='hs-varid'>as's</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>elt_list_tys</span>
<a name="line-15"></a>
<a name="line-16"></a> <span class='hs-varid'>zip_fn</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>zip_fn_ty</span>
<a name="line-17"></a>
<a name="line-18"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>inner_rhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkConsExpr</span> <span class='hs-varid'>elt_tuple_ty</span>
<a name="line-19"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkBigCoreVarTup</span> <span class='hs-varid'>as'</span><span class='hs-layout'>)</span>
<a name="line-20"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkVarApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>zip_fn</span><span class='hs-layout'>)</span> <span class='hs-varid'>as's</span><span class='hs-layout'>)</span>
<a name="line-21"></a> <span class='hs-varid'>zip_body</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-varid'>mk_case</span> <span class='hs-varid'>inner_rhs</span> <span class='hs-layout'>(</span><span class='hs-varid'>zip3</span> <span class='hs-varid'>ass</span> <span class='hs-varid'>as'</span> <span class='hs-varid'>as's</span><span class='hs-layout'>)</span>
<a name="line-22"></a>
<a name="line-23"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>zip_fn</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkLams</span> <span class='hs-varid'>ass</span> <span class='hs-varid'>zip_body</span><span class='hs-layout'>)</span>
<a name="line-24"></a> <span class='hs-keyword'>where</span>
<a name="line-25"></a> <span class='hs-varid'>elt_list_tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>mkListTy</span> <span class='hs-varid'>elt_tys</span>
<a name="line-26"></a> <span class='hs-varid'>elt_tuple_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBigCoreTupTy</span> <span class='hs-varid'>elt_tys</span>
<a name="line-27"></a> <span class='hs-varid'>elt_tuple_list_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkListTy</span> <span class='hs-varid'>elt_tuple_ty</span>
<a name="line-28"></a>
<a name="line-29"></a> <span class='hs-varid'>zip_fn_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkFunTys</span> <span class='hs-varid'>elt_list_tys</span> <span class='hs-varid'>elt_tuple_list_ty</span>
<a name="line-30"></a>
<a name="line-31"></a> <span class='hs-varid'>mk_case</span> <span class='hs-layout'>(</span><span class='hs-keyword'>as</span><span class='hs-layout'>,</span> <span class='hs-varid'>a'</span><span class='hs-layout'>,</span> <span class='hs-varid'>as'</span><span class='hs-layout'>)</span> <span class='hs-varid'>rest</span>
<a name="line-32"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Case</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-keyword'>as</span><span class='hs-layout'>)</span> <span class='hs-keyword'>as</span> <span class='hs-varid'>elt_tuple_list_ty</span>
<a name="line-33"></a> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>DataAlt</span> <span class='hs-varid'>nilDataCon</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkNilExpr</span> <span class='hs-varid'>elt_tuple_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-34"></a> <span class='hs-layout'>(</span><span class='hs-conid'>DataAlt</span> <span class='hs-varid'>consDataCon</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>a'</span><span class='hs-layout'>,</span> <span class='hs-varid'>as'</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-varid'>rest</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-35"></a> <span class='hs-comment'>-- Increasing order of tag</span>
<a name="line-36"></a>
<a name="line-37"></a>
<a name="line-38"></a><a name="mkUnzipBind"></a><span class='hs-definition'>mkUnzipBind</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'>DsM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span>
<a name="line-39"></a><span class='hs-comment'>-- mkUnzipBind [t1, t2] </span>
<a name="line-40"></a><span class='hs-comment'>-- = (unzip, \ys :: [(t1, t2)] -> foldr (\ax :: (t1, t2) axs :: ([t1], [t2])</span>
<a name="line-41"></a><span class='hs-comment'>-- -> case ax of</span>
<a name="line-42"></a><span class='hs-comment'>-- (x1, x2) -> case axs of</span>
<a name="line-43"></a><span class='hs-comment'>-- (xs1, xs2) -> (x1 : xs1, x2 : xs2))</span>
<a name="line-44"></a><span class='hs-comment'>-- ([], [])</span>
<a name="line-45"></a><span class='hs-comment'>-- ys)</span>
<a name="line-46"></a><span class='hs-comment'>-- </span>
<a name="line-47"></a><span class='hs-comment'>-- We use foldr here in all cases, even if rules are turned off, because we may as well!</span>
<a name="line-48"></a><span class='hs-definition'>mkUnzipBind</span> <span class='hs-varid'>elt_tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-49"></a> <span class='hs-varid'>ax</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>elt_tuple_ty</span>
<a name="line-50"></a> <span class='hs-varid'>axs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>elt_list_tuple_ty</span>
<a name="line-51"></a> <span class='hs-varid'>ys</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>elt_tuple_list_ty</span>
<a name="line-52"></a> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>elt_tys</span>
<a name="line-53"></a> <span class='hs-varid'>xss</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>elt_list_tys</span>
<a name="line-54"></a>
<a name="line-55"></a> <span class='hs-varid'>unzip_fn</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>unzip_fn_ty</span>
<a name="line-56"></a>
<a name="line-57"></a> <span class='hs-keyglyph'>[</span><span class='hs-varid'>us1</span><span class='hs-layout'>,</span> <span class='hs-varid'>us2</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>sequence</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>newUniqueSupply</span><span class='hs-layout'>,</span> <span class='hs-varid'>newUniqueSupply</span><span class='hs-keyglyph'>]</span>
<a name="line-58"></a>
<a name="line-59"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>nil_tuple</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBigCoreTup</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>mkNilExpr</span> <span class='hs-varid'>elt_tys</span><span class='hs-layout'>)</span>
<a name="line-60"></a>
<a name="line-61"></a> <span class='hs-varid'>concat_expressions</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>mkConcatExpression</span> <span class='hs-layout'>(</span><span class='hs-varid'>zip3</span> <span class='hs-varid'>elt_tys</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>xss</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-62"></a> <span class='hs-varid'>tupled_concat_expression</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBigCoreTup</span> <span class='hs-varid'>concat_expressions</span>
<a name="line-63"></a>
<a name="line-64"></a> <span class='hs-varid'>folder_body_inner_case</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTupleCase</span> <span class='hs-varid'>us1</span> <span class='hs-varid'>xss</span> <span class='hs-varid'>tupled_concat_expression</span> <span class='hs-varid'>axs</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>axs</span><span class='hs-layout'>)</span>
<a name="line-65"></a> <span class='hs-varid'>folder_body_outer_case</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTupleCase</span> <span class='hs-varid'>us2</span> <span class='hs-varid'>xs</span> <span class='hs-varid'>folder_body_inner_case</span> <span class='hs-varid'>ax</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>ax</span><span class='hs-layout'>)</span>
<a name="line-66"></a> <span class='hs-varid'>folder_body</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkLams</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ax</span><span class='hs-layout'>,</span> <span class='hs-varid'>axs</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>folder_body_outer_case</span>
<a name="line-67"></a>
<a name="line-68"></a> <span class='hs-varid'>unzip_body</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mkFoldrExpr</span> <span class='hs-varid'>elt_tuple_ty</span> <span class='hs-varid'>elt_list_tuple_ty</span> <span class='hs-varid'>folder_body</span> <span class='hs-varid'>nil_tuple</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>ys</span><span class='hs-layout'>)</span>
<a name="line-69"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>unzip_fn</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkLams</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ys</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>unzip_body</span><span class='hs-layout'>)</span>
<a name="line-70"></a> <span class='hs-keyword'>where</span>
<a name="line-71"></a> <span class='hs-varid'>elt_tuple_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBigCoreTupTy</span> <span class='hs-varid'>elt_tys</span>
<a name="line-72"></a> <span class='hs-varid'>elt_tuple_list_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkListTy</span> <span class='hs-varid'>elt_tuple_ty</span>
<a name="line-73"></a> <span class='hs-varid'>elt_list_tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>mkListTy</span> <span class='hs-varid'>elt_tys</span>
<a name="line-74"></a> <span class='hs-varid'>elt_list_tuple_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBigCoreTupTy</span> <span class='hs-varid'>elt_list_tys</span>
<a name="line-75"></a>
<a name="line-76"></a> <span class='hs-varid'>unzip_fn_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>elt_tuple_list_ty</span> <span class='hs-varop'>`mkFunTy`</span> <span class='hs-varid'>elt_list_tuple_ty</span>
<a name="line-77"></a>
<a name="line-78"></a> <span class='hs-varid'>mkConcatExpression</span> <span class='hs-layout'>(</span><span class='hs-varid'>list_element_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>head</span><span class='hs-layout'>,</span> <span class='hs-varid'>tail</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkConsExpr</span> <span class='hs-varid'>list_element_ty</span> <span class='hs-varid'>head</span> <span class='hs-varid'>tail</span>
<a name="line-79"></a>
<a name="line-80"></a>
<a name="line-81"></a>
</pre>\end{code}
%************************************************************************
%* *
\subsection[DsPArrComp]{Desugaring of array comprehensions}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a>
<a name="line-2"></a><a name="dsPArrComp"></a><span class='hs-comment'>-- entry point for desugaring a parallel array comprehension</span>
<a name="line-3"></a><span class='hs-comment'>--</span>
<a name="line-4"></a><span class='hs-comment'>-- [:e | qss:] = <<[:e | qss:]>> () [:():]</span>
<a name="line-5"></a><span class='hs-comment'>--</span>
<a name="line-6"></a><span class='hs-definition'>dsPArrComp</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Stmt</span> <span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span>
<a name="line-7"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Id</span>
<a name="line-8"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- Don't use; called with `undefined' below</span>
<a name="line-9"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-10"></a><span class='hs-definition'>dsPArrComp</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>ParStmt</span> <span class='hs-varid'>qss</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>body</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>-- parallel comprehension</span>
<a name="line-11"></a> <span class='hs-varid'>dePArrParComp</span> <span class='hs-varid'>qss</span> <span class='hs-varid'>body</span>
<a name="line-12"></a>
<a name="line-13"></a><span class='hs-comment'>-- Special case for simple generators:</span>
<a name="line-14"></a><span class='hs-comment'>--</span>
<a name="line-15"></a><span class='hs-comment'>-- <<[:e' | p <- e, qs:]>> = <<[: e' | qs :]>> p e</span>
<a name="line-16"></a><span class='hs-comment'>--</span>
<a name="line-17"></a><span class='hs-comment'>-- if matching again p cannot fail, or else</span>
<a name="line-18"></a><span class='hs-comment'>--</span>
<a name="line-19"></a><span class='hs-comment'>-- <<[:e' | p <- e, qs:]>> = </span>
<a name="line-20"></a><span class='hs-comment'>-- <<[:e' | qs:]>> p (filterP (\x -> case x of {p -> True; _ -> False}) e)</span>
<a name="line-21"></a><span class='hs-comment'>--</span>
<a name="line-22"></a><span class='hs-definition'>dsPArrComp</span> <span class='hs-layout'>(</span><span class='hs-conid'>BindStmt</span> <span class='hs-varid'>p</span> <span class='hs-varid'>e</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conop'>:</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-23"></a> <span class='hs-varid'>filterP</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLookupGlobalId</span> <span class='hs-varid'>filterPName</span>
<a name="line-24"></a> <span class='hs-varid'>ce</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>e</span>
<a name="line-25"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>ety'ce</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parrElemType</span> <span class='hs-varid'>ce</span>
<a name="line-26"></a> <span class='hs-varid'>false</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>falseDataConId</span>
<a name="line-27"></a> <span class='hs-varid'>true</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>trueDataConId</span>
<a name="line-28"></a> <span class='hs-varid'>v</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>ety'ce</span>
<a name="line-29"></a> <span class='hs-varid'>pred</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>matchSimply</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>StmtCtxt</span> <span class='hs-conid'>PArrComp</span><span class='hs-layout'>)</span> <span class='hs-varid'>p</span> <span class='hs-varid'>true</span> <span class='hs-varid'>false</span>
<a name="line-30"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>gen</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isIrrefutableHsPat</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ce</span>
<a name="line-31"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>filterP</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ety'ce</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkLams</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>v</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>pred</span><span class='hs-layout'>,</span> <span class='hs-varid'>ce</span><span class='hs-keyglyph'>]</span>
<a name="line-32"></a> <span class='hs-varid'>dePArrComp</span> <span class='hs-varid'>qs</span> <span class='hs-varid'>body</span> <span class='hs-varid'>p</span> <span class='hs-varid'>gen</span>
<a name="line-33"></a>
<a name="line-34"></a><span class='hs-definition'>dsPArrComp</span> <span class='hs-varid'>qs</span> <span class='hs-varid'>body</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-comment'>-- no ParStmt in `qs'</span>
<a name="line-35"></a> <span class='hs-varid'>sglP</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLookupGlobalId</span> <span class='hs-varid'>singletonPName</span>
<a name="line-36"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>unitArray</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>sglP</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span> <span class='hs-varid'>unitTy</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkCoreTup</span> <span class='hs-conid'>[]</span><span class='hs-keyglyph'>]</span>
<a name="line-37"></a> <span class='hs-varid'>dePArrComp</span> <span class='hs-varid'>qs</span> <span class='hs-varid'>body</span> <span class='hs-layout'>(</span><span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span> <span class='hs-conid'>WildPat</span> <span class='hs-varid'>unitTy</span><span class='hs-layout'>)</span> <span class='hs-varid'>unitArray</span>
<a name="line-38"></a>
<a name="line-39"></a>
<a name="line-40"></a>
<a name="line-41"></a><a name="dePArrComp"></a><span class='hs-comment'>-- the work horse</span>
<a name="line-42"></a><span class='hs-comment'>--</span>
<a name="line-43"></a><span class='hs-definition'>dePArrComp</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Stmt</span> <span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span>
<a name="line-44"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Id</span>
<a name="line-45"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LPat</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- the current generator pattern</span>
<a name="line-46"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- the current generator expression</span>
<a name="line-47"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-48"></a><span class='hs-comment'>--</span>
<a name="line-49"></a><span class='hs-comment'>-- <<[:e' | :]>> pa ea = mapP (\pa -> e') ea</span>
<a name="line-50"></a><span class='hs-comment'>--</span>
<a name="line-51"></a><span class='hs-definition'>dePArrComp</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>e'</span> <span class='hs-varid'>pa</span> <span class='hs-varid'>cea</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-52"></a> <span class='hs-varid'>mapP</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLookupGlobalId</span> <span class='hs-varid'>mapPName</span>
<a name="line-53"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parrElemType</span> <span class='hs-varid'>cea</span>
<a name="line-54"></a> <span class='hs-layout'>(</span><span class='hs-varid'>clam</span><span class='hs-layout'>,</span> <span class='hs-varid'>ty'e'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>deLambda</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>pa</span> <span class='hs-varid'>e'</span>
<a name="line-55"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>mapP</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span> <span class='hs-varid'>ty'e'</span><span class='hs-layout'>,</span> <span class='hs-varid'>clam</span><span class='hs-layout'>,</span> <span class='hs-varid'>cea</span><span class='hs-keyglyph'>]</span>
<a name="line-56"></a><span class='hs-comment'>--</span>
<a name="line-57"></a><span class='hs-comment'>-- <<[:e' | b, qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea)</span>
<a name="line-58"></a><span class='hs-comment'>--</span>
<a name="line-59"></a><span class='hs-definition'>dePArrComp</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExprStmt</span> <span class='hs-varid'>b</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conop'>:</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-varid'>pa</span> <span class='hs-varid'>cea</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-60"></a> <span class='hs-varid'>filterP</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLookupGlobalId</span> <span class='hs-varid'>filterPName</span>
<a name="line-61"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parrElemType</span> <span class='hs-varid'>cea</span>
<a name="line-62"></a> <span class='hs-layout'>(</span><span class='hs-varid'>clam</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>deLambda</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>pa</span> <span class='hs-varid'>b</span>
<a name="line-63"></a> <span class='hs-varid'>dePArrComp</span> <span class='hs-varid'>qs</span> <span class='hs-varid'>body</span> <span class='hs-varid'>pa</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>filterP</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>clam</span><span class='hs-layout'>,</span> <span class='hs-varid'>cea</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-64"></a>
<a name="line-65"></a><span class='hs-comment'>--</span>
<a name="line-66"></a><span class='hs-comment'>-- <<[:e' | p <- e, qs:]>> pa ea =</span>
<a name="line-67"></a><span class='hs-comment'>-- let ef = \pa -> e</span>
<a name="line-68"></a><span class='hs-comment'>-- in</span>
<a name="line-69"></a><span class='hs-comment'>-- <<[:e' | qs:]>> (pa, p) (crossMap ea ef)</span>
<a name="line-70"></a><span class='hs-comment'>--</span>
<a name="line-71"></a><span class='hs-comment'>-- if matching again p cannot fail, or else</span>
<a name="line-72"></a><span class='hs-comment'>--</span>
<a name="line-73"></a><span class='hs-comment'>-- <<[:e' | p <- e, qs:]>> pa ea = </span>
<a name="line-74"></a><span class='hs-comment'>-- let ef = \pa -> filterP (\x -> case x of {p -> True; _ -> False}) e</span>
<a name="line-75"></a><span class='hs-comment'>-- in</span>
<a name="line-76"></a><span class='hs-comment'>-- <<[:e' | qs:]>> (pa, p) (crossMapP ea ef)</span>
<a name="line-77"></a><span class='hs-comment'>--</span>
<a name="line-78"></a><span class='hs-definition'>dePArrComp</span> <span class='hs-layout'>(</span><span class='hs-conid'>BindStmt</span> <span class='hs-varid'>p</span> <span class='hs-varid'>e</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conop'>:</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-varid'>pa</span> <span class='hs-varid'>cea</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-79"></a> <span class='hs-varid'>filterP</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLookupGlobalId</span> <span class='hs-varid'>filterPName</span>
<a name="line-80"></a> <span class='hs-varid'>crossMapP</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLookupGlobalId</span> <span class='hs-varid'>crossMapPName</span>
<a name="line-81"></a> <span class='hs-varid'>ce</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>e</span>
<a name="line-82"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>ety'cea</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parrElemType</span> <span class='hs-varid'>cea</span>
<a name="line-83"></a> <span class='hs-varid'>ety'ce</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parrElemType</span> <span class='hs-varid'>ce</span>
<a name="line-84"></a> <span class='hs-varid'>false</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>falseDataConId</span>
<a name="line-85"></a> <span class='hs-varid'>true</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>trueDataConId</span>
<a name="line-86"></a> <span class='hs-varid'>v</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>ety'ce</span>
<a name="line-87"></a> <span class='hs-varid'>pred</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>matchSimply</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>StmtCtxt</span> <span class='hs-conid'>PArrComp</span><span class='hs-layout'>)</span> <span class='hs-varid'>p</span> <span class='hs-varid'>true</span> <span class='hs-varid'>false</span>
<a name="line-88"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>cef</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isIrrefutableHsPat</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ce</span>
<a name="line-89"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>filterP</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ety'ce</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkLams</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>v</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>pred</span><span class='hs-layout'>,</span> <span class='hs-varid'>ce</span><span class='hs-keyglyph'>]</span>
<a name="line-90"></a> <span class='hs-layout'>(</span><span class='hs-varid'>clam</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mkLambda</span> <span class='hs-varid'>ety'cea</span> <span class='hs-varid'>pa</span> <span class='hs-varid'>cef</span>
<a name="line-91"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>ety'cef</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ety'ce</span> <span class='hs-comment'>-- filter doesn't change the element type</span>
<a name="line-92"></a> <span class='hs-varid'>pa'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkLHsPatTup</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>pa</span><span class='hs-layout'>,</span> <span class='hs-varid'>p</span><span class='hs-keyglyph'>]</span>
<a name="line-93"></a>
<a name="line-94"></a> <span class='hs-varid'>dePArrComp</span> <span class='hs-varid'>qs</span> <span class='hs-varid'>body</span> <span class='hs-varid'>pa'</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>crossMapP</span><span class='hs-layout'>)</span>
<a name="line-95"></a> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ety'cea</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span> <span class='hs-varid'>ety'cef</span><span class='hs-layout'>,</span> <span class='hs-varid'>cea</span><span class='hs-layout'>,</span> <span class='hs-varid'>clam</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-96"></a><span class='hs-comment'>--</span>
<a name="line-97"></a><span class='hs-comment'>-- <<[:e' | let ds, qs:]>> pa ea = </span>
<a name="line-98"></a><span class='hs-comment'>-- <<[:e' | qs:]>> (pa, (x_1, ..., x_n)) </span>
<a name="line-99"></a><span class='hs-comment'>-- (mapP (\v@pa -> let ds in (v, (x_1, ..., x_n))) ea)</span>
<a name="line-100"></a><span class='hs-comment'>-- where</span>
<a name="line-101"></a><span class='hs-comment'>-- {x_1, ..., x_n} = DV (ds) -- Defined Variables</span>
<a name="line-102"></a><span class='hs-comment'>--</span>
<a name="line-103"></a><span class='hs-definition'>dePArrComp</span> <span class='hs-layout'>(</span><span class='hs-conid'>LetStmt</span> <span class='hs-varid'>ds</span> <span class='hs-conop'>:</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-varid'>pa</span> <span class='hs-varid'>cea</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-104"></a> <span class='hs-varid'>mapP</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLookupGlobalId</span> <span class='hs-varid'>mapPName</span>
<a name="line-105"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>unLoc</span> <span class='hs-layout'>(</span><span class='hs-varid'>collectLocalBinders</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span>
<a name="line-106"></a> <span class='hs-varid'>ty'cea</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parrElemType</span> <span class='hs-varid'>cea</span>
<a name="line-107"></a> <span class='hs-varid'>v</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>ty'cea</span>
<a name="line-108"></a> <span class='hs-varid'>clet</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLocalBinds</span> <span class='hs-varid'>ds</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkCoreTup</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>xs</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-109"></a> <span class='hs-varid'>let'v</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-layout'>(</span><span class='hs-varid'>exprType</span> <span class='hs-varid'>clet</span><span class='hs-layout'>)</span>
<a name="line-110"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>projBody</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkCoreLet</span> <span class='hs-layout'>(</span><span class='hs-conid'>NonRec</span> <span class='hs-varid'>let'v</span> <span class='hs-varid'>clet</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-111"></a> <span class='hs-varid'>mkCoreTup</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v</span><span class='hs-layout'>,</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>let'v</span><span class='hs-keyglyph'>]</span>
<a name="line-112"></a> <span class='hs-varid'>errTy</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>exprType</span> <span class='hs-varid'>projBody</span>
<a name="line-113"></a> <span class='hs-varid'>errMsg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"DsListComp.dePArrComp: internal error!"</span><span class='hs-layout'>)</span>
<a name="line-114"></a> <span class='hs-varid'>cerr</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mkErrorAppDs</span> <span class='hs-varid'>pAT_ERROR_ID</span> <span class='hs-varid'>errTy</span> <span class='hs-varid'>errMsg</span>
<a name="line-115"></a> <span class='hs-varid'>ccase</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>matchSimply</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>StmtCtxt</span> <span class='hs-conid'>PArrComp</span><span class='hs-layout'>)</span> <span class='hs-varid'>pa</span> <span class='hs-varid'>projBody</span> <span class='hs-varid'>cerr</span>
<a name="line-116"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>pa'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkLHsPatTup</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>pa</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkLHsPatTup</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>nlVarPat</span> <span class='hs-varid'>xs</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-117"></a> <span class='hs-varid'>proj</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkLams</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>v</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>ccase</span>
<a name="line-118"></a> <span class='hs-varid'>dePArrComp</span> <span class='hs-varid'>qs</span> <span class='hs-varid'>body</span> <span class='hs-varid'>pa'</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>mapP</span><span class='hs-layout'>)</span>
<a name="line-119"></a> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty'cea</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span> <span class='hs-varid'>errTy</span><span class='hs-layout'>,</span> <span class='hs-varid'>proj</span><span class='hs-layout'>,</span> <span class='hs-varid'>cea</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-120"></a><span class='hs-comment'>--</span>
<a name="line-121"></a><span class='hs-comment'>-- The parser guarantees that parallel comprehensions can only appear as</span>
<a name="line-122"></a><span class='hs-comment'>-- singeltons qualifier lists, which we already special case in the caller.</span>
<a name="line-123"></a><span class='hs-comment'>-- So, encountering one here is a bug.</span>
<a name="line-124"></a><span class='hs-comment'>--</span>
<a name="line-125"></a><span class='hs-definition'>dePArrComp</span> <span class='hs-layout'>(</span><span class='hs-conid'>ParStmt</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-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span>
<a name="line-126"></a> <span class='hs-varid'>panic</span> <span class='hs-str'>"DsListComp.dePArrComp: malformed comprehension AST"</span>
<a name="line-127"></a>
<a name="line-128"></a><a name="dePArrParComp"></a><span class='hs-comment'>-- <<[:e' | qs | qss:]>> pa ea = </span>
<a name="line-129"></a><span class='hs-comment'>-- <<[:e' | qss:]>> (pa, (x_1, ..., x_n)) </span>
<a name="line-130"></a><span class='hs-comment'>-- (zipP ea <<[:(x_1, ..., x_n) | qs:]>>)</span>
<a name="line-131"></a><span class='hs-comment'>-- where</span>
<a name="line-132"></a><span class='hs-comment'>-- {x_1, ..., x_n} = DV (qs)</span>
<a name="line-133"></a><span class='hs-comment'>--</span>
<a name="line-134"></a><span class='hs-definition'>dePArrParComp</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>LStmt</span> <span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-135"></a><span class='hs-definition'>dePArrParComp</span> <span class='hs-varid'>qss</span> <span class='hs-varid'>body</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-136"></a> <span class='hs-layout'>(</span><span class='hs-varid'>pQss</span><span class='hs-layout'>,</span> <span class='hs-varid'>ceQss</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>deParStmt</span> <span class='hs-varid'>qss</span>
<a name="line-137"></a> <span class='hs-varid'>dePArrComp</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>body</span> <span class='hs-varid'>pQss</span> <span class='hs-varid'>ceQss</span>
<a name="line-138"></a> <span class='hs-keyword'>where</span>
<a name="line-139"></a> <span class='hs-varid'>deParStmt</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span>
<a name="line-140"></a> <span class='hs-comment'>-- empty parallel statement lists have no source representation</span>
<a name="line-141"></a> <span class='hs-varid'>panic</span> <span class='hs-str'>"DsListComp.dePArrComp: Empty parallel list comprehension"</span>
<a name="line-142"></a> <span class='hs-varid'>deParStmt</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>qs</span><span class='hs-layout'>,</span> <span class='hs-varid'>xs</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>qss</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-comment'>-- first statement</span>
<a name="line-143"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>res_expr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkLHsVarTuple</span> <span class='hs-varid'>xs</span>
<a name="line-144"></a> <span class='hs-varid'>cqs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsPArrComp</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>unLoc</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_expr</span> <span class='hs-varid'>undefined</span>
<a name="line-145"></a> <span class='hs-varid'>parStmts</span> <span class='hs-varid'>qss</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkLHsVarPatTup</span> <span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-varid'>cqs</span>
<a name="line-146"></a> <span class='hs-comment'>---</span>
<a name="line-147"></a> <span class='hs-varid'>parStmts</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>pa</span> <span class='hs-varid'>cea</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>pa</span><span class='hs-layout'>,</span> <span class='hs-varid'>cea</span><span class='hs-layout'>)</span>
<a name="line-148"></a> <span class='hs-varid'>parStmts</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>qs</span><span class='hs-layout'>,</span> <span class='hs-varid'>xs</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>qss</span><span class='hs-layout'>)</span> <span class='hs-varid'>pa</span> <span class='hs-varid'>cea</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-comment'>-- subsequent statements (zip'ed)</span>
<a name="line-149"></a> <span class='hs-varid'>zipP</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsLookupGlobalId</span> <span class='hs-varid'>zipPName</span>
<a name="line-150"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>pa'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkLHsPatTup</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>pa</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkLHsVarPatTup</span> <span class='hs-varid'>xs</span><span class='hs-keyglyph'>]</span>
<a name="line-151"></a> <span class='hs-varid'>ty'cea</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parrElemType</span> <span class='hs-varid'>cea</span>
<a name="line-152"></a> <span class='hs-varid'>res_expr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkLHsVarTuple</span> <span class='hs-varid'>xs</span>
<a name="line-153"></a> <span class='hs-varid'>cqs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dsPArrComp</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>unLoc</span> <span class='hs-varid'>qs</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_expr</span> <span class='hs-varid'>undefined</span>
<a name="line-154"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>ty'cqs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parrElemType</span> <span class='hs-varid'>cqs</span>
<a name="line-155"></a> <span class='hs-varid'>cea'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>zipP</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty'cea</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span> <span class='hs-varid'>ty'cqs</span><span class='hs-layout'>,</span> <span class='hs-varid'>cea</span><span class='hs-layout'>,</span> <span class='hs-varid'>cqs</span><span class='hs-keyglyph'>]</span>
<a name="line-156"></a> <span class='hs-varid'>parStmts</span> <span class='hs-varid'>qss</span> <span class='hs-varid'>pa'</span> <span class='hs-varid'>cea'</span>
<a name="line-157"></a>
<a name="line-158"></a><a name="deLambda"></a><span class='hs-comment'>-- generate Core corresponding to `\p -> e'</span>
<a name="line-159"></a><span class='hs-comment'>--</span>
<a name="line-160"></a><span class='hs-definition'>deLambda</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- type of the argument</span>
<a name="line-161"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LPat</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- argument pattern</span>
<a name="line-162"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- body</span>
<a name="line-163"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span>
<a name="line-164"></a><span class='hs-definition'>deLambda</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>p</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>=</span>
<a name="line-165"></a> <span class='hs-varid'>mkLambda</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>p</span> <span class='hs-varop'>=<<</span> <span class='hs-varid'>dsLExpr</span> <span class='hs-varid'>e</span>
<a name="line-166"></a>
<a name="line-167"></a><a name="mkLambda"></a><span class='hs-comment'>-- generate Core for a lambda pattern match, where the body is already in Core</span>
<a name="line-168"></a><span class='hs-comment'>--</span>
<a name="line-169"></a><span class='hs-definition'>mkLambda</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- type of the argument</span>
<a name="line-170"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LPat</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- argument pattern</span>
<a name="line-171"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- desugared body</span>
<a name="line-172"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DsM</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreExpr</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span>
<a name="line-173"></a><span class='hs-definition'>mkLambda</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>p</span> <span class='hs-varid'>ce</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-174"></a> <span class='hs-varid'>v</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newSysLocalDs</span> <span class='hs-varid'>ty</span>
<a name="line-175"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>errMsg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"DsListComp.deLambda: internal error!"</span><span class='hs-layout'>)</span>
<a name="line-176"></a> <span class='hs-varid'>ce'ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>exprType</span> <span class='hs-varid'>ce</span>
<a name="line-177"></a> <span class='hs-varid'>cerr</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mkErrorAppDs</span> <span class='hs-varid'>pAT_ERROR_ID</span> <span class='hs-varid'>ce'ty</span> <span class='hs-varid'>errMsg</span>
<a name="line-178"></a> <span class='hs-varid'>res</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>matchSimply</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>StmtCtxt</span> <span class='hs-conid'>PArrComp</span><span class='hs-layout'>)</span> <span class='hs-varid'>p</span> <span class='hs-varid'>ce</span> <span class='hs-varid'>cerr</span>
<a name="line-179"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkLams</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>v</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>res</span><span class='hs-layout'>,</span> <span class='hs-varid'>ce'ty</span><span class='hs-layout'>)</span>
<a name="line-180"></a>
<a name="line-181"></a><a name="parrElemType"></a><span class='hs-comment'>-- obtain the element type of the parallel array produced by the given Core</span>
<a name="line-182"></a><span class='hs-comment'>-- expression</span>
<a name="line-183"></a><span class='hs-comment'>--</span>
<a name="line-184"></a><span class='hs-definition'>parrElemType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span>
<a name="line-185"></a><span class='hs-definition'>parrElemType</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>=</span>
<a name="line-186"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>splitTyConApp_maybe</span> <span class='hs-layout'>(</span><span class='hs-varid'>exprType</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-187"></a> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tycon</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ty</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>tycon</span> <span class='hs-varop'>==</span> <span class='hs-varid'>parrTyCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>ty</span>
<a name="line-188"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>panic</span>
<a name="line-189"></a> <span class='hs-str'>"DsListComp.parrElemType: not a parallel array type"</span>
</pre>\end{code}
</body>
</html>
