<?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>coreSyn/MkCore.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
\begin{code}
<pre><a name="line-1"></a><span class='hs-comment'>-- | Handy functions for creating much Core syntax</span>
<a name="line-2"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>MkCore</span> <span class='hs-layout'>(</span>
<a name="line-3"></a> <span class='hs-comment'>-- * Constructing normal syntax</span>
<a name="line-4"></a> <span class='hs-varid'>mkCoreLet</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkCoreLets</span><span class='hs-layout'>,</span>
<a name="line-5"></a> <span class='hs-varid'>mkCoreApp</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkCoreApps</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkCoreConApps</span><span class='hs-layout'>,</span>
<a name="line-6"></a> <span class='hs-varid'>mkCoreLams</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkWildCase</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkWildBinder</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkIfThenElse</span><span class='hs-layout'>,</span>
<a name="line-7"></a>
<a name="line-8"></a> <span class='hs-comment'>-- * Constructing boxed literals</span>
<a name="line-9"></a> <span class='hs-varid'>mkWordExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkWordExprWord</span><span class='hs-layout'>,</span>
<a name="line-10"></a> <span class='hs-varid'>mkIntExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkIntExprInt</span><span class='hs-layout'>,</span>
<a name="line-11"></a> <span class='hs-varid'>mkIntegerExpr</span><span class='hs-layout'>,</span>
<a name="line-12"></a> <span class='hs-varid'>mkFloatExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkDoubleExpr</span><span class='hs-layout'>,</span>
<a name="line-13"></a> <span class='hs-varid'>mkCharExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkStringExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkStringExprFS</span><span class='hs-layout'>,</span>
<a name="line-14"></a>
<a name="line-15"></a> <span class='hs-comment'>-- * Constructing general big tuples</span>
<a name="line-16"></a> <span class='hs-comment'>-- $big_tuples</span>
<a name="line-17"></a> <span class='hs-varid'>mkChunkified</span><span class='hs-layout'>,</span>
<a name="line-18"></a>
<a name="line-19"></a> <span class='hs-comment'>-- * Constructing small tuples</span>
<a name="line-20"></a> <span class='hs-varid'>mkCoreVarTup</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkCoreVarTupTy</span><span class='hs-layout'>,</span>
<a name="line-21"></a> <span class='hs-varid'>mkCoreTup</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkCoreTupTy</span><span class='hs-layout'>,</span>
<a name="line-22"></a>
<a name="line-23"></a> <span class='hs-comment'>-- * Constructing big tuples</span>
<a name="line-24"></a> <span class='hs-varid'>mkBigCoreVarTup</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkBigCoreVarTupTy</span><span class='hs-layout'>,</span>
<a name="line-25"></a> <span class='hs-varid'>mkBigCoreTup</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkBigCoreTupTy</span><span class='hs-layout'>,</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-comment'>-- * Deconstructing small tuples</span>
<a name="line-28"></a> <span class='hs-varid'>mkSmallTupleSelector</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkSmallTupleCase</span><span class='hs-layout'>,</span>
<a name="line-29"></a>
<a name="line-30"></a> <span class='hs-comment'>-- * Deconstructing big tuples</span>
<a name="line-31"></a> <span class='hs-varid'>mkTupleSelector</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkTupleCase</span><span class='hs-layout'>,</span>
<a name="line-32"></a>
<a name="line-33"></a> <span class='hs-comment'>-- * Constructing list expressions</span>
<a name="line-34"></a> <span class='hs-varid'>mkNilExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkConsExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkListExpr</span><span class='hs-layout'>,</span>
<a name="line-35"></a> <span class='hs-varid'>mkFoldrExpr</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkBuildExpr</span>
<a name="line-36"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-37"></a>
<a name="line-38"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-39"></a>
<a name="line-40"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Id</span>
<a name="line-41"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Var</span> <span class='hs-layout'>(</span> <span class='hs-varid'>setTyVarUnique</span> <span class='hs-layout'>)</span>
<a name="line-42"></a>
<a name="line-43"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreSyn</span>
<a name="line-44"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreUtils</span> <span class='hs-layout'>(</span> <span class='hs-varid'>exprType</span><span class='hs-layout'>,</span> <span class='hs-varid'>needsCaseBinding</span><span class='hs-layout'>,</span> <span class='hs-varid'>bindNonRec</span> <span class='hs-layout'>)</span>
<a name="line-45"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Literal</span>
<a name="line-46"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HscTypes</span>
<a name="line-47"></a>
<a name="line-48"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TysWiredIn</span>
<a name="line-49"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>PrelNames</span>
<a name="line-50"></a>
<a name="line-51"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Type</span>
<a name="line-52"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TysPrim</span> <span class='hs-layout'>(</span> <span class='hs-varid'>alphaTyVar</span> <span class='hs-layout'>)</span>
<a name="line-53"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DataCon</span> <span class='hs-layout'>(</span> <span class='hs-conid'>DataCon</span><span class='hs-layout'>,</span> <span class='hs-varid'>dataConWorkId</span> <span class='hs-layout'>)</span>
<a name="line-54"></a>
<a name="line-55"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastString</span>
<a name="line-56"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>UniqSupply</span>
<a name="line-57"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Unique</span> <span class='hs-layout'>(</span> <span class='hs-varid'>mkBuiltinUnique</span> <span class='hs-layout'>)</span>
<a name="line-58"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>BasicTypes</span>
<a name="line-59"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Util</span> <span class='hs-layout'>(</span> <span class='hs-varid'>notNull</span><span class='hs-layout'>,</span> <span class='hs-varid'>zipEqual</span> <span class='hs-layout'>)</span>
<a name="line-60"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Panic</span>
<a name="line-61"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Constants</span>
<a name="line-62"></a>
<a name="line-63"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Char</span> <span class='hs-layout'>(</span> <span class='hs-varid'>ord</span> <span class='hs-layout'>)</span>
<a name="line-64"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Word</span>
<a name="line-65"></a>
<a name="line-66"></a><span class='hs-keyword'>infixl</span> <span class='hs-num'>4</span> <span class='hs-varop'>`mkCoreApp`</span><span class='hs-layout'>,</span> <span class='hs-varop'>`mkCoreApps`</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Basic CoreSyn construction}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="mkCoreLet"></a><span class='hs-comment'>-- | Bind a binding group over an expression, using a @let@ or @case@ as</span>
<a name="line-2"></a><span class='hs-comment'>-- appropriate (see "CoreSyn#let_app_invariant")</span>
<a name="line-3"></a><span class='hs-definition'>mkCoreLet</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreBind</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-4"></a><span class='hs-definition'>mkCoreLet</span> <span class='hs-layout'>(</span><span class='hs-conid'>NonRec</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span> <span class='hs-comment'>-- See Note [CoreSyn let/app invariant]</span>
<a name="line-5"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>needsCaseBinding</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>)</span> <span class='hs-varid'>rhs</span>
<a name="line-6"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Case</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>bndr</span> <span class='hs-layout'>(</span><span class='hs-varid'>exprType</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>DEFAULT</span><span class='hs-layout'>,</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-varid'>body</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-7"></a><span class='hs-definition'>mkCoreLet</span> <span class='hs-varid'>bind</span> <span class='hs-varid'>body</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Let</span> <span class='hs-varid'>bind</span> <span class='hs-varid'>body</span>
<a name="line-9"></a>
<a name="line-10"></a><a name="mkCoreLets"></a><span class='hs-comment'>-- | Bind a list of binding groups over an expression. The leftmost binding</span>
<a name="line-11"></a><span class='hs-comment'>-- group becomes the outermost group in the resulting expression</span>
<a name="line-12"></a><span class='hs-definition'>mkCoreLets</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBind</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-13"></a><span class='hs-definition'>mkCoreLets</span> <span class='hs-varid'>binds</span> <span class='hs-varid'>body</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-varid'>mkCoreLet</span> <span class='hs-varid'>body</span> <span class='hs-varid'>binds</span>
<a name="line-14"></a>
<a name="line-15"></a><a name="mkCoreApp"></a><span class='hs-comment'>-- | Construct an expression which represents the application of one expression</span>
<a name="line-16"></a><span class='hs-comment'>-- to the other</span>
<a name="line-17"></a><span class='hs-definition'>mkCoreApp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-18"></a><span class='hs-comment'>-- Check the invariant that the arg of an App is ok-for-speculation if unlifted</span>
<a name="line-19"></a><span class='hs-comment'>-- See CoreSyn Note [CoreSyn let/app invariant]</span>
<a name="line-20"></a><span class='hs-definition'>mkCoreApp</span> <span class='hs-varid'>fun</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>App</span> <span class='hs-varid'>fun</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-21"></a><span class='hs-definition'>mkCoreApp</span> <span class='hs-varid'>fun</span> <span class='hs-varid'>arg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mk_val_app</span> <span class='hs-varid'>fun</span> <span class='hs-varid'>arg</span> <span class='hs-varid'>arg_ty</span> <span class='hs-varid'>res_ty</span>
<a name="line-22"></a> <span class='hs-keyword'>where</span>
<a name="line-23"></a> <span class='hs-layout'>(</span><span class='hs-varid'>arg_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitFunTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>exprType</span> <span class='hs-varid'>fun</span><span class='hs-layout'>)</span>
<a name="line-24"></a>
<a name="line-25"></a><a name="mkCoreApps"></a><span class='hs-comment'>-- | Construct an expression which represents the application of a number of</span>
<a name="line-26"></a><span class='hs-comment'>-- expressions to another. The leftmost expression in the list is applied first</span>
<a name="line-27"></a><span class='hs-definition'>mkCoreApps</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-28"></a><span class='hs-comment'>-- Slightly more efficient version of (foldl mkCoreApp)</span>
<a name="line-29"></a><span class='hs-definition'>mkCoreApps</span> <span class='hs-varid'>fun</span> <span class='hs-varid'>args</span>
<a name="line-30"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-varid'>fun</span> <span class='hs-layout'>(</span><span class='hs-varid'>exprType</span> <span class='hs-varid'>fun</span><span class='hs-layout'>)</span> <span class='hs-varid'>args</span>
<a name="line-31"></a> <span class='hs-keyword'>where</span>
<a name="line-32"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>fun</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fun</span>
<a name="line-33"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>fun</span> <span class='hs-varid'>fun_ty</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty</span> <span class='hs-conop'>:</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>fun</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>applyTy</span> <span class='hs-varid'>fun_ty</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>args</span>
<a name="line-34"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>fun</span> <span class='hs-varid'>fun_ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>arg</span> <span class='hs-conop'>:</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-varid'>mk_val_app</span> <span class='hs-varid'>fun</span> <span class='hs-varid'>arg</span> <span class='hs-varid'>arg_ty</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>args</span>
<a name="line-35"></a> <span class='hs-keyword'>where</span>
<a name="line-36"></a> <span class='hs-layout'>(</span><span class='hs-varid'>arg_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitFunTy</span> <span class='hs-varid'>fun_ty</span>
<a name="line-37"></a>
<a name="line-38"></a><a name="mkCoreConApps"></a><span class='hs-comment'>-- | Construct an expression which represents the application of a number of</span>
<a name="line-39"></a><span class='hs-comment'>-- expressions to that of a data constructor expression. The leftmost expression</span>
<a name="line-40"></a><span class='hs-comment'>-- in the list is applied first</span>
<a name="line-41"></a><span class='hs-definition'>mkCoreConApps</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-42"></a><span class='hs-definition'>mkCoreConApps</span> <span class='hs-varid'>con</span> <span class='hs-varid'>args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkCoreApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConWorkId</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>args</span>
<a name="line-43"></a>
<a name="line-44"></a><a name="mk_val_app"></a><span class='hs-comment'>-----------</span>
<a name="line-45"></a><span class='hs-definition'>mk_val_app</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-46"></a><span class='hs-definition'>mk_val_app</span> <span class='hs-varid'>fun</span> <span class='hs-varid'>arg</span> <span class='hs-varid'>arg_ty</span> <span class='hs-keyword'>_</span> <span class='hs-comment'>-- See Note [CoreSyn let/app invariant]</span>
<a name="line-47"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>needsCaseBinding</span> <span class='hs-varid'>arg_ty</span> <span class='hs-varid'>arg</span><span class='hs-layout'>)</span>
<a name="line-48"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>App</span> <span class='hs-varid'>fun</span> <span class='hs-varid'>arg</span> <span class='hs-comment'>-- The vastly common case</span>
<a name="line-49"></a>
<a name="line-50"></a><span class='hs-definition'>mk_val_app</span> <span class='hs-varid'>fun</span> <span class='hs-varid'>arg</span> <span class='hs-varid'>arg_ty</span> <span class='hs-varid'>res_ty</span>
<a name="line-51"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Case</span> <span class='hs-varid'>arg</span> <span class='hs-varid'>arg_id</span> <span class='hs-varid'>res_ty</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>DEFAULT</span><span class='hs-layout'>,</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-conid'>App</span> <span class='hs-varid'>fun</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>arg_id</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-52"></a> <span class='hs-keyword'>where</span>
<a name="line-53"></a> <span class='hs-varid'>arg_id</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkWildBinder</span> <span class='hs-varid'>arg_ty</span>
<a name="line-54"></a> <span class='hs-comment'>-- Lots of shadowing, but it doesn't matter,</span>
<a name="line-55"></a> <span class='hs-comment'>-- because 'fun ' should not have a free wild-id</span>
<a name="line-56"></a> <span class='hs-comment'>--</span>
<a name="line-57"></a> <span class='hs-comment'>-- This is Dangerous. But this is the only place we play this </span>
<a name="line-58"></a> <span class='hs-comment'>-- game, mk_val_app returns an expression that does not have</span>
<a name="line-59"></a> <span class='hs-comment'>-- have a free wild-id. So the only thing that can go wrong</span>
<a name="line-60"></a> <span class='hs-comment'>-- is if you take apart this case expression, and pass a </span>
<a name="line-61"></a> <span class='hs-comment'>-- fragmet of it as the fun part of a 'mk_val_app'.</span>
<a name="line-62"></a>
<a name="line-63"></a>
<a name="line-64"></a><a name="mkWildBinder"></a><span class='hs-comment'>-- | Make a /wildcard binder/. This is typically used when you need a binder </span>
<a name="line-65"></a><span class='hs-comment'>-- that you expect to use only at a *binding* site. Do not use it at</span>
<a name="line-66"></a><span class='hs-comment'>-- occurrence sites because it has a single, fixed unique, and it's very</span>
<a name="line-67"></a><span class='hs-comment'>-- easy to get into difficulties with shadowing. That's why it is used so little.</span>
<a name="line-68"></a><span class='hs-definition'>mkWildBinder</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span>
<a name="line-69"></a><span class='hs-definition'>mkWildBinder</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkSysLocal</span> <span class='hs-layout'>(</span><span class='hs-varid'>fsLit</span> <span class='hs-str'>"wild"</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkBuiltinUnique</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span>
<a name="line-70"></a>
<a name="line-71"></a><a name="mkWildCase"></a><span class='hs-definition'>mkWildCase</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreAlt</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-72"></a><span class='hs-comment'>-- Make a case expression whose case binder is unused</span>
<a name="line-73"></a><span class='hs-comment'>-- The alts should not have any occurrences of WildId</span>
<a name="line-74"></a><span class='hs-definition'>mkWildCase</span> <span class='hs-varid'>scrut</span> <span class='hs-varid'>scrut_ty</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>alts</span>
<a name="line-75"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Case</span> <span class='hs-varid'>scrut</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkWildBinder</span> <span class='hs-varid'>scrut_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>alts</span>
<a name="line-76"></a>
<a name="line-77"></a><a name="mkIfThenElse"></a><span class='hs-definition'>mkIfThenElse</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-78"></a><span class='hs-definition'>mkIfThenElse</span> <span class='hs-varid'>guard</span> <span class='hs-varid'>then_expr</span> <span class='hs-varid'>else_expr</span>
<a name="line-79"></a><span class='hs-comment'>-- Not going to be refining, so okay to take the type of the "then" clause</span>
<a name="line-80"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkWildCase</span> <span class='hs-varid'>guard</span> <span class='hs-varid'>boolTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>exprType</span> <span class='hs-varid'>then_expr</span><span class='hs-layout'>)</span>
<a name="line-81"></a> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-conid'>DataAlt</span> <span class='hs-varid'>falseDataCon</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>else_expr</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Increasing order of tag!</span>
<a name="line-82"></a> <span class='hs-layout'>(</span><span class='hs-conid'>DataAlt</span> <span class='hs-varid'>trueDataCon</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>then_expr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>]</span>
</pre>\end{code}
The functions from this point don't really do anything cleverer than
their counterparts in CoreSyn, but they are here for consistency
\begin{code}
<pre><a name="line-1"></a><a name="mkCoreLams"></a><span class='hs-comment'>-- | Create a lambda where the given expression has a number of variables</span>
<a name="line-2"></a><span class='hs-comment'>-- bound over it. The leftmost binder is that bound by the outermost</span>
<a name="line-3"></a><span class='hs-comment'>-- lambda in the result</span>
<a name="line-4"></a><span class='hs-definition'>mkCoreLams</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreBndr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-5"></a><span class='hs-definition'>mkCoreLams</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkLams</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Making literals}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="mkIntExpr"></a><span class='hs-comment'>-- | Create a 'CoreExpr' which will evaluate to the given @Int@</span>
<a name="line-2"></a><span class='hs-definition'>mkIntExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Result = I# i :: Int</span>
<a name="line-3"></a><span class='hs-definition'>mkIntExpr</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkConApp</span> <span class='hs-varid'>intDataCon</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mkIntLit</span> <span class='hs-varid'>i</span><span class='hs-keyglyph'>]</span>
<a name="line-4"></a>
<a name="line-5"></a><a name="mkIntExprInt"></a><span class='hs-comment'>-- | Create a 'CoreExpr' which will evaluate to the given @Int@</span>
<a name="line-6"></a><span class='hs-definition'>mkIntExprInt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Result = I# i :: Int</span>
<a name="line-7"></a><span class='hs-definition'>mkIntExprInt</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkConApp</span> <span class='hs-varid'>intDataCon</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mkIntLitInt</span> <span class='hs-varid'>i</span><span class='hs-keyglyph'>]</span>
<a name="line-8"></a>
<a name="line-9"></a><a name="mkWordExpr"></a><span class='hs-comment'>-- | Create a 'CoreExpr' which will evaluate to the a @Word@ with the given value</span>
<a name="line-10"></a><span class='hs-definition'>mkWordExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-11"></a><span class='hs-definition'>mkWordExpr</span> <span class='hs-varid'>w</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkConApp</span> <span class='hs-varid'>wordDataCon</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mkWordLit</span> <span class='hs-varid'>w</span><span class='hs-keyglyph'>]</span>
<a name="line-12"></a>
<a name="line-13"></a><a name="mkWordExprWord"></a><span class='hs-comment'>-- | Create a 'CoreExpr' which will evaluate to the given @Word@</span>
<a name="line-14"></a><span class='hs-definition'>mkWordExprWord</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Word</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-15"></a><span class='hs-definition'>mkWordExprWord</span> <span class='hs-varid'>w</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkConApp</span> <span class='hs-varid'>wordDataCon</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mkWordLitWord</span> <span class='hs-varid'>w</span><span class='hs-keyglyph'>]</span>
<a name="line-16"></a>
<a name="line-17"></a><a name="mkIntegerExpr"></a><span class='hs-comment'>-- | Create a 'CoreExpr' which will evaluate to the given @Integer@</span>
<a name="line-18"></a><span class='hs-definition'>mkIntegerExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MonadThings</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Result :: Integer</span>
<a name="line-19"></a><span class='hs-definition'>mkIntegerExpr</span> <span class='hs-varid'>i</span>
<a name="line-20"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>inIntRange</span> <span class='hs-varid'>i</span> <span class='hs-comment'>-- Small enough, so start from an Int</span>
<a name="line-21"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>integer_id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lookupId</span> <span class='hs-varid'>smallIntegerName</span>
<a name="line-22"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkSmallIntegerLit</span> <span class='hs-varid'>integer_id</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span>
<a name="line-23"></a>
<a name="line-24"></a><span class='hs-comment'>-- Special case for integral literals with a large magnitude:</span>
<a name="line-25"></a><span class='hs-comment'>-- They are transformed into an expression involving only smaller</span>
<a name="line-26"></a><span class='hs-comment'>-- integral literals. This improves constant folding.</span>
<a name="line-27"></a>
<a name="line-28"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-comment'>-- Big, so start from a string</span>
<a name="line-29"></a> <span class='hs-varid'>plus_id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lookupId</span> <span class='hs-varid'>plusIntegerName</span>
<a name="line-30"></a> <span class='hs-varid'>times_id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lookupId</span> <span class='hs-varid'>timesIntegerName</span>
<a name="line-31"></a> <span class='hs-varid'>integer_id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lookupId</span> <span class='hs-varid'>smallIntegerName</span>
<a name="line-32"></a> <span class='hs-keyword'>let</span>
<a name="line-33"></a> <span class='hs-varid'>lit</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkSmallIntegerLit</span> <span class='hs-varid'>integer_id</span> <span class='hs-varid'>i</span>
<a name="line-34"></a> <span class='hs-varid'>plus</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>plus_id</span> <span class='hs-varop'>`App`</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`App`</span> <span class='hs-varid'>b</span>
<a name="line-35"></a> <span class='hs-varid'>times</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>times_id</span> <span class='hs-varop'>`App`</span> <span class='hs-varid'>a</span> <span class='hs-varop'>`App`</span> <span class='hs-varid'>b</span>
<a name="line-36"></a>
<a name="line-37"></a> <span class='hs-comment'>-- Transform i into (x1 + (x2 + (x3 + (...) * b) * b) * b) with abs xi <= b</span>
<a name="line-38"></a> <span class='hs-varid'>horner</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-39"></a> <span class='hs-varid'>horner</span> <span class='hs-varid'>b</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>abs</span> <span class='hs-varid'>q</span> <span class='hs-varop'><=</span> <span class='hs-num'>1</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>r</span> <span class='hs-varop'>==</span> <span class='hs-num'>0</span> <span class='hs-varop'>||</span> <span class='hs-varid'>r</span> <span class='hs-varop'>==</span> <span class='hs-varid'>i</span>
<a name="line-40"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>lit</span> <span class='hs-varid'>i</span>
<a name="line-41"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>lit</span> <span class='hs-varid'>r</span> <span class='hs-varop'>`plus`</span> <span class='hs-varid'>lit</span> <span class='hs-layout'>(</span><span class='hs-varid'>i</span><span class='hs-comment'>-</span><span class='hs-varid'>r</span><span class='hs-layout'>)</span>
<a name="line-42"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>r</span> <span class='hs-varop'>==</span> <span class='hs-num'>0</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>horner</span> <span class='hs-varid'>b</span> <span class='hs-varid'>q</span> <span class='hs-varop'>`times`</span> <span class='hs-varid'>lit</span> <span class='hs-varid'>b</span>
<a name="line-43"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lit</span> <span class='hs-varid'>r</span> <span class='hs-varop'>`plus`</span> <span class='hs-layout'>(</span><span class='hs-varid'>horner</span> <span class='hs-varid'>b</span> <span class='hs-varid'>q</span> <span class='hs-varop'>`times`</span> <span class='hs-varid'>lit</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span>
<a name="line-44"></a> <span class='hs-keyword'>where</span>
<a name="line-45"></a> <span class='hs-layout'>(</span><span class='hs-varid'>q</span><span class='hs-layout'>,</span><span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>i</span> <span class='hs-varop'>`quotRem`</span> <span class='hs-varid'>b</span>
<a name="line-46"></a>
<a name="line-47"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>horner</span> <span class='hs-varid'>tARGET_MAX_INT</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span>
<a name="line-48"></a> <span class='hs-keyword'>where</span>
<a name="line-49"></a> <span class='hs-varid'>mkSmallIntegerLit</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-50"></a> <span class='hs-varid'>mkSmallIntegerLit</span> <span class='hs-varid'>small_integer</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkApps</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>small_integer</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mkIntLit</span> <span class='hs-varid'>i</span><span class='hs-keyglyph'>]</span>
<a name="line-51"></a>
<a name="line-52"></a>
<a name="line-53"></a><a name="mkFloatExpr"></a><span class='hs-comment'>-- | Create a 'CoreExpr' which will evaluate to the given @Float@</span>
<a name="line-54"></a><span class='hs-definition'>mkFloatExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Float</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-55"></a><span class='hs-definition'>mkFloatExpr</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkConApp</span> <span class='hs-varid'>floatDataCon</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mkFloatLitFloat</span> <span class='hs-varid'>f</span><span class='hs-keyglyph'>]</span>
<a name="line-56"></a>
<a name="line-57"></a><a name="mkDoubleExpr"></a><span class='hs-comment'>-- | Create a 'CoreExpr' which will evaluate to the given @Double@</span>
<a name="line-58"></a><span class='hs-definition'>mkDoubleExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Double</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-59"></a><span class='hs-definition'>mkDoubleExpr</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkConApp</span> <span class='hs-varid'>doubleDataCon</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mkDoubleLitDouble</span> <span class='hs-varid'>d</span><span class='hs-keyglyph'>]</span>
<a name="line-60"></a>
<a name="line-61"></a>
<a name="line-62"></a><a name="mkCharExpr"></a><span class='hs-comment'>-- | Create a 'CoreExpr' which will evaluate to the given @Char@</span>
<a name="line-63"></a><span class='hs-definition'>mkCharExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Char</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Result = C# c :: Int</span>
<a name="line-64"></a><span class='hs-definition'>mkCharExpr</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkConApp</span> <span class='hs-varid'>charDataCon</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mkCharLit</span> <span class='hs-varid'>c</span><span class='hs-keyglyph'>]</span>
<a name="line-65"></a>
<a name="line-66"></a><a name="mkStringExpr"></a><span class='hs-comment'>-- | Create a 'CoreExpr' which will evaluate to the given @String@</span>
<a name="line-67"></a><span class='hs-definition'>mkStringExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MonadThings</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Result :: String</span>
<a name="line-68"></a><a name="mkStringExprFS"></a><span class='hs-comment'>-- | Create a 'CoreExpr' which will evaluate to a string morally equivalent to the given @FastString@</span>
<a name="line-69"></a><span class='hs-definition'>mkStringExprFS</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MonadThings</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FastString</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Result :: String</span>
<a name="line-70"></a>
<a name="line-71"></a><span class='hs-definition'>mkStringExpr</span> <span class='hs-varid'>str</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkStringExprFS</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkFastString</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span>
<a name="line-72"></a>
<a name="line-73"></a><span class='hs-definition'>mkStringExprFS</span> <span class='hs-varid'>str</span>
<a name="line-74"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>nullFS</span> <span class='hs-varid'>str</span>
<a name="line-75"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkNilExpr</span> <span class='hs-varid'>charTy</span><span class='hs-layout'>)</span>
<a name="line-76"></a>
<a name="line-77"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>lengthFS</span> <span class='hs-varid'>str</span> <span class='hs-varop'>==</span> <span class='hs-num'>1</span>
<a name="line-78"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>the_char</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkCharExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>headFS</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span>
<a name="line-79"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkConsExpr</span> <span class='hs-varid'>charTy</span> <span class='hs-varid'>the_char</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkNilExpr</span> <span class='hs-varid'>charTy</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-80"></a>
<a name="line-81"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>all</span> <span class='hs-varid'>safeChar</span> <span class='hs-varid'>chars</span>
<a name="line-82"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>unpack_id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lookupId</span> <span class='hs-varid'>unpackCStringName</span>
<a name="line-83"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>unpack_id</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lit</span> <span class='hs-layout'>(</span><span class='hs-conid'>MachStr</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-84"></a>
<a name="line-85"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-86"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>unpack_id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lookupId</span> <span class='hs-varid'>unpackCStringUtf8Name</span>
<a name="line-87"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>unpack_id</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lit</span> <span class='hs-layout'>(</span><span class='hs-conid'>MachStr</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-88"></a>
<a name="line-89"></a> <span class='hs-keyword'>where</span>
<a name="line-90"></a> <span class='hs-varid'>chars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unpackFS</span> <span class='hs-varid'>str</span>
<a name="line-91"></a> <span class='hs-varid'>safeChar</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ord</span> <span class='hs-varid'>c</span> <span class='hs-varop'>>=</span> <span class='hs-num'>1</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>ord</span> <span class='hs-varid'>c</span> <span class='hs-varop'><=</span> <span class='hs-num'>0x7F</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Tuple constructors}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a>
<a name="line-2"></a><span class='hs-comment'>-- $big_tuples</span>
<a name="line-3"></a><span class='hs-comment'>-- #big_tuples#</span>
<a name="line-4"></a><span class='hs-comment'>--</span>
<a name="line-5"></a><span class='hs-comment'>-- GHCs built in tuples can only go up to 'mAX_TUPLE_SIZE' in arity, but</span>
<a name="line-6"></a><span class='hs-comment'>-- we might concievably want to build such a massive tuple as part of the</span>
<a name="line-7"></a><span class='hs-comment'>-- output of a desugaring stage (notably that for list comprehensions).</span>
<a name="line-8"></a><span class='hs-comment'>--</span>
<a name="line-9"></a><span class='hs-comment'>-- We call tuples above this size \"big tuples\", and emulate them by</span>
<a name="line-10"></a><span class='hs-comment'>-- creating and pattern matching on >nested< tuples that are expressible</span>
<a name="line-11"></a><span class='hs-comment'>-- by GHC.</span>
<a name="line-12"></a><span class='hs-comment'>--</span>
<a name="line-13"></a><span class='hs-comment'>-- Nesting policy: it's better to have a 2-tuple of 10-tuples (3 objects)</span>
<a name="line-14"></a><span class='hs-comment'>-- than a 10-tuple of 2-tuples (11 objects), so we want the leaves of any</span>
<a name="line-15"></a><span class='hs-comment'>-- construction to be big.</span>
<a name="line-16"></a><span class='hs-comment'>--</span>
<a name="line-17"></a><span class='hs-comment'>-- If you just use the 'mkBigCoreTup', 'mkBigCoreVarTupTy', 'mkTupleSelector'</span>
<a name="line-18"></a><span class='hs-comment'>-- and 'mkTupleCase' functions to do all your work with tuples you should be</span>
<a name="line-19"></a><span class='hs-comment'>-- fine, and not have to worry about the arity limitation at all.</span>
<a name="line-20"></a>
<a name="line-21"></a><a name="mkChunkified"></a><span class='hs-comment'>-- | Lifts a \"small\" constructor into a \"big\" constructor by recursive decompositon</span>
<a name="line-22"></a><span class='hs-definition'>mkChunkified</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- ^ \"Small\" constructor function, of maximum input arity 'mAX_TUPLE_SIZE'</span>
<a name="line-23"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- ^ Possible \"big\" list of things to construct from</span>
<a name="line-24"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-comment'>-- ^ Constructed thing made possible by recursive decomposition</span>
<a name="line-25"></a><span class='hs-definition'>mkChunkified</span> <span class='hs-varid'>small_tuple</span> <span class='hs-keyword'>as</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mk_big_tuple</span> <span class='hs-layout'>(</span><span class='hs-varid'>chunkify</span> <span class='hs-keyword'>as</span><span class='hs-layout'>)</span>
<a name="line-26"></a> <span class='hs-keyword'>where</span>
<a name="line-27"></a> <span class='hs-comment'>-- Each sub-list is short enough to fit in a tuple</span>
<a name="line-28"></a> <span class='hs-varid'>mk_big_tuple</span> <span class='hs-keyglyph'>[</span><span class='hs-keyword'>as</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>small_tuple</span> <span class='hs-keyword'>as</span>
<a name="line-29"></a> <span class='hs-varid'>mk_big_tuple</span> <span class='hs-varid'>as_s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mk_big_tuple</span> <span class='hs-layout'>(</span><span class='hs-varid'>chunkify</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>small_tuple</span> <span class='hs-varid'>as_s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-30"></a>
<a name="line-31"></a><a name="chunkify"></a><span class='hs-definition'>chunkify</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span>
<a name="line-32"></a><span class='hs-comment'>-- ^ Split a list into lists that are small enough to have a corresponding</span>
<a name="line-33"></a><span class='hs-comment'>-- tuple arity. The sub-lists of the result all have length <= 'mAX_TUPLE_SIZE'</span>
<a name="line-34"></a><span class='hs-comment'>-- But there may be more than 'mAX_TUPLE_SIZE' sub-lists</span>
<a name="line-35"></a><span class='hs-definition'>chunkify</span> <span class='hs-varid'>xs</span>
<a name="line-36"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>n_xs</span> <span class='hs-varop'><=</span> <span class='hs-varid'>mAX_TUPLE_SIZE</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>xs</span><span class='hs-keyglyph'>]</span>
<a name="line-37"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>split</span> <span class='hs-varid'>xs</span>
<a name="line-38"></a> <span class='hs-keyword'>where</span>
<a name="line-39"></a> <span class='hs-varid'>n_xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>xs</span>
<a name="line-40"></a> <span class='hs-varid'>split</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-41"></a> <span class='hs-varid'>split</span> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>take</span> <span class='hs-varid'>mAX_TUPLE_SIZE</span> <span class='hs-varid'>xs</span> <span class='hs-conop'>:</span> <span class='hs-varid'>split</span> <span class='hs-layout'>(</span><span class='hs-varid'>drop</span> <span class='hs-varid'>mAX_TUPLE_SIZE</span> <span class='hs-varid'>xs</span><span class='hs-layout'>)</span>
<a name="line-42"></a>
</pre>\end{code}
Creating tuples and their types for Core expressions
@mkBigCoreVarTup@ builds a tuple; the inverse to @mkTupleSelector@.
* If it has only one element, it is the identity function.
* If there are more elements than a big tuple can have, it nests
the tuples.
\begin{code}
<pre><a name="line-1"></a>
<a name="line-2"></a><a name="mkCoreVarTup"></a><span class='hs-comment'>-- | Build a small tuple holding the specified variables</span>
<a name="line-3"></a><span class='hs-definition'>mkCoreVarTup</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-4"></a><span class='hs-definition'>mkCoreVarTup</span> <span class='hs-varid'>ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkCoreTup</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>ids</span><span class='hs-layout'>)</span>
<a name="line-5"></a>
<a name="line-6"></a><a name="mkCoreVarTupTy"></a><span class='hs-comment'>-- | Bulid the type of a small tuple that holds the specified variables</span>
<a name="line-7"></a><span class='hs-definition'>mkCoreVarTupTy</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span>
<a name="line-8"></a><span class='hs-definition'>mkCoreVarTupTy</span> <span class='hs-varid'>ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkCoreTupTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>ids</span><span class='hs-layout'>)</span>
<a name="line-9"></a>
<a name="line-10"></a><a name="mkCoreTup"></a><span class='hs-comment'>-- | Build a small tuple holding the specified expressions</span>
<a name="line-11"></a><span class='hs-definition'>mkCoreTup</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-12"></a><span class='hs-definition'>mkCoreTup</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>unitDataConId</span>
<a name="line-13"></a><span class='hs-definition'>mkCoreTup</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>c</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>c</span>
<a name="line-14"></a><span class='hs-definition'>mkCoreTup</span> <span class='hs-varid'>cs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkConApp</span> <span class='hs-layout'>(</span><span class='hs-varid'>tupleCon</span> <span class='hs-conid'>Boxed</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>cs</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-15"></a> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varop'>.</span> <span class='hs-varid'>exprType</span><span class='hs-layout'>)</span> <span class='hs-varid'>cs</span> <span class='hs-varop'>++</span> <span class='hs-varid'>cs</span><span class='hs-layout'>)</span>
<a name="line-16"></a>
<a name="line-17"></a><a name="mkCoreTupTy"></a><span class='hs-comment'>-- | Build the type of a small tuple that holds the specified type of thing</span>
<a name="line-18"></a><span class='hs-definition'>mkCoreTupTy</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span>
<a name="line-19"></a><span class='hs-definition'>mkCoreTupTy</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ty</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ty</span>
<a name="line-20"></a><span class='hs-definition'>mkCoreTupTy</span> <span class='hs-varid'>tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTupleTy</span> <span class='hs-conid'>Boxed</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>tys</span><span class='hs-layout'>)</span> <span class='hs-varid'>tys</span>
<a name="line-21"></a>
<a name="line-22"></a>
<a name="line-23"></a><a name="mkBigCoreVarTup"></a><span class='hs-comment'>-- | Build a big tuple holding the specified variables</span>
<a name="line-24"></a><span class='hs-definition'>mkBigCoreVarTup</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-25"></a><span class='hs-definition'>mkBigCoreVarTup</span> <span class='hs-varid'>ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBigCoreTup</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>ids</span><span class='hs-layout'>)</span>
<a name="line-26"></a>
<a name="line-27"></a><a name="mkBigCoreVarTupTy"></a><span class='hs-comment'>-- | Build the type of a big tuple that holds the specified variables</span>
<a name="line-28"></a><span class='hs-definition'>mkBigCoreVarTupTy</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span>
<a name="line-29"></a><span class='hs-definition'>mkBigCoreVarTupTy</span> <span class='hs-varid'>ids</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkBigCoreTupTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>ids</span><span class='hs-layout'>)</span>
<a name="line-30"></a>
<a name="line-31"></a><a name="mkBigCoreTup"></a><span class='hs-comment'>-- | Build a big tuple holding the specified expressions</span>
<a name="line-32"></a><span class='hs-definition'>mkBigCoreTup</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-33"></a><span class='hs-definition'>mkBigCoreTup</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkChunkified</span> <span class='hs-varid'>mkCoreTup</span>
<a name="line-34"></a>
<a name="line-35"></a><a name="mkBigCoreTupTy"></a><span class='hs-comment'>-- | Build the type of a big tuple that holds the specified type of thing</span>
<a name="line-36"></a><span class='hs-definition'>mkBigCoreTupTy</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span>
<a name="line-37"></a><span class='hs-definition'>mkBigCoreTupTy</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkChunkified</span> <span class='hs-varid'>mkCoreTupTy</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Tuple destructors}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="mkTupleSelector"></a><span class='hs-comment'>-- | Builds a selector which scrutises the given</span>
<a name="line-2"></a><span class='hs-comment'>-- expression and extracts the one name from the list given.</span>
<a name="line-3"></a><span class='hs-comment'>-- If you want the no-shadowing rule to apply, the caller</span>
<a name="line-4"></a><span class='hs-comment'>-- is responsible for making sure that none of these names</span>
<a name="line-5"></a><span class='hs-comment'>-- are in scope.</span>
<a name="line-6"></a><span class='hs-comment'>--</span>
<a name="line-7"></a><span class='hs-comment'>-- If there is just one 'Id' in the tuple, then the selector is</span>
<a name="line-8"></a><span class='hs-comment'>-- just the identity.</span>
<a name="line-9"></a><span class='hs-comment'>--</span>
<a name="line-10"></a><span class='hs-comment'>-- If necessary, we pattern match on a \"big\" tuple.</span>
<a name="line-11"></a><span class='hs-definition'>mkTupleSelector</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- ^ The 'Id's to pattern match the tuple against</span>
<a name="line-12"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- ^ The 'Id' to select</span>
<a name="line-13"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- ^ A variable of the same type as the scrutinee</span>
<a name="line-14"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- ^ Scrutinee</span>
<a name="line-15"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- ^ Selector expression</span>
<a name="line-16"></a>
<a name="line-17"></a><span class='hs-comment'>-- mkTupleSelector [a,b,c,d] b v e</span>
<a name="line-18"></a><span class='hs-comment'>-- = case e of v { </span>
<a name="line-19"></a><span class='hs-comment'>-- (p,q) -> case p of p {</span>
<a name="line-20"></a><span class='hs-comment'>-- (a,b) -> b }}</span>
<a name="line-21"></a><span class='hs-comment'>-- We use 'tpl' vars for the p,q, since shadowing does not matter.</span>
<a name="line-22"></a><span class='hs-comment'>--</span>
<a name="line-23"></a><span class='hs-comment'>-- In fact, it's more convenient to generate it innermost first, getting</span>
<a name="line-24"></a><span class='hs-comment'>--</span>
<a name="line-25"></a><span class='hs-comment'>-- case (case e of v </span>
<a name="line-26"></a><span class='hs-comment'>-- (p,q) -> p) of p</span>
<a name="line-27"></a><span class='hs-comment'>-- (a,b) -> b</span>
<a name="line-28"></a><span class='hs-definition'>mkTupleSelector</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>the_var</span> <span class='hs-varid'>scrut_var</span> <span class='hs-varid'>scrut</span>
<a name="line-29"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mk_tup_sel</span> <span class='hs-layout'>(</span><span class='hs-varid'>chunkify</span> <span class='hs-varid'>vars</span><span class='hs-layout'>)</span> <span class='hs-varid'>the_var</span>
<a name="line-30"></a> <span class='hs-keyword'>where</span>
<a name="line-31"></a> <span class='hs-varid'>mk_tup_sel</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>vars</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>the_var</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkSmallTupleSelector</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>the_var</span> <span class='hs-varid'>scrut_var</span> <span class='hs-varid'>scrut</span>
<a name="line-32"></a> <span class='hs-varid'>mk_tup_sel</span> <span class='hs-varid'>vars_s</span> <span class='hs-varid'>the_var</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkSmallTupleSelector</span> <span class='hs-varid'>group</span> <span class='hs-varid'>the_var</span> <span class='hs-varid'>tpl_v</span> <span class='hs-varop'>$</span>
<a name="line-33"></a> <span class='hs-varid'>mk_tup_sel</span> <span class='hs-layout'>(</span><span class='hs-varid'>chunkify</span> <span class='hs-varid'>tpl_vs</span><span class='hs-layout'>)</span> <span class='hs-varid'>tpl_v</span>
<a name="line-34"></a> <span class='hs-keyword'>where</span>
<a name="line-35"></a> <span class='hs-varid'>tpl_tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mkCoreTupTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>gp</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>gp</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>vars_s</span><span class='hs-keyglyph'>]</span>
<a name="line-36"></a> <span class='hs-varid'>tpl_vs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTemplateLocals</span> <span class='hs-varid'>tpl_tys</span>
<a name="line-37"></a> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>tpl_v</span><span class='hs-layout'>,</span> <span class='hs-varid'>group</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>tpl</span><span class='hs-layout'>,</span><span class='hs-varid'>gp</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>tpl</span><span class='hs-layout'>,</span><span class='hs-varid'>gp</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zipEqual</span> <span class='hs-str'>"mkTupleSelector"</span> <span class='hs-varid'>tpl_vs</span> <span class='hs-varid'>vars_s</span><span class='hs-layout'>,</span>
<a name="line-38"></a> <span class='hs-varid'>the_var</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>gp</span> <span class='hs-keyglyph'>]</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="mkSmallTupleSelector"></a><span class='hs-comment'>-- | Like 'mkTupleSelector' but for tuples that are guaranteed</span>
<a name="line-2"></a><span class='hs-comment'>-- never to be \"big\".</span>
<a name="line-3"></a><span class='hs-comment'>--</span>
<a name="line-4"></a><span class='hs-comment'>-- > mkSmallTupleSelector [x] x v e = [| e |]</span>
<a name="line-5"></a><span class='hs-comment'>-- > mkSmallTupleSelector [x,y,z] x v e = [| case e of v { (x,y,z) -> x } |]</span>
<a name="line-6"></a><span class='hs-definition'>mkSmallTupleSelector</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- The tuple args</span>
<a name="line-7"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- The selected one</span>
<a name="line-8"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- A variable of the same type as the scrutinee</span>
<a name="line-9"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- Scrutinee</span>
<a name="line-10"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-11"></a><span class='hs-definition'>mkSmallTupleSelector</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>var</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>should_be_the_same_var</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>scrut</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span><span class='hs-varid'>var</span> <span class='hs-varop'>==</span> <span class='hs-varid'>should_be_the_same_var</span><span class='hs-layout'>)</span>
<a name="line-13"></a> <span class='hs-varid'>scrut</span>
<a name="line-14"></a><span class='hs-definition'>mkSmallTupleSelector</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>the_var</span> <span class='hs-varid'>scrut_var</span> <span class='hs-varid'>scrut</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'>notNull</span> <span class='hs-varid'>vars</span> <span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-conid'>Case</span> <span class='hs-varid'>scrut</span> <span class='hs-varid'>scrut_var</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>the_var</span><span class='hs-layout'>)</span>
<a name="line-17"></a> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>DataAlt</span> <span class='hs-layout'>(</span><span class='hs-varid'>tupleCon</span> <span class='hs-conid'>Boxed</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>vars</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>vars</span><span class='hs-layout'>,</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>the_var</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="mkTupleCase"></a><span class='hs-comment'>-- | A generalization of 'mkTupleSelector', allowing the body</span>
<a name="line-2"></a><span class='hs-comment'>-- of the case to be an arbitrary expression.</span>
<a name="line-3"></a><span class='hs-comment'>--</span>
<a name="line-4"></a><span class='hs-comment'>-- To avoid shadowing, we use uniques to invent new variables.</span>
<a name="line-5"></a><span class='hs-comment'>--</span>
<a name="line-6"></a><span class='hs-comment'>-- If necessary we pattern match on a \"big\" tuple.</span>
<a name="line-7"></a><span class='hs-definition'>mkTupleCase</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>UniqSupply</span> <span class='hs-comment'>-- ^ For inventing names of intermediate variables</span>
<a name="line-8"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- ^ The tuple identifiers to pattern match on</span>
<a name="line-9"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- ^ Body of the case</span>
<a name="line-10"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- ^ A variable of the same type as the scrutinee</span>
<a name="line-11"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- ^ Scrutinee</span>
<a name="line-12"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-13"></a><span class='hs-comment'>-- ToDo: eliminate cases where none of the variables are needed.</span>
<a name="line-14"></a><span class='hs-comment'>--</span>
<a name="line-15"></a><span class='hs-comment'>-- mkTupleCase uniqs [a,b,c,d] body v e</span>
<a name="line-16"></a><span class='hs-comment'>-- = case e of v { (p,q) -></span>
<a name="line-17"></a><span class='hs-comment'>-- case p of p { (a,b) -></span>
<a name="line-18"></a><span class='hs-comment'>-- case q of q { (c,d) -></span>
<a name="line-19"></a><span class='hs-comment'>-- body }}}</span>
<a name="line-20"></a><span class='hs-definition'>mkTupleCase</span> <span class='hs-varid'>uniqs</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>body</span> <span class='hs-varid'>scrut_var</span> <span class='hs-varid'>scrut</span>
<a name="line-21"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mk_tuple_case</span> <span class='hs-varid'>uniqs</span> <span class='hs-layout'>(</span><span class='hs-varid'>chunkify</span> <span class='hs-varid'>vars</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span>
<a name="line-22"></a> <span class='hs-keyword'>where</span>
<a name="line-23"></a> <span class='hs-comment'>-- This is the case where don't need any nesting</span>
<a name="line-24"></a> <span class='hs-varid'>mk_tuple_case</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>vars</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>body</span>
<a name="line-25"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkSmallTupleCase</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>body</span> <span class='hs-varid'>scrut_var</span> <span class='hs-varid'>scrut</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-comment'>-- This is the case where we must make nest tuples at least once</span>
<a name="line-28"></a> <span class='hs-varid'>mk_tuple_case</span> <span class='hs-varid'>us</span> <span class='hs-varid'>vars_s</span> <span class='hs-varid'>body</span>
<a name="line-29"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>us'</span><span class='hs-layout'>,</span> <span class='hs-varid'>vars'</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'>foldr</span> <span class='hs-varid'>one_tuple_case</span> <span class='hs-layout'>(</span><span class='hs-varid'>us</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span> <span class='hs-varid'>vars_s</span>
<a name="line-30"></a> <span class='hs-keyword'>in</span> <span class='hs-varid'>mk_tuple_case</span> <span class='hs-varid'>us'</span> <span class='hs-layout'>(</span><span class='hs-varid'>chunkify</span> <span class='hs-varid'>vars'</span><span class='hs-layout'>)</span> <span class='hs-varid'>body'</span>
<a name="line-31"></a>
<a name="line-32"></a> <span class='hs-varid'>one_tuple_case</span> <span class='hs-varid'>chunk_vars</span> <span class='hs-layout'>(</span><span class='hs-varid'>us</span><span class='hs-layout'>,</span> <span class='hs-varid'>vs</span><span class='hs-layout'>,</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span>
<a name="line-33"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>us1</span><span class='hs-layout'>,</span> <span class='hs-varid'>us2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitUniqSupply</span> <span class='hs-varid'>us</span>
<a name="line-34"></a> <span class='hs-varid'>scrut_var</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkSysLocal</span> <span class='hs-layout'>(</span><span class='hs-varid'>fsLit</span> <span class='hs-str'>"ds"</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>uniqFromSupply</span> <span class='hs-varid'>us1</span><span class='hs-layout'>)</span>
<a name="line-35"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mkCoreTupTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>chunk_vars</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-36"></a> <span class='hs-varid'>body'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkSmallTupleCase</span> <span class='hs-varid'>chunk_vars</span> <span class='hs-varid'>body</span> <span class='hs-varid'>scrut_var</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>scrut_var</span><span class='hs-layout'>)</span>
<a name="line-37"></a> <span class='hs-keyword'>in</span> <span class='hs-layout'>(</span><span class='hs-varid'>us2</span><span class='hs-layout'>,</span> <span class='hs-varid'>scrut_var</span><span class='hs-conop'>:</span><span class='hs-varid'>vs</span><span class='hs-layout'>,</span> <span class='hs-varid'>body'</span><span class='hs-layout'>)</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="mkSmallTupleCase"></a><span class='hs-comment'>-- | As 'mkTupleCase', but for a tuple that is small enough to be guaranteed</span>
<a name="line-2"></a><span class='hs-comment'>-- not to need nesting.</span>
<a name="line-3"></a><span class='hs-definition'>mkSmallTupleCase</span>
<a name="line-4"></a> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- ^ The tuple args</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- ^ Body of the case</span>
<a name="line-6"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- ^ A variable of the same type as the scrutinee</span>
<a name="line-7"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- ^ Scrutinee</span>
<a name="line-8"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-9"></a>
<a name="line-10"></a><span class='hs-definition'>mkSmallTupleCase</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>var</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>body</span> <span class='hs-sel'>_scrut_var</span> <span class='hs-varid'>scrut</span>
<a name="line-11"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bindNonRec</span> <span class='hs-varid'>var</span> <span class='hs-varid'>scrut</span> <span class='hs-varid'>body</span>
<a name="line-12"></a><span class='hs-definition'>mkSmallTupleCase</span> <span class='hs-varid'>vars</span> <span class='hs-varid'>body</span> <span class='hs-varid'>scrut_var</span> <span class='hs-varid'>scrut</span>
<a name="line-13"></a><span class='hs-comment'>-- One branch no refinement?</span>
<a name="line-14"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Case</span> <span class='hs-varid'>scrut</span> <span class='hs-varid'>scrut_var</span> <span class='hs-layout'>(</span><span class='hs-varid'>exprType</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>DataAlt</span> <span class='hs-layout'>(</span><span class='hs-varid'>tupleCon</span> <span class='hs-conid'>Boxed</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>vars</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>vars</span><span class='hs-layout'>,</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Common list manipulation expressions}
%* *
%************************************************************************
Call the constructor Ids when building explicit lists, so that they
interact well with rules.
\begin{code}
<pre><a name="line-1"></a><a name="mkNilExpr"></a><span class='hs-comment'>-- | Makes a list @[]@ for lists of the specified type</span>
<a name="line-2"></a><span class='hs-definition'>mkNilExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-3"></a><span class='hs-definition'>mkNilExpr</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkConApp</span> <span class='hs-varid'>nilDataCon</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty</span><span class='hs-keyglyph'>]</span>
<a name="line-4"></a>
<a name="line-5"></a><a name="mkConsExpr"></a><span class='hs-comment'>-- | Makes a list @(:)@ for lists of the specified type</span>
<a name="line-6"></a><span class='hs-definition'>mkConsExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-7"></a><span class='hs-definition'>mkConsExpr</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>hd</span> <span class='hs-varid'>tl</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkConApp</span> <span class='hs-varid'>consDataCon</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>hd</span><span class='hs-layout'>,</span> <span class='hs-varid'>tl</span><span class='hs-keyglyph'>]</span>
<a name="line-8"></a>
<a name="line-9"></a><a name="mkListExpr"></a><span class='hs-comment'>-- | Make a list containing the given expressions, where the list has the given type</span>
<a name="line-10"></a><span class='hs-definition'>mkListExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span>
<a name="line-11"></a><span class='hs-definition'>mkListExpr</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkConsExpr</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkNilExpr</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>xs</span>
<a name="line-12"></a>
<a name="line-13"></a><a name="mkFoldrExpr"></a><span class='hs-comment'>-- | Make a fully applied 'foldr' expression</span>
<a name="line-14"></a><span class='hs-definition'>mkFoldrExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MonadThings</span> <span class='hs-varid'>m</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- ^ Element type of the list</span>
<a name="line-16"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- ^ Fold result type</span>
<a name="line-17"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- ^ "Cons" function expression for the fold</span>
<a name="line-18"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- ^ "Nil" expression for the fold</span>
<a name="line-19"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-comment'>-- ^ List expression being folded acress</span>
<a name="line-20"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-21"></a><span class='hs-definition'>mkFoldrExpr</span> <span class='hs-varid'>elt_ty</span> <span class='hs-varid'>result_ty</span> <span class='hs-varid'>c</span> <span class='hs-varid'>n</span> <span class='hs-varid'>list</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-22"></a> <span class='hs-varid'>foldr_id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lookupId</span> <span class='hs-varid'>foldrName</span>
<a name="line-23"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>foldr_id</span> <span class='hs-varop'>`App`</span> <span class='hs-conid'>Type</span> <span class='hs-varid'>elt_ty</span>
<a name="line-24"></a> <span class='hs-varop'>`App`</span> <span class='hs-conid'>Type</span> <span class='hs-varid'>result_ty</span>
<a name="line-25"></a> <span class='hs-varop'>`App`</span> <span class='hs-varid'>c</span>
<a name="line-26"></a> <span class='hs-varop'>`App`</span> <span class='hs-varid'>n</span>
<a name="line-27"></a> <span class='hs-varop'>`App`</span> <span class='hs-varid'>list</span><span class='hs-layout'>)</span>
<a name="line-28"></a>
<a name="line-29"></a><a name="mkBuildExpr"></a><span class='hs-comment'>-- | Make a 'build' expression applied to a locally-bound worker function</span>
<a name="line-30"></a><span class='hs-definition'>mkBuildExpr</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>MonadThings</span> <span class='hs-varid'>m</span><span class='hs-layout'>,</span> <span class='hs-conid'>MonadUnique</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span>
<a name="line-31"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- ^ Type of list elements to be built</span>
<a name="line-32"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>CoreExpr</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- ^ Function that, given information about the 'Id's</span>
<a name="line-33"></a> <span class='hs-comment'>-- of the binders for the build worker function, returns</span>
<a name="line-34"></a> <span class='hs-comment'>-- the body of that worker</span>
<a name="line-35"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>CoreExpr</span>
<a name="line-36"></a><span class='hs-definition'>mkBuildExpr</span> <span class='hs-varid'>elt_ty</span> <span class='hs-varid'>mk_build_inside</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-37"></a> <span class='hs-keyglyph'>[</span><span class='hs-varid'>n_tyvar</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newTyVars</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>alphaTyVar</span><span class='hs-keyglyph'>]</span>
<a name="line-38"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>n_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTyVarTy</span> <span class='hs-varid'>n_tyvar</span>
<a name="line-39"></a> <span class='hs-varid'>c_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkFunTys</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>elt_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>n_ty</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>n_ty</span>
<a name="line-40"></a> <span class='hs-keyglyph'>[</span><span class='hs-varid'>c</span><span class='hs-layout'>,</span> <span class='hs-varid'>n</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>sequence</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mkSysLocalM</span> <span class='hs-layout'>(</span><span class='hs-varid'>fsLit</span> <span class='hs-str'>"c"</span><span class='hs-layout'>)</span> <span class='hs-varid'>c_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkSysLocalM</span> <span class='hs-layout'>(</span><span class='hs-varid'>fsLit</span> <span class='hs-str'>"n"</span><span class='hs-layout'>)</span> <span class='hs-varid'>n_ty</span><span class='hs-keyglyph'>]</span>
<a name="line-41"></a>
<a name="line-42"></a> <span class='hs-varid'>build_inside</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mk_build_inside</span> <span class='hs-layout'>(</span><span class='hs-varid'>c</span><span class='hs-layout'>,</span> <span class='hs-varid'>c_ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-layout'>,</span> <span class='hs-varid'>n_ty</span><span class='hs-layout'>)</span>
<a name="line-43"></a>
<a name="line-44"></a> <span class='hs-varid'>build_id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lookupId</span> <span class='hs-varid'>buildName</span>
<a name="line-45"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Var</span> <span class='hs-varid'>build_id</span> <span class='hs-varop'>`App`</span> <span class='hs-conid'>Type</span> <span class='hs-varid'>elt_ty</span> <span class='hs-varop'>`App`</span> <span class='hs-varid'>mkLams</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>n_tyvar</span><span class='hs-layout'>,</span> <span class='hs-varid'>c</span><span class='hs-layout'>,</span> <span class='hs-varid'>n</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>build_inside</span>
<a name="line-46"></a> <span class='hs-keyword'>where</span>
<a name="line-47"></a> <span class='hs-varid'>newTyVars</span> <span class='hs-varid'>tyvar_tmpls</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-48"></a> <span class='hs-varid'>uniqs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getUniquesM</span>
<a name="line-49"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>zipWith</span> <span class='hs-varid'>setTyVarUnique</span> <span class='hs-varid'>tyvar_tmpls</span> <span class='hs-varid'>uniqs</span><span class='hs-layout'>)</span>
</pre>\end{code}</body>
</html>
