<?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>typecheck/TcMatches.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
%
TcMatches: Typecheck some @Matches@
\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>TcMatches</span> <span class='hs-layout'>(</span> <span class='hs-varid'>tcMatchesFun</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcGRHSsPat</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcMatchesCase</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcMatchLambda</span><span class='hs-layout'>,</span>
<a name="line-2"></a> <span class='hs-conid'>TcMatchCtxt</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-3"></a> <span class='hs-varid'>tcStmts</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcDoStmts</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcBody</span><span class='hs-layout'>,</span>
<a name="line-4"></a> <span class='hs-varid'>tcDoStmt</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcMDoStmt</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcGuardStmt</span>
<a name="line-5"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-comment'>{-# SOURCE #-}</span> <span class='hs-conid'>TcExpr</span><span class='hs-layout'>(</span> <span class='hs-varid'>tcSyntaxOp</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcInferRhoNC</span><span class='hs-layout'>,</span>
<a name="line-8"></a> <span class='hs-varid'>tcMonoExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcMonoExprNC</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcPolyExpr</span> <span class='hs-layout'>)</span>
<a name="line-9"></a>
<a name="line-10"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HsSyn</span>
<a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcRnMonad</span>
<a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Inst</span>
<a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcEnv</span>
<a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcPat</span>
<a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcMType</span>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcType</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcBinds</span>
<a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcUnify</span>
<a name="line-19"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcSimplify</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>MkCore</span>
<a name="line-21"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TysWiredIn</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>PrelNames</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'>TyCon</span>
<a name="line-26"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TysPrim</span>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-28"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Util</span>
<a name="line-29"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>SrcLoc</span>
<a name="line-30"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastString</span>
<a name="line-31"></a>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>
<a name="line-33"></a>
<a name="line-34"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{tcMatchesFun, tcMatchesCase}
%* *
%************************************************************************
@tcMatchesFun@ typechecks a @[Match]@ list which occurs in a
@FunMonoBind@. The second argument is the name of the function, which
is used in error messages. It checks that all the equations have the
same number of arguments before using @tcMatches@ to do the work.
\begin{code}
<pre><a name="line-1"></a><a name="tcMatchesFun"></a><span class='hs-definition'>tcMatchesFun</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MatchGroup</span> <span class='hs-conid'>Name</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span> <span class='hs-comment'>-- Expected type of function</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsWrapper</span><span class='hs-layout'>,</span> <span class='hs-conid'>MatchGroup</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Returns type of body</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-definition'>tcMatchesFun</span> <span class='hs-varid'>fun_name</span> <span class='hs-varid'>inf</span> <span class='hs-varid'>matches</span> <span class='hs-varid'>exp_ty</span>
<a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- Check that they all have the same no of arguments</span>
<a name="line-8"></a> <span class='hs-comment'>-- Location is in the monad, set the caller so that </span>
<a name="line-9"></a> <span class='hs-comment'>-- any inter-equation error messages get some vaguely</span>
<a name="line-10"></a> <span class='hs-comment'>-- sensible location. Note: we have to do this odd</span>
<a name="line-11"></a> <span class='hs-comment'>-- ann-grabbing, because we don't always have annotations in</span>
<a name="line-12"></a> <span class='hs-comment'>-- hand when we call tcMatchesFun...</span>
<a name="line-13"></a> <span class='hs-varid'>checkArgs</span> <span class='hs-varid'>fun_name</span> <span class='hs-varid'>matches</span>
<a name="line-14"></a>
<a name="line-15"></a> <span class='hs-comment'>-- ToDo: Don't use "expected" stuff if there ain't a type signature</span>
<a name="line-16"></a> <span class='hs-comment'>-- because inconsistency between branches</span>
<a name="line-17"></a> <span class='hs-comment'>-- may show up as something wrong with the (non-existent) type signature</span>
<a name="line-18"></a>
<a name="line-19"></a> <span class='hs-comment'>-- This is one of two places places we call subFunTys</span>
<a name="line-20"></a> <span class='hs-comment'>-- The point is that if expected_y is a "hole", we want </span>
<a name="line-21"></a> <span class='hs-comment'>-- to make pat_tys and rhs_ty as "holes" too.</span>
<a name="line-22"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>subFunTys</span> <span class='hs-varid'>doc</span> <span class='hs-varid'>n_pats</span> <span class='hs-varid'>exp_ty</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-conid'>FunSigCtxt</span> <span class='hs-varid'>fun_name</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>pat_tys</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-23"></a> <span class='hs-varid'>tcMatches</span> <span class='hs-varid'>match_ctxt</span> <span class='hs-varid'>pat_tys</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-varid'>matches</span>
<a name="line-24"></a> <span class='hs-layout'>}</span>
<a name="line-25"></a> <span class='hs-keyword'>where</span>
<a name="line-26"></a> <span class='hs-varid'>doc</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'>"The equation(s) for"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>fun_name</span><span class='hs-layout'>)</span>
<a name="line-27"></a> <span class='hs-varop'><+></span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"have"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>speakNOf</span> <span class='hs-varid'>n_pats</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"argument"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-28"></a> <span class='hs-varid'>n_pats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>matchGroupArity</span> <span class='hs-varid'>matches</span>
<a name="line-29"></a> <span class='hs-varid'>match_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MC</span> <span class='hs-layout'>{</span> <span class='hs-varid'>mc_what</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>FunRhs</span> <span class='hs-varid'>fun_name</span> <span class='hs-varid'>inf</span><span class='hs-layout'>,</span> <span class='hs-varid'>mc_body</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcBody</span> <span class='hs-layout'>}</span>
</pre>\end{code}
@tcMatchesCase@ doesn't do the argument-count check because the
parser guarantees that each equation has exactly one argument.
\begin{code}
<pre><a name="line-1"></a><a name="tcMatchesCase"></a><span class='hs-definition'>tcMatchesCase</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcMatchCtxt</span> <span class='hs-comment'>-- Case context</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcRhoType</span> <span class='hs-comment'>-- Type of scrutinee</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MatchGroup</span> <span class='hs-conid'>Name</span> <span class='hs-comment'>-- The case alternatives</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span> <span class='hs-comment'>-- Type of whole case expressions</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>MatchGroup</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Translated alternatives</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-definition'>tcMatchesCase</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>scrut_ty</span> <span class='hs-varid'>matches</span> <span class='hs-varid'>res_ty</span>
<a name="line-8"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isEmptyMatchGroup</span> <span class='hs-varid'>matches</span>
<a name="line-9"></a> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>-- Allow empty case expressions</span>
<a name="line-10"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- Make sure we follow the invariant that res_ty is filled in</span>
<a name="line-11"></a> <span class='hs-varid'>res_ty'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>refineBoxToTau</span> <span class='hs-varid'>res_ty</span>
<a name="line-12"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>MatchGroup</span> <span class='hs-conid'>[]</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkFunTys</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>scrut_ty</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>res_ty'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcMatches</span> <span class='hs-varid'>ctxt</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>scrut_ty</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>matches</span>
<a name="line-16"></a>
<a name="line-17"></a><a name="tcMatchLambda"></a><span class='hs-definition'>tcMatchLambda</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MatchGroup</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsWrapper</span><span class='hs-layout'>,</span> <span class='hs-conid'>MatchGroup</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>)</span>
<a name="line-18"></a><span class='hs-definition'>tcMatchLambda</span> <span class='hs-varid'>match</span> <span class='hs-varid'>res_ty</span>
<a name="line-19"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>subFunTys</span> <span class='hs-varid'>doc</span> <span class='hs-varid'>n_pats</span> <span class='hs-varid'>res_ty</span> <span class='hs-conid'>Nothing</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>pat_tys</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-20"></a> <span class='hs-varid'>tcMatches</span> <span class='hs-varid'>match_ctxt</span> <span class='hs-varid'>pat_tys</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-varid'>match</span>
<a name="line-21"></a> <span class='hs-keyword'>where</span>
<a name="line-22"></a> <span class='hs-varid'>n_pats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>matchGroupArity</span> <span class='hs-varid'>match</span>
<a name="line-23"></a> <span class='hs-varid'>doc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sep</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"The lambda expression"</span><span class='hs-layout'>)</span>
<a name="line-24"></a> <span class='hs-varop'><+></span> <span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>pprSetDepth</span> <span class='hs-layout'>(</span><span class='hs-conid'>PartWay</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-25"></a> <span class='hs-varid'>pprMatches</span> <span class='hs-layout'>(</span><span class='hs-conid'>LambdaExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HsMatchContext</span> <span class='hs-conid'>Name</span><span class='hs-layout'>)</span> <span class='hs-varid'>match</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-26"></a> <span class='hs-comment'>-- The pprSetDepth makes the abstraction print briefly</span>
<a name="line-27"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"has"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>speakNOf</span> <span class='hs-varid'>n_pats</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"argument"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-28"></a> <span class='hs-varid'>match_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MC</span> <span class='hs-layout'>{</span> <span class='hs-varid'>mc_what</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>LambdaExpr</span><span class='hs-layout'>,</span>
<a name="line-29"></a> <span class='hs-varid'>mc_body</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcBody</span> <span class='hs-layout'>}</span>
</pre>\end{code}
@tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind@.
\begin{code}
<pre><a name="line-1"></a><a name="tcGRHSsPat"></a><span class='hs-definition'>tcGRHSsPat</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GRHSs</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>GRHSs</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>)</span>
<a name="line-2"></a><span class='hs-comment'>-- Used for pattern bindings</span>
<a name="line-3"></a><span class='hs-definition'>tcGRHSsPat</span> <span class='hs-varid'>grhss</span> <span class='hs-varid'>res_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcGRHSs</span> <span class='hs-varid'>match_ctxt</span> <span class='hs-varid'>grhss</span> <span class='hs-varid'>res_ty</span>
<a name="line-4"></a> <span class='hs-keyword'>where</span>
<a name="line-5"></a> <span class='hs-varid'>match_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MC</span> <span class='hs-layout'>{</span> <span class='hs-varid'>mc_what</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PatBindRhs</span><span class='hs-layout'>,</span>
<a name="line-6"></a> <span class='hs-varid'>mc_body</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcBody</span> <span class='hs-layout'>}</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{tcMatch}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="tcMatches"></a><span class='hs-definition'>tcMatches</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcMatchCtxt</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>BoxySigmaType</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Expected pattern types</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span> <span class='hs-comment'>-- Expected result-type of the Match.</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MatchGroup</span> <span class='hs-conid'>Name</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>MatchGroup</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>)</span>
<a name="line-6"></a>
<a name="line-7"></a><a name="TcMatchCtxt"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>TcMatchCtxt</span> <span class='hs-comment'>-- c.f. TcStmtCtxt, also in this module</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MC</span> <span class='hs-layout'>{</span> <span class='hs-varid'>mc_what</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HsMatchContext</span> <span class='hs-conid'>Name</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- What kind of thing this is</span>
<a name="line-9"></a> <span class='hs-varid'>mc_body</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Name</span> <span class='hs-comment'>-- Type checker for a body of</span>
<a name="line-10"></a> <span class='hs-comment'>-- an alternative</span>
<a name="line-11"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span>
<a name="line-12"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-definition'>tcMatches</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>pat_tys</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-layout'>(</span><span class='hs-conid'>MatchGroup</span> <span class='hs-varid'>matches</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>matches</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span> <span class='hs-comment'>-- Ensure that rhs_ty is filled in</span>
<a name="line-16"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>matches'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcMatch</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>pat_tys</span> <span class='hs-varid'>rhs_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>matches</span>
<a name="line-17"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>MatchGroup</span> <span class='hs-varid'>matches'</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkFunTys</span> <span class='hs-varid'>pat_tys</span> <span class='hs-varid'>rhs_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-18"></a>
<a name="line-19"></a><a name="tcMatch"></a><span class='hs-comment'>-------------</span>
<a name="line-20"></a><span class='hs-definition'>tcMatch</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcMatchCtxt</span>
<a name="line-21"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>BoxySigmaType</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Expected pattern types</span>
<a name="line-22"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span> <span class='hs-comment'>-- Expected result-type of the Match.</span>
<a name="line-23"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LMatch</span> <span class='hs-conid'>Name</span>
<a name="line-24"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>LMatch</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>)</span>
<a name="line-25"></a>
<a name="line-26"></a><span class='hs-definition'>tcMatch</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>pat_tys</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-varid'>match</span>
<a name="line-27"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>wrapLocM</span> <span class='hs-layout'>(</span><span class='hs-varid'>tc_match</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>pat_tys</span> <span class='hs-varid'>rhs_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>match</span>
<a name="line-28"></a> <span class='hs-keyword'>where</span>
<a name="line-29"></a> <span class='hs-varid'>tc_match</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>pat_tys</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-varid'>match</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Match</span> <span class='hs-varid'>pats</span> <span class='hs-varid'>maybe_rhs_sig</span> <span class='hs-varid'>grhss</span><span class='hs-layout'>)</span>
<a name="line-30"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>add_match_ctxt</span> <span class='hs-varid'>match</span> <span class='hs-varop'>$</span>
<a name="line-31"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>pats'</span><span class='hs-layout'>,</span> <span class='hs-varid'>grhss'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcPats</span> <span class='hs-layout'>(</span><span class='hs-varid'>mc_what</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>)</span> <span class='hs-varid'>pats</span> <span class='hs-varid'>pat_tys</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-varop'>$</span>
<a name="line-32"></a> <span class='hs-varid'>tc_grhss</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>maybe_rhs_sig</span> <span class='hs-varid'>grhss</span>
<a name="line-33"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Match</span> <span class='hs-varid'>pats'</span> <span class='hs-conid'>Nothing</span> <span class='hs-varid'>grhss'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-34"></a>
<a name="line-35"></a> <span class='hs-varid'>tc_grhss</span> <span class='hs-varid'>ctxt</span> <span class='hs-conid'>Nothing</span> <span class='hs-varid'>grhss</span> <span class='hs-varid'>rhs_ty</span>
<a name="line-36"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcGRHSs</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>grhss</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-comment'>-- No result signature</span>
<a name="line-37"></a>
<a name="line-38"></a> <span class='hs-comment'>-- Result type sigs are no longer supported</span>
<a name="line-39"></a> <span class='hs-varid'>tc_grhss</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span>
<a name="line-40"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"tc_ghrss"</span> <span class='hs-comment'>-- Rejected by renamer</span>
<a name="line-41"></a>
<a name="line-42"></a> <span class='hs-comment'>-- For (\x -> e), tcExpr has already said "In the expresssion \x->e"</span>
<a name="line-43"></a> <span class='hs-comment'>-- so we don't want to add "In the lambda abstraction \x->e"</span>
<a name="line-44"></a> <span class='hs-varid'>add_match_ctxt</span> <span class='hs-varid'>match</span> <span class='hs-varid'>thing_inside</span>
<a name="line-45"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>mc_what</span> <span class='hs-varid'>ctxt</span> <span class='hs-keyword'>of</span>
<a name="line-46"></a> <span class='hs-conid'>LambdaExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>thing_inside</span>
<a name="line-47"></a> <span class='hs-varid'>m_ctxt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>addErrCtxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>pprMatchInCtxt</span> <span class='hs-varid'>m_ctxt</span> <span class='hs-varid'>match</span><span class='hs-layout'>)</span> <span class='hs-varid'>thing_inside</span>
<a name="line-48"></a>
<a name="line-49"></a><a name="tcGRHSs"></a><span class='hs-comment'>-------------</span>
<a name="line-50"></a><span class='hs-definition'>tcGRHSs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcMatchCtxt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>GRHSs</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span>
<a name="line-51"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>GRHSs</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>)</span>
<a name="line-52"></a>
<a name="line-53"></a><span class='hs-comment'>-- Notice that we pass in the full res_ty, so that we get</span>
<a name="line-54"></a><span class='hs-comment'>-- good inference from simple things like</span>
<a name="line-55"></a><span class='hs-comment'>-- f = \(x::forall a.a->a) -> <stuff></span>
<a name="line-56"></a><span class='hs-comment'>-- We used to force it to be a monotype when there was more than one guard</span>
<a name="line-57"></a><span class='hs-comment'>-- but we don't need to do that any more</span>
<a name="line-58"></a>
<a name="line-59"></a><span class='hs-definition'>tcGRHSs</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-conid'>GRHSs</span> <span class='hs-varid'>grhss</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span>
<a name="line-60"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>binds'</span><span class='hs-layout'>,</span> <span class='hs-varid'>grhss'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLocalBinds</span> <span class='hs-varid'>binds</span> <span class='hs-varop'>$</span>
<a name="line-61"></a> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>wrapLocM</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcGRHS</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>grhss</span>
<a name="line-62"></a>
<a name="line-63"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>GRHSs</span> <span class='hs-varid'>grhss'</span> <span class='hs-varid'>binds'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-64"></a>
<a name="line-65"></a><a name="tcGRHS"></a><span class='hs-comment'>-------------</span>
<a name="line-66"></a><span class='hs-definition'>tcGRHS</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcMatchCtxt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>GRHS</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>GRHS</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>)</span>
<a name="line-67"></a>
<a name="line-68"></a><span class='hs-definition'>tcGRHS</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>res_ty</span> <span class='hs-layout'>(</span><span class='hs-conid'>GRHS</span> <span class='hs-varid'>guards</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span>
<a name="line-69"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>guards'</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcStmts</span> <span class='hs-varid'>stmt_ctxt</span> <span class='hs-varid'>tcGuardStmt</span> <span class='hs-varid'>guards</span> <span class='hs-varid'>res_ty</span> <span class='hs-varop'>$</span>
<a name="line-70"></a> <span class='hs-varid'>mc_body</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>rhs</span>
<a name="line-71"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>GRHS</span> <span class='hs-varid'>guards'</span> <span class='hs-varid'>rhs'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-72"></a> <span class='hs-keyword'>where</span>
<a name="line-73"></a> <span class='hs-varid'>stmt_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PatGuard</span> <span class='hs-layout'>(</span><span class='hs-varid'>mc_what</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{@tcDoStmts@ typechecks a {\em list} of do statements}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="tcDoStmts"></a><span class='hs-definition'>tcDoStmts</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HsStmtContext</span> <span class='hs-conid'>Name</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LStmt</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Name</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsExpr</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Returns a HsDo</span>
<a name="line-6"></a><span class='hs-definition'>tcDoStmts</span> <span class='hs-conid'>ListComp</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>body</span> <span class='hs-varid'>res_ty</span>
<a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>elt_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>coi</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>boxySplitListTy</span> <span class='hs-varid'>res_ty</span>
<a name="line-8"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcStmts</span> <span class='hs-conid'>ListComp</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcLcStmt</span> <span class='hs-varid'>listTyCon</span><span class='hs-layout'>)</span> <span class='hs-varid'>stmts</span>
<a name="line-9"></a> <span class='hs-varid'>elt_ty</span> <span class='hs-varop'>$</span>
<a name="line-10"></a> <span class='hs-varid'>tcBody</span> <span class='hs-varid'>body</span>
<a name="line-11"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mkHsWrapCoI</span> <span class='hs-varid'>coi</span>
<a name="line-12"></a> <span class='hs-layout'>(</span><span class='hs-conid'>HsDo</span> <span class='hs-conid'>ListComp</span> <span class='hs-varid'>stmts'</span> <span class='hs-varid'>body'</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkListTy</span> <span class='hs-varid'>elt_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-definition'>tcDoStmts</span> <span class='hs-conid'>PArrComp</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>body</span> <span class='hs-varid'>res_ty</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>elt_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>coi</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>boxySplitPArrTy</span> <span class='hs-varid'>res_ty</span>
<a name="line-16"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcStmts</span> <span class='hs-conid'>PArrComp</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcLcStmt</span> <span class='hs-varid'>parrTyCon</span><span class='hs-layout'>)</span> <span class='hs-varid'>stmts</span>
<a name="line-17"></a> <span class='hs-varid'>elt_ty</span> <span class='hs-varop'>$</span>
<a name="line-18"></a> <span class='hs-varid'>tcBody</span> <span class='hs-varid'>body</span>
<a name="line-19"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mkHsWrapCoI</span> <span class='hs-varid'>coi</span>
<a name="line-20"></a> <span class='hs-layout'>(</span><span class='hs-conid'>HsDo</span> <span class='hs-conid'>PArrComp</span> <span class='hs-varid'>stmts'</span> <span class='hs-varid'>body'</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkPArrTy</span> <span class='hs-varid'>elt_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-21"></a>
<a name="line-22"></a><span class='hs-definition'>tcDoStmts</span> <span class='hs-conid'>DoExpr</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>body</span> <span class='hs-varid'>res_ty</span>
<a name="line-23"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcStmts</span> <span class='hs-conid'>DoExpr</span> <span class='hs-varid'>tcDoStmt</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>res_ty</span> <span class='hs-varop'>$</span>
<a name="line-24"></a> <span class='hs-varid'>tcBody</span> <span class='hs-varid'>body</span>
<a name="line-25"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsDo</span> <span class='hs-conid'>DoExpr</span> <span class='hs-varid'>stmts'</span> <span class='hs-varid'>body'</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-26"></a>
<a name="line-27"></a><span class='hs-definition'>tcDoStmts</span> <span class='hs-varid'>ctxt</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>MDoExpr</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>body</span> <span class='hs-varid'>res_ty</span>
<a name="line-28"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>m_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>elt_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>coi</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>boxySplitAppTy</span> <span class='hs-varid'>res_ty</span>
<a name="line-29"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>res_ty'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkAppTy</span> <span class='hs-varid'>m_ty</span> <span class='hs-varid'>elt_ty</span> <span class='hs-comment'>-- The boxySplit consumes res_ty</span>
<a name="line-30"></a> <span class='hs-varid'>tc_rhs</span> <span class='hs-varid'>rhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withBox</span> <span class='hs-varid'>liftedTypeKind</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>pat_ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-31"></a> <span class='hs-varid'>tcMonoExpr</span> <span class='hs-varid'>rhs</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkAppTy</span> <span class='hs-varid'>m_ty</span> <span class='hs-varid'>pat_ty</span><span class='hs-layout'>)</span>
<a name="line-32"></a>
<a name="line-33"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcStmts</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcMDoStmt</span> <span class='hs-varid'>tc_rhs</span><span class='hs-layout'>)</span> <span class='hs-varid'>stmts</span>
<a name="line-34"></a> <span class='hs-varid'>res_ty'</span> <span class='hs-varop'>$</span>
<a name="line-35"></a> <span class='hs-varid'>tcBody</span> <span class='hs-varid'>body</span>
<a name="line-36"></a>
<a name="line-37"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>names</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mfixName</span><span class='hs-layout'>,</span> <span class='hs-varid'>bindMName</span><span class='hs-layout'>,</span> <span class='hs-varid'>thenMName</span><span class='hs-layout'>,</span> <span class='hs-varid'>returnMName</span><span class='hs-layout'>,</span> <span class='hs-varid'>failMName</span><span class='hs-keyglyph'>]</span>
<a name="line-38"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>insts</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>newMethodFromName</span> <span class='hs-conid'>DoOrigin</span> <span class='hs-varid'>m_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>names</span>
<a name="line-39"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span>
<a name="line-40"></a> <span class='hs-varid'>mkHsWrapCoI</span> <span class='hs-varid'>coi</span>
<a name="line-41"></a> <span class='hs-layout'>(</span><span class='hs-conid'>HsDo</span> <span class='hs-layout'>(</span><span class='hs-conid'>MDoExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>names</span> <span class='hs-varop'>`zip`</span> <span class='hs-varid'>insts</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>stmts'</span> <span class='hs-varid'>body'</span> <span class='hs-varid'>res_ty'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-42"></a>
<a name="line-43"></a><span class='hs-definition'>tcDoStmts</span> <span class='hs-varid'>ctxt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcDoStmts"</span> <span class='hs-layout'>(</span><span class='hs-varid'>pprStmtContext</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>)</span>
<a name="line-44"></a>
<a name="line-45"></a><a name="tcBody"></a><span class='hs-definition'>tcBody</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>)</span>
<a name="line-46"></a><span class='hs-definition'>tcBody</span> <span class='hs-varid'>body</span> <span class='hs-varid'>res_ty</span>
<a name="line-47"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>traceTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"tcBody"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span>
<a name="line-48"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>body'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcMonoExpr</span> <span class='hs-varid'>body</span> <span class='hs-varid'>res_ty</span>
<a name="line-49"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-varid'>body'</span>
<a name="line-50"></a> <span class='hs-layout'>}</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{tcStmts}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="TcStmtChecker"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>TcStmtChecker</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>forall</span> <span class='hs-varid'>thing</span><span class='hs-varop'>.</span> <span class='hs-conid'>HsStmtContext</span> <span class='hs-conid'>Name</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Stmt</span> <span class='hs-conid'>Name</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span> <span class='hs-comment'>-- Result type for comprehension</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>BoxyRhoType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Checker for what follows the stmt</span>
<a name="line-6"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Stmt</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span>
<a name="line-7"></a>
<a name="line-8"></a><a name="tcStmts"></a><span class='hs-definition'>tcStmts</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HsStmtContext</span> <span class='hs-conid'>Name</span>
<a name="line-9"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcStmtChecker</span> <span class='hs-comment'>-- NB: higher-rank type</span>
<a name="line-10"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LStmt</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span>
<a name="line-11"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>BoxyRhoType</span>
<a name="line-12"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>BoxyRhoType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span>
<a name="line-13"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>LStmt</span> <span class='hs-conid'>TcId</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span>
<a name="line-14"></a>
<a name="line-15"></a><span class='hs-comment'>-- Note the higher-rank type. stmt_chk is applied at different</span>
<a name="line-16"></a><span class='hs-comment'>-- types in the equations for tcStmts</span>
<a name="line-17"></a>
<a name="line-18"></a><span class='hs-definition'>tcStmts</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-19"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>thing_inside</span> <span class='hs-varid'>res_ty</span>
<a name="line-20"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-21"></a>
<a name="line-22"></a><span class='hs-comment'>-- LetStmts are handled uniformly, regardless of context</span>
<a name="line-23"></a><span class='hs-definition'>tcStmts</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>stmt_chk</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-layout'>(</span><span class='hs-conid'>LetStmt</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>stmts</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-24"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>binds'</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span><span class='hs-varid'>thing</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLocalBinds</span> <span class='hs-varid'>binds</span> <span class='hs-varop'>$</span>
<a name="line-25"></a> <span class='hs-varid'>tcStmts</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>stmt_chk</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-26"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-layout'>(</span><span class='hs-conid'>LetStmt</span> <span class='hs-varid'>binds'</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-27"></a>
<a name="line-28"></a><span class='hs-comment'>-- For the vanilla case, handle the location-setting part</span>
<a name="line-29"></a><span class='hs-definition'>tcStmts</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>stmt_chk</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>stmt</span> <span class='hs-conop'>:</span> <span class='hs-varid'>stmts</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-30"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmt'</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span>
<a name="line-31"></a> <span class='hs-varid'>setSrcSpan</span> <span class='hs-varid'>loc</span> <span class='hs-varop'>$</span>
<a name="line-32"></a> <span class='hs-varid'>addErrCtxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>pprStmtInCtxt</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>stmt</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-33"></a> <span class='hs-varid'>stmt_chk</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>stmt</span> <span class='hs-varid'>res_ty</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>res_ty'</span> <span class='hs-keyglyph'>-></span>
<a name="line-34"></a> <span class='hs-varid'>popErrCtxt</span> <span class='hs-varop'>$</span>
<a name="line-35"></a> <span class='hs-varid'>tcStmts</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>stmt_chk</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>res_ty'</span> <span class='hs-varop'>$</span>
<a name="line-36"></a> <span class='hs-varid'>thing_inside</span>
<a name="line-37"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>stmt'</span> <span class='hs-conop'>:</span> <span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-38"></a>
<a name="line-39"></a><a name="tcGuardStmt"></a><span class='hs-comment'>--------------------------------</span>
<a name="line-40"></a><span class='hs-comment'>-- Pattern guards</span>
<a name="line-41"></a><span class='hs-definition'>tcGuardStmt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcStmtChecker</span>
<a name="line-42"></a><span class='hs-definition'>tcGuardStmt</span> <span class='hs-keyword'>_</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-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-43"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>guard'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcMonoExpr</span> <span class='hs-varid'>guard</span> <span class='hs-varid'>boolTy</span>
<a name="line-44"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>thing_inside</span> <span class='hs-varid'>res_ty</span>
<a name="line-45"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExprStmt</span> <span class='hs-varid'>guard'</span> <span class='hs-varid'>noSyntaxExpr</span> <span class='hs-varid'>boolTy</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-46"></a>
<a name="line-47"></a><span class='hs-definition'>tcGuardStmt</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-conid'>BindStmt</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>rhs</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-48"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>rhs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcInferRhoNC</span> <span class='hs-varid'>rhs</span> <span class='hs-comment'>-- Stmt has a context already</span>
<a name="line-49"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>pat'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>StmtCtxt</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>)</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-50"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>BindStmt</span> <span class='hs-varid'>pat'</span> <span class='hs-varid'>rhs'</span> <span class='hs-varid'>noSyntaxExpr</span> <span class='hs-varid'>noSyntaxExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-51"></a>
<a name="line-52"></a><span class='hs-definition'>tcGuardStmt</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>stmt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span>
<a name="line-53"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcGuardStmt: unexpected Stmt"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>stmt</span><span class='hs-layout'>)</span>
<a name="line-54"></a>
<a name="line-55"></a>
<a name="line-56"></a><span class='hs-comment'>--------------------------------</span>
<a name="line-57"></a><span class='hs-comment'>-- List comprehensions and PArrays</span>
<a name="line-58"></a>
<a name="line-59"></a><a name="tcLcStmt"></a><span class='hs-definition'>tcLcStmt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyCon</span> <span class='hs-comment'>-- The list/Parray type constructor ([] or PArray)</span>
<a name="line-60"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcStmtChecker</span>
<a name="line-61"></a>
<a name="line-62"></a><span class='hs-comment'>-- A generator, pat <- rhs</span>
<a name="line-63"></a><span class='hs-definition'>tcLcStmt</span> <span class='hs-varid'>m_tc</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-conid'>BindStmt</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>rhs</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-64"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>rhs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>withBox</span> <span class='hs-varid'>liftedTypeKind</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-65"></a> <span class='hs-varid'>tcMonoExpr</span> <span class='hs-varid'>rhs</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkTyConApp</span> <span class='hs-varid'>m_tc</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ty</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-66"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>pat'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>StmtCtxt</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>)</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>pat_ty</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-67"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>BindStmt</span> <span class='hs-varid'>pat'</span> <span class='hs-varid'>rhs'</span> <span class='hs-varid'>noSyntaxExpr</span> <span class='hs-varid'>noSyntaxExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-68"></a>
<a name="line-69"></a><span class='hs-comment'>-- A boolean guard</span>
<a name="line-70"></a><span class='hs-definition'>tcLcStmt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExprStmt</span> <span class='hs-varid'>rhs</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-71"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>rhs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcMonoExpr</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>boolTy</span>
<a name="line-72"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>thing_inside</span> <span class='hs-varid'>res_ty</span>
<a name="line-73"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExprStmt</span> <span class='hs-varid'>rhs'</span> <span class='hs-varid'>noSyntaxExpr</span> <span class='hs-varid'>boolTy</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-74"></a>
<a name="line-75"></a><span class='hs-comment'>-- A parallel set of comprehensions</span>
<a name="line-76"></a><span class='hs-comment'>-- [ (g x, h x) | ... ; let g v = ...</span>
<a name="line-77"></a><span class='hs-comment'>-- | ... ; let h v = ... ]</span>
<a name="line-78"></a><span class='hs-comment'>--</span>
<a name="line-79"></a><span class='hs-comment'>-- It's possible that g,h are overloaded, so we need to feed the LIE from the</span>
<a name="line-80"></a><span class='hs-comment'>-- (g x, h x) up through both lots of bindings (so we get the bindInstsOfLocalFuns).</span>
<a name="line-81"></a><span class='hs-comment'>-- Similarly if we had an existential pattern match:</span>
<a name="line-82"></a><span class='hs-comment'>--</span>
<a name="line-83"></a><span class='hs-comment'>-- data T = forall a. Show a => C a</span>
<a name="line-84"></a><span class='hs-comment'>--</span>
<a name="line-85"></a><span class='hs-comment'>-- [ (show x, show y) | ... ; C x <- ...</span>
<a name="line-86"></a><span class='hs-comment'>-- | ... ; C y <- ... ]</span>
<a name="line-87"></a><span class='hs-comment'>--</span>
<a name="line-88"></a><span class='hs-comment'>-- Then we need the LIE from (show x, show y) to be simplified against</span>
<a name="line-89"></a><span class='hs-comment'>-- the bindings for x and y. </span>
<a name="line-90"></a><span class='hs-comment'>-- </span>
<a name="line-91"></a><span class='hs-comment'>-- It's difficult to do this in parallel, so we rely on the renamer to </span>
<a name="line-92"></a><span class='hs-comment'>-- ensure that g,h and x,y don't duplicate, and simply grow the environment.</span>
<a name="line-93"></a><span class='hs-comment'>-- So the binders of the first parallel group will be in scope in the second</span>
<a name="line-94"></a><span class='hs-comment'>-- group. But that's fine; there's no shadowing to worry about.</span>
<a name="line-95"></a>
<a name="line-96"></a><span class='hs-definition'>tcLcStmt</span> <span class='hs-varid'>m_tc</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-conid'>ParStmt</span> <span class='hs-varid'>bndr_stmts_s</span><span class='hs-layout'>)</span> <span class='hs-varid'>elt_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-97"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>pairs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>loop</span> <span class='hs-varid'>bndr_stmts_s</span>
<a name="line-98"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>ParStmt</span> <span class='hs-varid'>pairs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-99"></a> <span class='hs-keyword'>where</span>
<a name="line-100"></a> <span class='hs-comment'>-- loop :: [([LStmt Name], [Name])] -> TcM ([([LStmt TcId], [TcId])], thing)</span>
<a name="line-101"></a> <span class='hs-varid'>loop</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>thing_inside</span> <span class='hs-varid'>elt_ty</span>
<a name="line-102"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span> <span class='hs-comment'>-- matching in the branches</span>
<a name="line-103"></a>
<a name="line-104"></a> <span class='hs-varid'>loop</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>stmts</span><span class='hs-layout'>,</span> <span class='hs-varid'>names</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>pairs</span><span class='hs-layout'>)</span>
<a name="line-105"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>ids</span><span class='hs-layout'>,</span> <span class='hs-varid'>pairs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-106"></a> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcStmts</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcLcStmt</span> <span class='hs-varid'>m_tc</span><span class='hs-layout'>)</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>elt_ty</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-sel'>_elt_ty'</span> <span class='hs-keyglyph'>-></span>
<a name="line-107"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ids</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupLocalIds</span> <span class='hs-varid'>names</span>
<a name="line-108"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>pairs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>loop</span> <span class='hs-varid'>pairs</span>
<a name="line-109"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>ids</span><span class='hs-layout'>,</span> <span class='hs-varid'>pairs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-110"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-varid'>ids</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>pairs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span> <span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-111"></a>
<a name="line-112"></a><span class='hs-definition'>tcLcStmt</span> <span class='hs-varid'>m_tc</span> <span class='hs-varid'>ctxt</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-varid'>elt_ty</span> <span class='hs-varid'>thing_inside</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-113"></a> <span class='hs-layout'>(</span><span class='hs-varid'>stmts'</span><span class='hs-layout'>,</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-layout'>,</span> <span class='hs-varid'>maybeByExpr'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span>
<a name="line-114"></a> <span class='hs-varid'>tcStmts</span> <span class='hs-layout'>(</span><span class='hs-conid'>TransformStmtCtxt</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcLcStmt</span> <span class='hs-varid'>m_tc</span><span class='hs-layout'>)</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>elt_ty</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>elt_ty'</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-115"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>alphaListTy</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTyConApp</span> <span class='hs-varid'>m_tc</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>alphaTy</span><span class='hs-keyglyph'>]</span>
<a name="line-116"></a>
<a name="line-117"></a> <span class='hs-layout'>(</span><span class='hs-varid'>usingExpr'</span><span class='hs-layout'>,</span> <span class='hs-varid'>maybeByExpr'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span>
<a name="line-118"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>maybeByExpr</span> <span class='hs-keyword'>of</span>
<a name="line-119"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-120"></a> <span class='hs-comment'>-- We must validate that usingExpr :: forall a. [a] -> [a]</span>
<a name="line-121"></a> <span class='hs-varid'>usingExpr'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcPolyExpr</span> <span class='hs-varid'>usingExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkForAllTy</span> <span class='hs-varid'>alphaTyVar</span> <span class='hs-layout'>(</span><span class='hs-varid'>alphaListTy</span> <span class='hs-varop'>`mkFunTy`</span> <span class='hs-varid'>alphaListTy</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-122"></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-conid'>Nothing</span><span class='hs-layout'>)</span>
<a name="line-123"></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-124"></a> <span class='hs-comment'>-- We must infer a type such that e :: t and then check that usingExpr :: forall a. (a -> t) -> [a] -> [a]</span>
<a name="line-125"></a> <span class='hs-layout'>(</span><span class='hs-varid'>byExpr'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tTy</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcInferRhoNC</span> <span class='hs-varid'>byExpr</span>
<a name="line-126"></a> <span class='hs-varid'>usingExpr'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcPolyExpr</span> <span class='hs-varid'>usingExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkForAllTy</span> <span class='hs-varid'>alphaTyVar</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>alphaTy</span> <span class='hs-varop'>`mkFunTy`</span> <span class='hs-varid'>tTy</span><span class='hs-layout'>)</span> <span class='hs-varop'>`mkFunTy`</span> <span class='hs-layout'>(</span><span class='hs-varid'>alphaListTy</span> <span class='hs-varop'>`mkFunTy`</span> <span class='hs-varid'>alphaListTy</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-127"></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-conid'>Just</span> <span class='hs-varid'>byExpr'</span><span class='hs-layout'>)</span>
<a name="line-128"></a>
<a name="line-129"></a> <span class='hs-varid'>binders'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupLocalIds</span> <span class='hs-varid'>binders</span>
<a name="line-130"></a> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>thing_inside</span> <span class='hs-varid'>elt_ty'</span>
<a name="line-131"></a>
<a name="line-132"></a> <span class='hs-varid'>return</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-layout'>,</span> <span class='hs-varid'>maybeByExpr'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span>
<a name="line-133"></a>
<a name="line-134"></a> <span class='hs-varid'>return</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-varid'>thing</span><span class='hs-layout'>)</span>
<a name="line-135"></a>
<a name="line-136"></a><span class='hs-definition'>tcLcStmt</span> <span class='hs-varid'>m_tc</span> <span class='hs-varid'>ctxt</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'>bindersMap</span><span class='hs-layout'>)</span> <span class='hs-varid'>groupByClause</span><span class='hs-layout'>)</span> <span class='hs-varid'>elt_ty</span> <span class='hs-varid'>thing_inside</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-137"></a> <span class='hs-layout'>(</span><span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>bindersMap'</span><span class='hs-layout'>,</span> <span class='hs-varid'>groupByClause'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span>
<a name="line-138"></a> <span class='hs-varid'>tcStmts</span> <span class='hs-layout'>(</span><span class='hs-conid'>TransformStmtCtxt</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcLcStmt</span> <span class='hs-varid'>m_tc</span><span class='hs-layout'>)</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>elt_ty</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>elt_ty'</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-139"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>alphaListTy</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTyConApp</span> <span class='hs-varid'>m_tc</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>alphaTy</span><span class='hs-keyglyph'>]</span>
<a name="line-140"></a> <span class='hs-varid'>alphaListListTy</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTyConApp</span> <span class='hs-varid'>m_tc</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>alphaListTy</span><span class='hs-keyglyph'>]</span>
<a name="line-141"></a>
<a name="line-142"></a> <span class='hs-varid'>groupByClause'</span> <span class='hs-keyglyph'><-</span>
<a name="line-143"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>groupByClause</span> <span class='hs-keyword'>of</span>
<a name="line-144"></a> <span class='hs-conid'>GroupByNothing</span> <span class='hs-varid'>usingExpr</span> <span class='hs-keyglyph'>-></span>
<a name="line-145"></a> <span class='hs-comment'>-- We must validate that usingExpr :: forall a. [a] -> [[a]]</span>
<a name="line-146"></a> <span class='hs-varid'>tcPolyExpr</span> <span class='hs-varid'>usingExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkForAllTy</span> <span class='hs-varid'>alphaTyVar</span> <span class='hs-layout'>(</span><span class='hs-varid'>alphaListTy</span> <span class='hs-varop'>`mkFunTy`</span> <span class='hs-varid'>alphaListListTy</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>>>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-varop'>.</span> <span class='hs-conid'>GroupByNothing</span><span class='hs-layout'>)</span>
<a name="line-147"></a> <span class='hs-conid'>GroupBySomething</span> <span class='hs-varid'>eitherUsingExpr</span> <span class='hs-varid'>byExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-148"></a> <span class='hs-comment'>-- We must infer a type such that byExpr :: t</span>
<a name="line-149"></a> <span class='hs-layout'>(</span><span class='hs-varid'>byExpr'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tTy</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcInferRhoNC</span> <span class='hs-varid'>byExpr</span>
<a name="line-150"></a>
<a name="line-151"></a> <span class='hs-comment'>-- If it exists, we then check that usingExpr :: forall a. (a -> t) -> [a] -> [[a]]</span>
<a name="line-152"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>expectedUsingType</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkForAllTy</span> <span class='hs-varid'>alphaTyVar</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>alphaTy</span> <span class='hs-varop'>`mkFunTy`</span> <span class='hs-varid'>tTy</span><span class='hs-layout'>)</span> <span class='hs-varop'>`mkFunTy`</span> <span class='hs-layout'>(</span><span class='hs-varid'>alphaListTy</span> <span class='hs-varop'>`mkFunTy`</span> <span class='hs-varid'>alphaListListTy</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-153"></a> <span class='hs-varid'>eitherUsingExpr'</span> <span class='hs-keyglyph'><-</span>
<a name="line-154"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>eitherUsingExpr</span> <span class='hs-keyword'>of</span>
<a name="line-155"></a> <span class='hs-conid'>Left</span> <span class='hs-varid'>usingExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>tcPolyExpr</span> <span class='hs-varid'>usingExpr</span> <span class='hs-varid'>expectedUsingType</span><span class='hs-layout'>)</span> <span class='hs-varop'>>>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-varop'>.</span> <span class='hs-conid'>Left</span><span class='hs-layout'>)</span>
<a name="line-156"></a> <span class='hs-conid'>Right</span> <span class='hs-varid'>usingExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>tcPolyExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>noLoc</span> <span class='hs-varid'>usingExpr</span><span class='hs-layout'>)</span> <span class='hs-varid'>expectedUsingType</span><span class='hs-layout'>)</span> <span class='hs-varop'>>>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-varop'>.</span> <span class='hs-conid'>Right</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unLoc</span><span class='hs-layout'>)</span>
<a name="line-157"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>GroupBySomething</span> <span class='hs-varid'>eitherUsingExpr'</span> <span class='hs-varid'>byExpr'</span>
<a name="line-158"></a>
<a name="line-159"></a> <span class='hs-comment'>-- Find the IDs and types of all old binders</span>
<a name="line-160"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>oldBinders</span><span class='hs-layout'>,</span> <span class='hs-varid'>newBinders</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unzip</span> <span class='hs-varid'>bindersMap</span>
<a name="line-161"></a> <span class='hs-varid'>oldBinders'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupLocalIds</span> <span class='hs-varid'>oldBinders</span>
<a name="line-162"></a>
<a name="line-163"></a> <span class='hs-comment'>-- Ensure that every old binder of type b is linked up with its new binder which should have type [b]</span>
<a name="line-164"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>newBinders'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>zipWith</span> <span class='hs-varid'>associateNewBinder</span> <span class='hs-varid'>oldBinders'</span> <span class='hs-varid'>newBinders</span>
<a name="line-165"></a>
<a name="line-166"></a> <span class='hs-comment'>-- Type check the thing in the environment with these new binders and return the result</span>
<a name="line-167"></a> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcExtendIdEnv</span> <span class='hs-varid'>newBinders'</span> <span class='hs-layout'>(</span><span class='hs-varid'>thing_inside</span> <span class='hs-varid'>elt_ty'</span><span class='hs-layout'>)</span>
<a name="line-168"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>zipEqual</span> <span class='hs-str'>"tcLcStmt: Old and new binder lists were not of the same length"</span> <span class='hs-varid'>oldBinders'</span> <span class='hs-varid'>newBinders'</span><span class='hs-layout'>,</span> <span class='hs-varid'>groupByClause'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span>
<a name="line-169"></a>
<a name="line-170"></a> <span class='hs-varid'>return</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'>bindersMap'</span><span class='hs-layout'>)</span> <span class='hs-varid'>groupByClause'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span>
<a name="line-171"></a> <span class='hs-keyword'>where</span>
<a name="line-172"></a> <span class='hs-varid'>associateNewBinder</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcId</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcId</span>
<a name="line-173"></a> <span class='hs-varid'>associateNewBinder</span> <span class='hs-varid'>oldBinder</span> <span class='hs-varid'>newBinder</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkLocalId</span> <span class='hs-varid'>newBinder</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkTyConApp</span> <span class='hs-varid'>m_tc</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>idType</span> <span class='hs-varid'>oldBinder</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-174"></a>
<a name="line-175"></a><span class='hs-definition'>tcLcStmt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>stmt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span>
<a name="line-176"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcLcStmt: unexpected Stmt"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>stmt</span><span class='hs-layout'>)</span>
<a name="line-177"></a>
<a name="line-178"></a><span class='hs-comment'>--------------------------------</span>
<a name="line-179"></a><span class='hs-comment'>-- Do-notation</span>
<a name="line-180"></a><span class='hs-comment'>-- The main excitement here is dealing with rebindable syntax</span>
<a name="line-181"></a>
<a name="line-182"></a><a name="tcDoStmt"></a><span class='hs-definition'>tcDoStmt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcStmtChecker</span>
<a name="line-183"></a>
<a name="line-184"></a><span class='hs-definition'>tcDoStmt</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-conid'>BindStmt</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>bind_op</span> <span class='hs-varid'>fail_op</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-185"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- Deal with rebindable syntax:</span>
<a name="line-186"></a> <span class='hs-comment'>-- (>>=) :: rhs_ty -> (pat_ty -> new_res_ty) -> res_ty</span>
<a name="line-187"></a> <span class='hs-comment'>-- This level of generality is needed for using do-notation</span>
<a name="line-188"></a> <span class='hs-comment'>-- in full generality; see Trac #1537</span>
<a name="line-189"></a>
<a name="line-190"></a> <span class='hs-comment'>-- I'd like to put this *after* the tcSyntaxOp </span>
<a name="line-191"></a> <span class='hs-comment'>-- (see Note [Treat rebindable syntax first], but that breaks </span>
<a name="line-192"></a> <span class='hs-comment'>-- the rigidity info for GADTs. When we move to the new story</span>
<a name="line-193"></a> <span class='hs-comment'>-- for GADTs, we can move this after tcSyntaxOp</span>
<a name="line-194"></a> <span class='hs-layout'>(</span><span class='hs-varid'>rhs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcInferRhoNC</span> <span class='hs-varid'>rhs</span>
<a name="line-195"></a>
<a name="line-196"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>bind_op'</span><span class='hs-layout'>,</span> <span class='hs-varid'>new_res_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span>
<a name="line-197"></a> <span class='hs-varid'>withBox</span> <span class='hs-varid'>liftedTypeKind</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>pat_ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-198"></a> <span class='hs-varid'>withBox</span> <span class='hs-varid'>liftedTypeKind</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>new_res_ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-199"></a> <span class='hs-varid'>tcSyntaxOp</span> <span class='hs-conid'>DoOrigin</span> <span class='hs-varid'>bind_op</span>
<a name="line-200"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkFunTys</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>rhs_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkFunTy</span> <span class='hs-varid'>pat_ty</span> <span class='hs-varid'>new_res_ty</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span>
<a name="line-201"></a>
<a name="line-202"></a> <span class='hs-comment'>-- If (but only if) the pattern can fail, </span>
<a name="line-203"></a> <span class='hs-comment'>-- typecheck the 'fail' operator</span>
<a name="line-204"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>fail_op'</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>isIrrefutableHsPat</span> <span class='hs-varid'>pat</span>
<a name="line-205"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-varid'>noSyntaxExpr</span>
<a name="line-206"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>tcSyntaxOp</span> <span class='hs-conid'>DoOrigin</span> <span class='hs-varid'>fail_op</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkFunTy</span> <span class='hs-varid'>stringTy</span> <span class='hs-varid'>new_res_ty</span><span class='hs-layout'>)</span>
<a name="line-207"></a>
<a name="line-208"></a> <span class='hs-comment'>-- We should typecheck the RHS *before* the pattern,</span>
<a name="line-209"></a> <span class='hs-comment'>-- because of GADTs. </span>
<a name="line-210"></a> <span class='hs-comment'>-- do { pat <- rhs; <rest> }</span>
<a name="line-211"></a> <span class='hs-comment'>-- is rather like</span>
<a name="line-212"></a> <span class='hs-comment'>-- case rhs of { pat -> <rest> }</span>
<a name="line-213"></a> <span class='hs-comment'>-- We do inference on rhs, so that information about its type </span>
<a name="line-214"></a> <span class='hs-comment'>-- can be refined when type-checking the pattern. </span>
<a name="line-215"></a>
<a name="line-216"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>pat'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>StmtCtxt</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>)</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>pat_ty</span> <span class='hs-varid'>new_res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-217"></a>
<a name="line-218"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>BindStmt</span> <span class='hs-varid'>pat'</span> <span class='hs-varid'>rhs'</span> <span class='hs-varid'>bind_op'</span> <span class='hs-varid'>fail_op'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-219"></a>
<a name="line-220"></a>
<a name="line-221"></a><span class='hs-definition'>tcDoStmt</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExprStmt</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>then_op</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-222"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- Deal with rebindable syntax; </span>
<a name="line-223"></a> <span class='hs-comment'>-- (>>) :: rhs_ty -> new_res_ty -> res_ty</span>
<a name="line-224"></a> <span class='hs-comment'>-- See also Note [Treat rebindable syntax first]</span>
<a name="line-225"></a> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>then_op'</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>new_res_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span>
<a name="line-226"></a> <span class='hs-varid'>withBox</span> <span class='hs-varid'>liftedTypeKind</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>new_res_ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-227"></a> <span class='hs-varid'>withBox</span> <span class='hs-varid'>liftedTypeKind</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>rhs_ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-228"></a> <span class='hs-varid'>tcSyntaxOp</span> <span class='hs-conid'>DoOrigin</span> <span class='hs-varid'>then_op</span>
<a name="line-229"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkFunTys</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>rhs_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>new_res_ty</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span>
<a name="line-230"></a>
<a name="line-231"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>rhs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcMonoExprNC</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>rhs_ty</span>
<a name="line-232"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>thing_inside</span> <span class='hs-varid'>new_res_ty</span>
<a name="line-233"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExprStmt</span> <span class='hs-varid'>rhs'</span> <span class='hs-varid'>then_op'</span> <span class='hs-varid'>rhs_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-234"></a>
<a name="line-235"></a><span class='hs-definition'>tcDoStmt</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-conid'>RecStmt</span> <span class='hs-layout'>{</span> <span class='hs-varid'>recS_stmts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>stmts</span><span class='hs-layout'>,</span> <span class='hs-varid'>recS_later_ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>later_names</span>
<a name="line-236"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>recS_rec_ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rec_names</span><span class='hs-layout'>,</span> <span class='hs-varid'>recS_ret_fn</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ret_op</span>
<a name="line-237"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>recS_mfix_fn</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mfix_op</span><span class='hs-layout'>,</span> <span class='hs-varid'>recS_bind_fn</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bind_op</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-238"></a> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-239"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>tup_names</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rec_names</span> <span class='hs-varop'>++</span> <span class='hs-varid'>filterOut</span> <span class='hs-layout'>(</span><span class='hs-varop'>`elem`</span> <span class='hs-varid'>rec_names</span><span class='hs-layout'>)</span> <span class='hs-varid'>later_names</span>
<a name="line-240"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tup_elt_tys</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newFlexiTyVarTys</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>tup_names</span><span class='hs-layout'>)</span> <span class='hs-varid'>liftedTypeKind</span>
<a name="line-241"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>tup_ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>zipWith</span> <span class='hs-varid'>mkLocalId</span> <span class='hs-varid'>tup_names</span> <span class='hs-varid'>tup_elt_tys</span>
<a name="line-242"></a> <span class='hs-varid'>tup_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkCoreTupTy</span> <span class='hs-varid'>tup_elt_tys</span>
<a name="line-243"></a>
<a name="line-244"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tcExtendIdEnv</span> <span class='hs-varid'>tup_ids</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-245"></a> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>ret_op'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tup_rets</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>stmts_ty</span><span class='hs-layout'>)</span>
<a name="line-246"></a> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>withBox</span> <span class='hs-varid'>liftedTypeKind</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>stmts_ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-247"></a> <span class='hs-varid'>tcStmts</span> <span class='hs-varid'>ctxt</span> <span class='hs-varid'>tcDoStmt</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>stmts_ty</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>inner_res_ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-248"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tup_rets</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zipWithM</span> <span class='hs-varid'>tc_ret</span> <span class='hs-varid'>tup_names</span> <span class='hs-varid'>tup_elt_tys</span>
<a name="line-249"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>ret_op'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcSyntaxOp</span> <span class='hs-conid'>DoOrigin</span> <span class='hs-varid'>ret_op</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkFunTy</span> <span class='hs-varid'>tup_ty</span> <span class='hs-varid'>inner_res_ty</span><span class='hs-layout'>)</span>
<a name="line-250"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>ret_op'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tup_rets</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-251"></a>
<a name="line-252"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>mfix_op'</span><span class='hs-layout'>,</span> <span class='hs-varid'>mfix_res_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>withBox</span> <span class='hs-varid'>liftedTypeKind</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>mfix_res_ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-253"></a> <span class='hs-varid'>tcSyntaxOp</span> <span class='hs-conid'>DoOrigin</span> <span class='hs-varid'>mfix_op</span>
<a name="line-254"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkFunTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkFunTy</span> <span class='hs-varid'>tup_ty</span> <span class='hs-varid'>stmts_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>mfix_res_ty</span><span class='hs-layout'>)</span>
<a name="line-255"></a>
<a name="line-256"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>bind_op'</span><span class='hs-layout'>,</span> <span class='hs-varid'>new_res_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>withBox</span> <span class='hs-varid'>liftedTypeKind</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>new_res_ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-257"></a> <span class='hs-varid'>tcSyntaxOp</span> <span class='hs-conid'>DoOrigin</span> <span class='hs-varid'>bind_op</span>
<a name="line-258"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkFunTys</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mfix_res_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkFunTy</span> <span class='hs-varid'>tup_ty</span> <span class='hs-varid'>new_res_ty</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span>
<a name="line-259"></a>
<a name="line-260"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>thing</span><span class='hs-layout'>,</span><span class='hs-varid'>lie</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getLIE</span> <span class='hs-layout'>(</span><span class='hs-varid'>thing_inside</span> <span class='hs-varid'>new_res_ty</span><span class='hs-layout'>)</span>
<a name="line-261"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>lie_binds</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>bindInstsOfLocalFuns</span> <span class='hs-varid'>lie</span> <span class='hs-varid'>tup_ids</span>
<a name="line-262"></a>
<a name="line-263"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>rec_ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>takeList</span> <span class='hs-varid'>rec_names</span> <span class='hs-varid'>tup_ids</span>
<a name="line-264"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>later_ids</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupLocalIds</span> <span class='hs-varid'>later_names</span>
<a name="line-265"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>traceTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"tcdo"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>rec_ids</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>rec_ids</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-266"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>later_ids</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>later_ids</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-267"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>RecStmt</span> <span class='hs-layout'>{</span> <span class='hs-varid'>recS_stmts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-varid'>recS_later_ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>later_ids</span>
<a name="line-268"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>recS_rec_ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rec_ids</span><span class='hs-layout'>,</span> <span class='hs-varid'>recS_ret_fn</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ret_op'</span>
<a name="line-269"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>recS_mfix_fn</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mfix_op'</span><span class='hs-layout'>,</span> <span class='hs-varid'>recS_bind_fn</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bind_op'</span>
<a name="line-270"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>recS_rec_rets</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tup_rets</span><span class='hs-layout'>,</span> <span class='hs-varid'>recS_dicts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lie_binds</span> <span class='hs-layout'>}</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span>
<a name="line-271"></a> <span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-272"></a> <span class='hs-keyword'>where</span>
<a name="line-273"></a> <span class='hs-comment'>-- Unify the types of the "final" Ids with those of "knot-tied" Ids</span>
<a name="line-274"></a> <span class='hs-varid'>tc_ret</span> <span class='hs-varid'>rec_name</span> <span class='hs-varid'>mono_ty</span>
<a name="line-275"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>poly_id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupId</span> <span class='hs-varid'>rec_name</span>
<a name="line-276"></a> <span class='hs-comment'>-- poly_id may have a polymorphic type</span>
<a name="line-277"></a> <span class='hs-comment'>-- but mono_ty is just a monomorphic type variable</span>
<a name="line-278"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>co_fn</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcSubExp</span> <span class='hs-conid'>DoOrigin</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>poly_id</span><span class='hs-layout'>)</span> <span class='hs-varid'>mono_ty</span>
<a name="line-279"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkHsWrap</span> <span class='hs-varid'>co_fn</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsVar</span> <span class='hs-varid'>poly_id</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-280"></a>
<a name="line-281"></a><span class='hs-definition'>tcDoStmt</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>stmt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span>
<a name="line-282"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcDoStmt: unexpected Stmt"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>stmt</span><span class='hs-layout'>)</span>
</pre>\end{code}
Note [Treat rebindable syntax first]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When typechecking
do { bar; ... } :: IO ()
we want to typecheck 'bar' in the knowledge that it should be an IO thing,
pushing info from the context into the RHS. To do this, we check the
rebindable syntax first, and push that information into (tcMonoExprNC rhs).
Otherwise the error shows up when cheking the rebindable syntax, and
the expected/inferred stuff is back to front (see Trac #3613).
\begin{code}
<pre><a name="line-1"></a><span class='hs-comment'>--------------------------------</span>
<a name="line-2"></a><span class='hs-comment'>-- Mdo-notation</span>
<a name="line-3"></a><span class='hs-comment'>-- The distinctive features here are</span>
<a name="line-4"></a><span class='hs-comment'>-- (a) RecStmts, and</span>
<a name="line-5"></a><span class='hs-comment'>-- (b) no rebindable syntax</span>
<a name="line-6"></a>
<a name="line-7"></a><a name="tcMDoStmt"></a><span class='hs-definition'>tcMDoStmt</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>LHsExpr</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>,</span> <span class='hs-conid'>TcType</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- RHS inference</span>
<a name="line-8"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcStmtChecker</span>
<a name="line-9"></a><span class='hs-definition'>tcMDoStmt</span> <span class='hs-varid'>tc_rhs</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-conid'>BindStmt</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>rhs</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-10"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>rhs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>pat_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tc_rhs</span> <span class='hs-varid'>rhs</span>
<a name="line-11"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>pat'</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcPat</span> <span class='hs-layout'>(</span><span class='hs-conid'>StmtCtxt</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>)</span> <span class='hs-varid'>pat</span> <span class='hs-varid'>pat_ty</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-12"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>BindStmt</span> <span class='hs-varid'>pat'</span> <span class='hs-varid'>rhs'</span> <span class='hs-varid'>noSyntaxExpr</span> <span class='hs-varid'>noSyntaxExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-definition'>tcMDoStmt</span> <span class='hs-varid'>tc_rhs</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExprStmt</span> <span class='hs-varid'>rhs</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>rhs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>elt_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tc_rhs</span> <span class='hs-varid'>rhs</span>
<a name="line-16"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>thing_inside</span> <span class='hs-varid'>res_ty</span>
<a name="line-17"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>ExprStmt</span> <span class='hs-varid'>rhs'</span> <span class='hs-varid'>noSyntaxExpr</span> <span class='hs-varid'>elt_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-18"></a>
<a name="line-19"></a><span class='hs-definition'>tcMDoStmt</span> <span class='hs-varid'>tc_rhs</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-conid'>RecStmt</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>laterNames</span> <span class='hs-varid'>recNames</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>thing_inside</span>
<a name="line-20"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>rec_tys</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newFlexiTyVarTys</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>recNames</span><span class='hs-layout'>)</span> <span class='hs-varid'>liftedTypeKind</span>
<a name="line-21"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>rec_ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>zipWith</span> <span class='hs-varid'>mkLocalId</span> <span class='hs-varid'>recNames</span> <span class='hs-varid'>rec_tys</span>
<a name="line-22"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tcExtendIdEnv</span> <span class='hs-varid'>rec_ids</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-23"></a> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>stmts'</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>later_ids</span><span class='hs-layout'>,</span> <span class='hs-varid'>rec_rets</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-24"></a> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcStmts</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcMDoStmt</span> <span class='hs-varid'>tc_rhs</span><span class='hs-layout'>)</span> <span class='hs-varid'>stmts</span> <span class='hs-varid'>res_ty</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-sel'>_res_ty'</span> <span class='hs-keyglyph'>-></span>
<a name="line-25"></a> <span class='hs-comment'>-- ToDo: res_ty not really right</span>
<a name="line-26"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>rec_rets</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zipWithM</span> <span class='hs-varid'>tc_ret</span> <span class='hs-varid'>recNames</span> <span class='hs-varid'>rec_tys</span>
<a name="line-27"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>later_ids</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupLocalIds</span> <span class='hs-varid'>laterNames</span>
<a name="line-28"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>later_ids</span><span class='hs-layout'>,</span> <span class='hs-varid'>rec_rets</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-29"></a>
<a name="line-30"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>thing</span><span class='hs-layout'>,</span><span class='hs-varid'>lie</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcExtendIdEnv</span> <span class='hs-varid'>later_ids</span> <span class='hs-layout'>(</span><span class='hs-varid'>getLIE</span> <span class='hs-layout'>(</span><span class='hs-varid'>thing_inside</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-31"></a> <span class='hs-comment'>-- NB: The rec_ids for the recursive things </span>
<a name="line-32"></a> <span class='hs-comment'>-- already scope over this part. This binding may shadow</span>
<a name="line-33"></a> <span class='hs-comment'>-- some of them with polymorphic things with the same Name</span>
<a name="line-34"></a> <span class='hs-comment'>-- (see note [RecStmt] in HsExpr)</span>
<a name="line-35"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>lie_binds</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>bindInstsOfLocalFuns</span> <span class='hs-varid'>lie</span> <span class='hs-varid'>later_ids</span>
<a name="line-36"></a>
<a name="line-37"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>RecStmt</span> <span class='hs-varid'>stmts'</span> <span class='hs-varid'>later_ids</span> <span class='hs-varid'>rec_ids</span> <span class='hs-varid'>noSyntaxExpr</span> <span class='hs-varid'>noSyntaxExpr</span> <span class='hs-varid'>noSyntaxExpr</span> <span class='hs-varid'>rec_rets</span> <span class='hs-varid'>lie_binds</span><span class='hs-layout'>,</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span>
<a name="line-38"></a> <span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-39"></a> <span class='hs-keyword'>where</span>
<a name="line-40"></a> <span class='hs-comment'>-- Unify the types of the "final" Ids with those of "knot-tied" Ids</span>
<a name="line-41"></a> <span class='hs-varid'>tc_ret</span> <span class='hs-varid'>rec_name</span> <span class='hs-varid'>mono_ty</span>
<a name="line-42"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>poly_id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupId</span> <span class='hs-varid'>rec_name</span>
<a name="line-43"></a> <span class='hs-comment'>-- poly_id may have a polymorphic type</span>
<a name="line-44"></a> <span class='hs-comment'>-- but mono_ty is just a monomorphic type variable</span>
<a name="line-45"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>co_fn</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcSubExp</span> <span class='hs-conid'>DoOrigin</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>poly_id</span><span class='hs-layout'>)</span> <span class='hs-varid'>mono_ty</span>
<a name="line-46"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkHsWrap</span> <span class='hs-varid'>co_fn</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsVar</span> <span class='hs-varid'>poly_id</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-47"></a>
<a name="line-48"></a><span class='hs-definition'>tcMDoStmt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>stmt</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span>
<a name="line-49"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcMDoStmt: unexpected Stmt"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>stmt</span><span class='hs-layout'>)</span>
<a name="line-50"></a>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Errors and contexts}
%* *
%************************************************************************
@sameNoOfArgs@ takes a @[RenamedMatch]@ and decides whether the same
number of args are used in each equation.
\begin{code}
<pre><a name="line-1"></a><a name="checkArgs"></a><span class='hs-definition'>checkArgs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MatchGroup</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-2"></a><span class='hs-definition'>checkArgs</span> <span class='hs-varid'>fun</span> <span class='hs-layout'>(</span><span class='hs-conid'>MatchGroup</span> <span class='hs-layout'>(</span><span class='hs-varid'>match1</span><span class='hs-conop'>:</span><span class='hs-varid'>matches</span><span class='hs-layout'>)</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>
<a name="line-3"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>null</span> <span class='hs-varid'>bad_matches</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-4"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-5"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>failWithTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Equations for"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>fun</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span>
<a name="line-6"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"have different numbers of arguments"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-7"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>getLoc</span> <span class='hs-varid'>match1</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-8"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>getLoc</span> <span class='hs-layout'>(</span><span class='hs-varid'>head</span> <span class='hs-varid'>bad_matches</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-keyword'>where</span>
<a name="line-10"></a> <span class='hs-varid'>n_args1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>args_in_match</span> <span class='hs-varid'>match1</span>
<a name="line-11"></a> <span class='hs-varid'>bad_matches</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>m</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>matches</span><span class='hs-layout'>,</span> <span class='hs-varid'>args_in_match</span> <span class='hs-varid'>m</span> <span class='hs-varop'>/=</span> <span class='hs-varid'>n_args1</span><span class='hs-keyglyph'>]</span>
<a name="line-12"></a>
<a name="line-13"></a> <span class='hs-varid'>args_in_match</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LMatch</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span>
<a name="line-14"></a> <span class='hs-varid'>args_in_match</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>Match</span> <span class='hs-varid'>pats</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>pats</span>
<a name="line-15"></a><span class='hs-definition'>checkArgs</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"TcPat.checkArgs"</span> <span class='hs-comment'>-- Matches always non-empty</span>
</pre>\end{code}
</body>
</html>
