<?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/TcTyClsDecls.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The University of Glasgow 2006
% (c) The AQUA Project, Glasgow University, 1996-1998
%
TcTyClsDecls: Typecheck type and class declarations
\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>TcTyClsDecls</span> <span class='hs-layout'>(</span>
<a name="line-2"></a> <span class='hs-varid'>tcTyAndClassDecls</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcFamInstDecl</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkAuxBinds</span>
<a name="line-3"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-4"></a>
<a name="line-5"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HsSyn</span>
<a name="line-8"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HscTypes</span>
<a name="line-9"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>BuildTyCl</span>
<a name="line-10"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcUnify</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'>TcEnv</span>
<a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcTyDecls</span>
<a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcClassDcl</span>
<a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcHsType</span>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcMType</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcType</span>
<a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TysWiredIn</span> <span class='hs-layout'>(</span> <span class='hs-varid'>unitTy</span> <span class='hs-layout'>)</span>
<a name="line-19"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Type</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Generics</span>
<a name="line-21"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Class</span>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TyCon</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DataCon</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'>MkId</span> <span class='hs-layout'>(</span> <span class='hs-varid'>rEC_SEL_ERROR_ID</span> <span class='hs-layout'>)</span>
<a name="line-26"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>IdInfo</span>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Var</span>
<a name="line-28"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarSet</span>
<a name="line-29"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span>
<a name="line-30"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-31"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Maybes</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Unify</span>
<a name="line-33"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Util</span>
<a name="line-34"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>SrcLoc</span>
<a name="line-35"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ListSetOps</span>
<a name="line-36"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Digraph</span>
<a name="line-37"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DynFlags</span>
<a name="line-38"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastString</span>
<a name="line-39"></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-40"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>BasicTypes</span>
<a name="line-41"></a>
<a name="line-42"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Bag</span>
<a name="line-43"></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-44"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Type checking for type and class declarations}
%* *
%************************************************************************
Dealing with a group
~~~~~~~~~~~~~~~~~~~~
Consider a mutually-recursive group, binding
a type constructor T and a class C.
Step 1: getInitialKind
Construct a KindEnv by binding T and C to a kind variable
Step 2: kcTyClDecl
In that environment, do a kind check
Step 3: Zonk the kinds
Step 4: buildTyConOrClass
Construct an environment binding T to a TyCon and C to a Class.
a) Their kinds comes from zonking the relevant kind variable
b) Their arity (for synonyms) comes direct from the decl
c) The funcional dependencies come from the decl
d) The rest comes a knot-tied binding of T and C, returned from Step 4
e) The variances of the tycons in the group is calculated from
the knot-tied stuff
Step 5: tcTyClDecl1
In this environment, walk over the decls, constructing the TyCons and Classes.
This uses in a strict way items (a)-(c) above, which is why they must
be constructed in Step 4. Feed the results back to Step 4.
For this step, pass the is-recursive flag as the wimp-out flag
to tcTyClDecl1.
Step 6: Extend environment
We extend the type environment with bindings not only for the TyCons and Classes,
but also for their "implicit Ids" like data constructors and class selectors
Step 7: checkValidTyCl
For a recursive group only, check all the decls again, just
to check all the side conditions on validity. We could not
do this before because we were in a mutually recursive knot.
Identification of recursive TyCons
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The knot-tying parameters: @rec_details_list@ is an alist mapping @Name@s to
@TyThing@s.
Identifying a TyCon as recursive serves two purposes
1. Avoid infinite types. Non-recursive newtypes are treated as
"transparent", like type synonyms, after the type checker. If we did
this for all newtypes, we'd get infinite types. So we figure out for
each newtype whether it is "recursive", and add a coercion if so. In
effect, we are trying to "cut the loops" by identifying a loop-breaker.
2. Avoid infinite unboxing. This is nothing to do with newtypes.
Suppose we have
data T = MkT Int T
f (MkT x t) = f t
Well, this function diverges, but we don't want the strictness analyser
to diverge. But the strictness analyser will diverge because it looks
deeper and deeper into the structure of T. (I believe there are
examples where the function does something sane, and the strictness
analyser still diverges, but I can't see one now.)
Now, concerning (1), the FC2 branch currently adds a coercion for ALL
newtypes. I did this as an experiment, to try to expose cases in which
the coercions got in the way of optimisations. If it turns out that we
can indeed always use a coercion, then we don't risk recursive types,
and don't need to figure out what the loop breakers are.
For newtype *families* though, we will always have a coercion, so they
are always loop breakers! So you can easily adjust the current
algorithm by simply treating all newtype families as loop breakers (and
indeed type families). I think.
\begin{code}
<pre><a name="line-1"></a><a name="tcTyAndClassDecls"></a><span class='hs-definition'>tcTyAndClassDecls</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ModDetails</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LTyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>TcGblEnv</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Input env extended by types and classes </span>
<a name="line-3"></a> <span class='hs-comment'>-- and their implicit Ids,DataCons</span>
<a name="line-4"></a> <span class='hs-conid'>HsValBinds</span> <span class='hs-conid'>Name</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Renamed bindings for record selectors</span>
<a name="line-5"></a><span class='hs-comment'>-- Fails if there are any errors</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-definition'>tcTyAndClassDecls</span> <span class='hs-varid'>boot_details</span> <span class='hs-varid'>allDecls</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>checkNoErrs</span> <span class='hs-varop'>$</span> <span class='hs-comment'>-- The code recovers internally, but if anything gave rise to</span>
<a name="line-9"></a> <span class='hs-comment'>-- an error we'd better stop now, to avoid a cascade</span>
<a name="line-10"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- Omit instances of type families; they are handled together</span>
<a name="line-11"></a> <span class='hs-comment'>-- with the *heads* of class instances</span>
<a name="line-12"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>decls</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>filter</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-varop'>.</span> <span class='hs-varid'>isFamInstDecl</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unLoc</span><span class='hs-layout'>)</span> <span class='hs-varid'>allDecls</span>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-comment'>-- First check for cyclic type synonysm or classes</span>
<a name="line-15"></a> <span class='hs-comment'>-- See notes with checkCycleErrs</span>
<a name="line-16"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkCycleErrs</span> <span class='hs-varid'>decls</span>
<a name="line-17"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>mod</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getModule</span>
<a name="line-18"></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'>"tcTyAndCl"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>mod</span><span class='hs-layout'>)</span>
<a name="line-19"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>syn_tycons</span><span class='hs-layout'>,</span> <span class='hs-varid'>alg_tyclss</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>fixM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-keyglyph'>~</span><span class='hs-layout'>(</span><span class='hs-sel'>_rec_syn_tycons</span><span class='hs-layout'>,</span> <span class='hs-varid'>rec_alg_tyclss</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-20"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- Seperate ordinary synonyms from all other type and</span>
<a name="line-21"></a> <span class='hs-comment'>-- class declarations and add all associated type</span>
<a name="line-22"></a> <span class='hs-comment'>-- declarations from type classes. The latter is</span>
<a name="line-23"></a> <span class='hs-comment'>-- required so that the temporary environment for the</span>
<a name="line-24"></a> <span class='hs-comment'>-- knot includes all associated family declarations.</span>
<a name="line-25"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>syn_decls</span><span class='hs-layout'>,</span> <span class='hs-varid'>alg_decls</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>partition</span> <span class='hs-layout'>(</span><span class='hs-varid'>isSynDecl</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unLoc</span><span class='hs-layout'>)</span>
<a name="line-26"></a> <span class='hs-varid'>decls</span>
<a name="line-27"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>alg_at_decls</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>concatMap</span> <span class='hs-varid'>addATs</span> <span class='hs-varid'>alg_decls</span>
<a name="line-28"></a> <span class='hs-layout'>}</span>
<a name="line-29"></a> <span class='hs-comment'>-- Extend the global env with the knot-tied results</span>
<a name="line-30"></a> <span class='hs-comment'>-- for data types and classes</span>
<a name="line-31"></a> <span class='hs-comment'>-- </span>
<a name="line-32"></a> <span class='hs-comment'>-- We must populate the environment with the loop-tied</span>
<a name="line-33"></a> <span class='hs-comment'>-- T's right away, because the kind checker may "fault</span>
<a name="line-34"></a> <span class='hs-comment'>-- in" some type constructors that recursively</span>
<a name="line-35"></a> <span class='hs-comment'>-- mention T</span>
<a name="line-36"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>gbl_things</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkGlobalThings</span> <span class='hs-varid'>alg_at_decls</span> <span class='hs-varid'>rec_alg_tyclss</span>
<a name="line-37"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tcExtendRecEnv</span> <span class='hs-varid'>gbl_things</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-38"></a>
<a name="line-39"></a> <span class='hs-comment'>-- Kind-check the declarations</span>
<a name="line-40"></a> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>kc_syn_decls</span><span class='hs-layout'>,</span> <span class='hs-varid'>kc_alg_decls</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kcTyClDecls</span> <span class='hs-varid'>syn_decls</span> <span class='hs-varid'>alg_decls</span>
<a name="line-41"></a>
<a name="line-42"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- Calculate rec-flag</span>
<a name="line-43"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>calc_rec</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>calcRecFlags</span> <span class='hs-varid'>boot_details</span> <span class='hs-varid'>rec_alg_tyclss</span>
<a name="line-44"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tc_decl</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addLocM</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcTyClDecl</span> <span class='hs-varid'>calc_rec</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-45"></a>
<a name="line-46"></a> <span class='hs-comment'>-- Type-check the type synonyms, and extend the envt</span>
<a name="line-47"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>syn_tycons</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcSynDecls</span> <span class='hs-varid'>kc_syn_decls</span>
<a name="line-48"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tcExtendGlobalEnv</span> <span class='hs-varid'>syn_tycons</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-49"></a>
<a name="line-50"></a> <span class='hs-comment'>-- Type-check the data types and classes</span>
<a name="line-51"></a> <span class='hs-layout'>{</span> <span class='hs-varid'>alg_tyclss</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>tc_decl</span> <span class='hs-varid'>kc_alg_decls</span>
<a name="line-52"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>syn_tycons</span><span class='hs-layout'>,</span> <span class='hs-varid'>concat</span> <span class='hs-varid'>alg_tyclss</span><span class='hs-layout'>)</span>
<a name="line-53"></a> <span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-54"></a> <span class='hs-comment'>-- Finished with knot-tying now</span>
<a name="line-55"></a> <span class='hs-comment'>-- Extend the environment with the finished things</span>
<a name="line-56"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tcExtendGlobalEnv</span> <span class='hs-layout'>(</span><span class='hs-varid'>syn_tycons</span> <span class='hs-varop'>++</span> <span class='hs-varid'>alg_tyclss</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-57"></a>
<a name="line-58"></a> <span class='hs-comment'>-- Perform the validity check</span>
<a name="line-59"></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'>"ready for validity check"</span><span class='hs-layout'>)</span>
<a name="line-60"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>mapM_</span> <span class='hs-layout'>(</span><span class='hs-varid'>addLocM</span> <span class='hs-varid'>checkValidTyCl</span><span class='hs-layout'>)</span> <span class='hs-varid'>decls</span>
<a name="line-61"></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'>"done"</span><span class='hs-layout'>)</span>
<a name="line-62"></a>
<a name="line-63"></a> <span class='hs-comment'>-- Add the implicit things;</span>
<a name="line-64"></a> <span class='hs-comment'>-- we want them in the environment because </span>
<a name="line-65"></a> <span class='hs-comment'>-- they may be mentioned in interface files</span>
<a name="line-66"></a> <span class='hs-comment'>-- NB: All associated types and their implicit things will be added a</span>
<a name="line-67"></a> <span class='hs-comment'>-- second time here. This doesn't matter as the definitions are</span>
<a name="line-68"></a> <span class='hs-comment'>-- the same.</span>
<a name="line-69"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>{</span> <span class='hs-varid'>implicit_things</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>concatMap</span> <span class='hs-varid'>implicitTyThings</span> <span class='hs-varid'>alg_tyclss</span>
<a name="line-70"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>aux_binds</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkAuxBinds</span> <span class='hs-varid'>alg_tyclss</span> <span class='hs-layout'>}</span>
<a name="line-71"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>traceTc</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"Adding"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>alg_tyclss</span><span class='hs-layout'>)</span>
<a name="line-72"></a> <span class='hs-varop'>$$</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"and"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>implicit_things</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-73"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcExtendGlobalEnv</span> <span class='hs-varid'>implicit_things</span> <span class='hs-varid'>getGblEnv</span>
<a name="line-74"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>env</span><span class='hs-layout'>,</span> <span class='hs-varid'>aux_binds</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-75"></a> <span class='hs-layout'>}</span>
<a name="line-76"></a> <span class='hs-keyword'>where</span>
<a name="line-77"></a> <span class='hs-comment'>-- Pull associated types out of class declarations, to tie them into the</span>
<a name="line-78"></a> <span class='hs-comment'>-- knot above. </span>
<a name="line-79"></a> <span class='hs-comment'>-- NB: We put them in the same place in the list as `tcTyClDecl' will</span>
<a name="line-80"></a> <span class='hs-comment'>-- eventually put the matching `TyThing's. That's crucial; otherwise,</span>
<a name="line-81"></a> <span class='hs-comment'>-- the two argument lists of `mkGlobalThings' don't match up.</span>
<a name="line-82"></a> <span class='hs-varid'>addATs</span> <span class='hs-varid'>decl</span><span class='hs-keyglyph'>@</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'>ClassDecl</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdATs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ats</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>decl</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ats</span>
<a name="line-83"></a> <span class='hs-varid'>addATs</span> <span class='hs-varid'>decl</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>decl</span><span class='hs-keyglyph'>]</span>
<a name="line-84"></a>
<a name="line-85"></a><a name="mkGlobalThings"></a><span class='hs-definition'>mkGlobalThings</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LTyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- The decls</span>
<a name="line-86"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyThing</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Knot-tied, in 1-1 correspondence with the decls</span>
<a name="line-87"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Name</span><span class='hs-layout'>,</span><span class='hs-conid'>TyThing</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-88"></a><span class='hs-comment'>-- Driven by the Decls, and treating the TyThings lazily</span>
<a name="line-89"></a><span class='hs-comment'>-- make a TypeEnv for the new things</span>
<a name="line-90"></a><span class='hs-definition'>mkGlobalThings</span> <span class='hs-varid'>decls</span> <span class='hs-varid'>things</span>
<a name="line-91"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>mk_thing</span> <span class='hs-layout'>(</span><span class='hs-varid'>decls</span> <span class='hs-varop'>`zipLazy`</span> <span class='hs-varid'>things</span><span class='hs-layout'>)</span>
<a name="line-92"></a> <span class='hs-keyword'>where</span>
<a name="line-93"></a> <span class='hs-varid'>mk_thing</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'>ClassDecl</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdLName</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>name</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><span class='hs-conid'>AClass</span> <span class='hs-varid'>cl</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-94"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>name</span><span class='hs-layout'>,</span> <span class='hs-conid'>AClass</span> <span class='hs-varid'>cl</span><span class='hs-layout'>)</span>
<a name="line-95"></a> <span class='hs-varid'>mk_thing</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>decl</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>~</span><span class='hs-layout'>(</span><span class='hs-conid'>ATyCon</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-96"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdName</span> <span class='hs-varid'>decl</span><span class='hs-layout'>,</span> <span class='hs-conid'>ATyCon</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
Type checking family instances
%* *
%************************************************************************
Family instances are somewhat of a hybrid. They are processed together with
class instance heads, but can contain data constructors and hence they share a
lot of kinding and type checking code with ordinary algebraic data types (and
GADTs).
\begin{code}
<pre><a name="line-1"></a><a name="tcFamInstDecl"></a><span class='hs-definition'>tcFamInstDecl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LTyClDecl</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TyThing</span>
<a name="line-2"></a><span class='hs-definition'>tcFamInstDecl</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>-- Prime error recovery, set source location</span>
<a name="line-4"></a> <span class='hs-varid'>setSrcSpan</span> <span class='hs-varid'>loc</span> <span class='hs-varop'>$</span>
<a name="line-5"></a> <span class='hs-varid'>tcAddDeclCtxt</span> <span class='hs-varid'>decl</span> <span class='hs-varop'>$</span>
<a name="line-6"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- type family instances require -XTypeFamilies</span>
<a name="line-7"></a> <span class='hs-comment'>-- and can't (currently) be in an hs-boot file</span>
<a name="line-8"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>type_families</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_TypeFamilies</span>
<a name="line-9"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>is_boot</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcIsHsBoot</span> <span class='hs-comment'>-- Are we compiling an hs-boot file?</span>
<a name="line-10"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-varid'>type_families</span> <span class='hs-varop'>$</span> <span class='hs-varid'>badFamInstDecl</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdLName</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span>
<a name="line-11"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-varid'>is_boot</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>badBootFamInstDeclErr</span>
<a name="line-12"></a>
<a name="line-13"></a> <span class='hs-comment'>-- Perform kind and type checking</span>
<a name="line-14"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tc</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcFamInstDecl1</span> <span class='hs-varid'>decl</span>
<a name="line-15"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkValidTyCon</span> <span class='hs-varid'>tc</span> <span class='hs-comment'>-- Remember to check validity;</span>
<a name="line-16"></a> <span class='hs-comment'>-- no recursion to worry about here</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'>ATyCon</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-18"></a>
<a name="line-19"></a><a name="tcFamInstDecl1"></a><span class='hs-definition'>tcFamInstDecl1</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyClDecl</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TyCon</span>
<a name="line-20"></a>
<a name="line-21"></a> <span class='hs-comment'>-- "type instance"</span>
<a name="line-22"></a><span class='hs-definition'>tcFamInstDecl1</span> <span class='hs-layout'>(</span><span class='hs-varid'>decl</span><span class='hs-keyglyph'>@</span><span class='hs-conid'>TySynonym</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdLName</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-23"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>kcIdxTyPats</span> <span class='hs-varid'>decl</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>k_tvs</span> <span class='hs-varid'>k_typats</span> <span class='hs-varid'>resKind</span> <span class='hs-varid'>family</span> <span class='hs-keyglyph'>-></span>
<a name="line-24"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- check that the family declaration is for a synonym</span>
<a name="line-25"></a> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>isOpenTyCon</span> <span class='hs-varid'>family</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>notFamily</span> <span class='hs-varid'>family</span><span class='hs-layout'>)</span>
<a name="line-26"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>isSynTyCon</span> <span class='hs-varid'>family</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>wrongKindOfFamily</span> <span class='hs-varid'>family</span><span class='hs-layout'>)</span>
<a name="line-27"></a>
<a name="line-28"></a> <span class='hs-layout'>;</span> <span class='hs-comment'>-- (1) kind check the right-hand side of the type equation</span>
<a name="line-29"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>k_rhs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kcCheckLHsType</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdSynRhs</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>EK</span> <span class='hs-varid'>resKind</span> <span class='hs-conid'>EkUnk</span><span class='hs-layout'>)</span>
<a name="line-30"></a> <span class='hs-comment'>-- ToDo: the ExpKind could be better</span>
<a name="line-31"></a>
<a name="line-32"></a> <span class='hs-comment'>-- we need the exact same number of type parameters as the family</span>
<a name="line-33"></a> <span class='hs-comment'>-- declaration </span>
<a name="line-34"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>famArity</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tyConArity</span> <span class='hs-varid'>family</span>
<a name="line-35"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>k_typats</span> <span class='hs-varop'>==</span> <span class='hs-varid'>famArity</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-36"></a> <span class='hs-varid'>wrongNumberOfParmsErr</span> <span class='hs-varid'>famArity</span>
<a name="line-37"></a>
<a name="line-38"></a> <span class='hs-comment'>-- (2) type check type equation</span>
<a name="line-39"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tcTyVarBndrs</span> <span class='hs-varid'>k_tvs</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>t_tvs</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- turn kinded into proper tyvars</span>
<a name="line-40"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>t_typats</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>tcHsKindedType</span> <span class='hs-varid'>k_typats</span>
<a name="line-41"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>t_rhs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcHsKindedType</span> <span class='hs-varid'>k_rhs</span>
<a name="line-42"></a>
<a name="line-43"></a> <span class='hs-comment'>-- (3) check the well-formedness of the instance</span>
<a name="line-44"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkValidTypeInst</span> <span class='hs-varid'>t_typats</span> <span class='hs-varid'>t_rhs</span>
<a name="line-45"></a>
<a name="line-46"></a> <span class='hs-comment'>-- (4) construct representation tycon</span>
<a name="line-47"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>rep_tc_name</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newFamInstTyConName</span> <span class='hs-varid'>tc_name</span> <span class='hs-varid'>t_typats</span> <span class='hs-varid'>loc</span>
<a name="line-48"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>buildSynTyCon</span> <span class='hs-varid'>rep_tc_name</span> <span class='hs-varid'>t_tvs</span> <span class='hs-layout'>(</span><span class='hs-conid'>SynonymTyCon</span> <span class='hs-varid'>t_rhs</span><span class='hs-layout'>)</span>
<a name="line-49"></a> <span class='hs-layout'>(</span><span class='hs-varid'>typeKind</span> <span class='hs-varid'>t_rhs</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>family</span><span class='hs-layout'>,</span> <span class='hs-varid'>t_typats</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-50"></a> <span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-51"></a>
<a name="line-52"></a> <span class='hs-comment'>-- "newtype instance" and "data instance"</span>
<a name="line-53"></a><span class='hs-definition'>tcFamInstDecl1</span> <span class='hs-layout'>(</span><span class='hs-varid'>decl</span><span class='hs-keyglyph'>@</span><span class='hs-conid'>TyData</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdND</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>new_or_data</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdLName</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>,</span>
<a name="line-54"></a> <span class='hs-varid'>tcdCons</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cons</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-55"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>kcIdxTyPats</span> <span class='hs-varid'>decl</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>k_tvs</span> <span class='hs-varid'>k_typats</span> <span class='hs-varid'>resKind</span> <span class='hs-varid'>fam_tycon</span> <span class='hs-keyglyph'>-></span>
<a name="line-56"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- check that the family declaration is for the right kind</span>
<a name="line-57"></a> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>isOpenTyCon</span> <span class='hs-varid'>fam_tycon</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>notFamily</span> <span class='hs-varid'>fam_tycon</span><span class='hs-layout'>)</span>
<a name="line-58"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>isAlgTyCon</span> <span class='hs-varid'>fam_tycon</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>wrongKindOfFamily</span> <span class='hs-varid'>fam_tycon</span><span class='hs-layout'>)</span>
<a name="line-59"></a>
<a name="line-60"></a> <span class='hs-layout'>;</span> <span class='hs-comment'>-- (1) kind check the data declaration as usual</span>
<a name="line-61"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>k_decl</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kcDataDecl</span> <span class='hs-varid'>decl</span> <span class='hs-varid'>k_tvs</span>
<a name="line-62"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>k_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcdCtxt</span> <span class='hs-varid'>k_decl</span>
<a name="line-63"></a> <span class='hs-varid'>k_cons</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcdCons</span> <span class='hs-varid'>k_decl</span>
<a name="line-64"></a>
<a name="line-65"></a> <span class='hs-comment'>-- result kind must be '*' (otherwise, we have too few patterns)</span>
<a name="line-66"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>isLiftedTypeKind</span> <span class='hs-varid'>resKind</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>tooFewParmsErr</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConArity</span> <span class='hs-varid'>fam_tycon</span><span class='hs-layout'>)</span>
<a name="line-67"></a>
<a name="line-68"></a> <span class='hs-comment'>-- (2) type check indexed data type declaration</span>
<a name="line-69"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tcTyVarBndrs</span> <span class='hs-varid'>k_tvs</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>t_tvs</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- turn kinded into proper tyvars</span>
<a name="line-70"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>unbox_strict</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_UnboxStrictFields</span>
<a name="line-71"></a>
<a name="line-72"></a> <span class='hs-comment'>-- kind check the type indexes and the context</span>
<a name="line-73"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>t_typats</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>tcHsKindedType</span> <span class='hs-varid'>k_typats</span>
<a name="line-74"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>stupid_theta</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcHsKindedContext</span> <span class='hs-varid'>k_ctxt</span>
<a name="line-75"></a>
<a name="line-76"></a> <span class='hs-comment'>-- (3) Check that</span>
<a name="line-77"></a> <span class='hs-comment'>-- (a) left-hand side contains no type family applications</span>
<a name="line-78"></a> <span class='hs-comment'>-- (vanilla synonyms are fine, though, and we checked for</span>
<a name="line-79"></a> <span class='hs-comment'>-- foralls earlier)</span>
<a name="line-80"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>mapM_</span> <span class='hs-varid'>checkTyFamFreeness</span> <span class='hs-varid'>t_typats</span>
<a name="line-81"></a>
<a name="line-82"></a> <span class='hs-comment'>-- Check that we don't use GADT syntax in H98 world</span>
<a name="line-83"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>gadt_ok</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_GADTs</span>
<a name="line-84"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>gadt_ok</span> <span class='hs-varop'>||</span> <span class='hs-varid'>consUseH98Syntax</span> <span class='hs-varid'>cons</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>badGadtDecl</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-85"></a>
<a name="line-86"></a> <span class='hs-comment'>-- (b) a newtype has exactly one constructor</span>
<a name="line-87"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>new_or_data</span> <span class='hs-varop'>==</span> <span class='hs-conid'>DataType</span> <span class='hs-varop'>||</span> <span class='hs-varid'>isSingleton</span> <span class='hs-varid'>k_cons</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-88"></a> <span class='hs-varid'>newtypeConError</span> <span class='hs-varid'>tc_name</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>k_cons</span><span class='hs-layout'>)</span>
<a name="line-89"></a>
<a name="line-90"></a> <span class='hs-comment'>-- (4) construct representation tycon</span>
<a name="line-91"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>rep_tc_name</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newFamInstTyConName</span> <span class='hs-varid'>tc_name</span> <span class='hs-varid'>t_typats</span> <span class='hs-varid'>loc</span>
<a name="line-92"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>ex_ok</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span> <span class='hs-comment'>-- Existentials ok for type families!</span>
<a name="line-93"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>fixM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>rep_tycon</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-94"></a> <span class='hs-layout'>{</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>orig_res_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTyConApp</span> <span class='hs-varid'>fam_tycon</span> <span class='hs-varid'>t_typats</span>
<a name="line-95"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>data_cons</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcConDecls</span> <span class='hs-varid'>unbox_strict</span> <span class='hs-varid'>ex_ok</span> <span class='hs-varid'>rep_tycon</span>
<a name="line-96"></a> <span class='hs-layout'>(</span><span class='hs-varid'>t_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>orig_res_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>k_cons</span>
<a name="line-97"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tc_rhs</span> <span class='hs-keyglyph'><-</span>
<a name="line-98"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>new_or_data</span> <span class='hs-keyword'>of</span>
<a name="line-99"></a> <span class='hs-conid'>DataType</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkDataTyConRhs</span> <span class='hs-varid'>data_cons</span><span class='hs-layout'>)</span>
<a name="line-100"></a> <span class='hs-conid'>NewType</span> <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'>data_cons</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-101"></a> <span class='hs-varid'>mkNewTyConRhs</span> <span class='hs-varid'>rep_tc_name</span> <span class='hs-varid'>rep_tycon</span> <span class='hs-layout'>(</span><span class='hs-varid'>head</span> <span class='hs-varid'>data_cons</span><span class='hs-layout'>)</span>
<a name="line-102"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>buildAlgTyCon</span> <span class='hs-varid'>rep_tc_name</span> <span class='hs-varid'>t_tvs</span> <span class='hs-varid'>stupid_theta</span> <span class='hs-varid'>tc_rhs</span> <span class='hs-conid'>Recursive</span>
<a name="line-103"></a> <span class='hs-conid'>False</span> <span class='hs-varid'>h98_syntax</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>fam_tycon</span><span class='hs-layout'>,</span> <span class='hs-varid'>t_typats</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-104"></a> <span class='hs-comment'>-- We always assume that indexed types are recursive. Why?</span>
<a name="line-105"></a> <span class='hs-comment'>-- (1) Due to their open nature, we can never be sure that a</span>
<a name="line-106"></a> <span class='hs-comment'>-- further instance might not introduce a new recursive</span>
<a name="line-107"></a> <span class='hs-comment'>-- dependency. (2) They are always valid loop breakers as</span>
<a name="line-108"></a> <span class='hs-comment'>-- they involve a coercion.</span>
<a name="line-109"></a> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-110"></a> <span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-111"></a> <span class='hs-keyword'>where</span>
<a name="line-112"></a> <span class='hs-varid'>h98_syntax</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>cons</span> <span class='hs-keyword'>of</span> <span class='hs-comment'>-- All constructors have same shape</span>
<a name="line-113"></a> <span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>ConDecl</span> <span class='hs-layout'>{</span> <span class='hs-varid'>con_res</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ResTyGADT</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>False</span>
<a name="line-114"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>True</span>
<a name="line-115"></a>
<a name="line-116"></a><span class='hs-definition'>tcFamInstDecl1</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcFamInstDecl1"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>
<a name="line-117"></a>
<a name="line-118"></a><span class='hs-comment'>-- Kind checking of indexed types</span>
<a name="line-119"></a><span class='hs-comment'>-- -</span>
<a name="line-120"></a>
<a name="line-121"></a><span class='hs-comment'>-- Kind check type patterns and kind annotate the embedded type variables.</span>
<a name="line-122"></a><span class='hs-comment'>--</span>
<a name="line-123"></a><span class='hs-comment'>-- * Here we check that a type instance matches its kind signature, but we do</span>
<a name="line-124"></a><span class='hs-comment'>-- not check whether there is a pattern for each type index; the latter</span>
<a name="line-125"></a><span class='hs-comment'>-- check is only required for type synonym instances.</span>
<a name="line-126"></a>
<a name="line-127"></a><a name="kcIdxTyPats"></a><span class='hs-definition'>kcIdxTyPats</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyClDecl</span> <span class='hs-conid'>Name</span>
<a name="line-128"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>LHsTyVarBndr</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LHsType</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Kind</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TyCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-129"></a> <span class='hs-comment'>-- ^^kinded tvs ^^kinded ty pats ^^res kind</span>
<a name="line-130"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span>
<a name="line-131"></a><span class='hs-definition'>kcIdxTyPats</span> <span class='hs-varid'>decl</span> <span class='hs-varid'>thing_inside</span>
<a name="line-132"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>kcHsTyVars</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdTyVars</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>tvs</span> <span class='hs-keyglyph'>-></span>
<a name="line-133"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>tc_name</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcdLName</span> <span class='hs-varid'>decl</span>
<a name="line-134"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>fam_tycon</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupLocatedTyCon</span> <span class='hs-varid'>tc_name</span>
<a name="line-135"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>kinds</span><span class='hs-layout'>,</span> <span class='hs-varid'>resKind</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitKindFunTys</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConKind</span> <span class='hs-varid'>fam_tycon</span><span class='hs-layout'>)</span>
<a name="line-136"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>hs_typats</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fromJust</span> <span class='hs-varop'>$</span> <span class='hs-varid'>tcdTyPats</span> <span class='hs-varid'>decl</span> <span class='hs-layout'>}</span>
<a name="line-137"></a>
<a name="line-138"></a> <span class='hs-comment'>-- we may not have more parameters than the kind indicates</span>
<a name="line-139"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>kinds</span> <span class='hs-varop'>>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>hs_typats</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-140"></a> <span class='hs-varid'>tooManyParmsErr</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdLName</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span>
<a name="line-141"></a>
<a name="line-142"></a> <span class='hs-comment'>-- type functions can have a higher-kinded result</span>
<a name="line-143"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>resultKind</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkArrowKinds</span> <span class='hs-layout'>(</span><span class='hs-varid'>drop</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>hs_typats</span><span class='hs-layout'>)</span> <span class='hs-varid'>kinds</span><span class='hs-layout'>)</span> <span class='hs-varid'>resKind</span>
<a name="line-144"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>typats</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zipWithM</span> <span class='hs-varid'>kcCheckLHsType</span> <span class='hs-varid'>hs_typats</span>
<a name="line-145"></a> <span class='hs-keyglyph'>[</span> <span class='hs-conid'>EK</span> <span class='hs-varid'>kind</span> <span class='hs-layout'>(</span><span class='hs-conid'>EkArg</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span> <span class='hs-varid'>n</span><span class='hs-layout'>)</span>
<a name="line-146"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>kind</span><span class='hs-layout'>,</span><span class='hs-varid'>n</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kinds</span> <span class='hs-varop'>`zip`</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>1</span><span class='hs-keyglyph'>..</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span>
<a name="line-147"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>thing_inside</span> <span class='hs-varid'>tvs</span> <span class='hs-varid'>typats</span> <span class='hs-varid'>resultKind</span> <span class='hs-varid'>fam_tycon</span>
<a name="line-148"></a> <span class='hs-layout'>}</span>
</pre>\end{code}
%************************************************************************
%* *
Kind checking
%* *
%************************************************************************
We need to kind check all types in the mutually recursive group
before we know the kind of the type variables. For example:
class C a where
op :: D b => a -> b -> b
class D c where
bop :: (Monad c) => ...
Here, the kind of the locally-polymorphic type variable "b"
depends on *all the uses of class D*. For example, the use of
Monad c in bop's type signature means that D must have kind Type->Type.
However type synonyms work differently. They can have kinds which don't
just involve (->) and *:
type R = Int# -- Kind #
type S a = Array# a -- Kind * -> #
type T a b = (# a,b #) -- Kind * -> * -> (# a,b #)
So we must infer their kinds from their right-hand sides *first* and then
use them, whereas for the mutually recursive data types D we bring into
scope kind bindings D -> k, where k is a kind variable, and do inference.
Type families
~~~~~~~~~~~~~
This treatment of type synonyms only applies to Haskell 98-style synonyms.
General type functions can be recursive, and hence, appear in `alg_decls'.
The kind of a type family is solely determinded by its kind signature;
hence, only kind signatures participate in the construction of the initial
kind environment (as constructed by `getInitialKind'). In fact, we ignore
instances of families altogether in the following. However, we need to
include the kinds of associated families into the construction of the
initial kind environment. (This is handled by `allDecls').
\begin{code}
<pre><a name="line-1"></a><a name="kcTyClDecls"></a><span class='hs-definition'>kcTyClDecls</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LTyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Located</span> <span class='hs-layout'>(</span><span class='hs-conid'>TyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-2"></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'>LTyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Located</span> <span class='hs-layout'>(</span><span class='hs-conid'>TyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-3"></a><span class='hs-definition'>kcTyClDecls</span> <span class='hs-varid'>syn_decls</span> <span class='hs-varid'>alg_decls</span>
<a name="line-4"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- First extend the kind env with each data type, class, and</span>
<a name="line-5"></a> <span class='hs-comment'>-- indexed type, mapping them to a type variable</span>
<a name="line-6"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>initialKindDecls</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>concat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>allDecls</span> <span class='hs-varid'>decl</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>decl</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>alg_decls</span><span class='hs-keyglyph'>]</span>
<a name="line-7"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>alg_kinds</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>getInitialKind</span> <span class='hs-varid'>initialKindDecls</span>
<a name="line-8"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tcExtendKindEnv</span> <span class='hs-varid'>alg_kinds</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-9"></a>
<a name="line-10"></a> <span class='hs-comment'>-- Now kind-check the type synonyms, in dependency order</span>
<a name="line-11"></a> <span class='hs-comment'>-- We do these differently to data type and classes,</span>
<a name="line-12"></a> <span class='hs-comment'>-- because a type synonym can be an unboxed type</span>
<a name="line-13"></a> <span class='hs-comment'>-- type Foo = Int#</span>
<a name="line-14"></a> <span class='hs-comment'>-- and a kind variable can't unify with UnboxedTypeKind</span>
<a name="line-15"></a> <span class='hs-comment'>-- So we infer their kinds in dependency order</span>
<a name="line-16"></a> <span class='hs-layout'>{</span> <span class='hs-layout'>(</span><span class='hs-varid'>kc_syn_decls</span><span class='hs-layout'>,</span> <span class='hs-varid'>syn_kinds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kcSynDecls</span> <span class='hs-layout'>(</span><span class='hs-varid'>calcSynCycles</span> <span class='hs-varid'>syn_decls</span><span class='hs-layout'>)</span>
<a name="line-17"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tcExtendKindEnv</span> <span class='hs-varid'>syn_kinds</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-18"></a>
<a name="line-19"></a> <span class='hs-comment'>-- Now kind-check the data type, class, and kind signatures,</span>
<a name="line-20"></a> <span class='hs-comment'>-- returning kind-annotated decls; we don't kind-check</span>
<a name="line-21"></a> <span class='hs-comment'>-- instances of indexed types yet, but leave this to</span>
<a name="line-22"></a> <span class='hs-comment'>-- `tcInstDecls1'</span>
<a name="line-23"></a> <span class='hs-layout'>{</span> <span class='hs-varid'>kc_alg_decls</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>wrapLocM</span> <span class='hs-varid'>kcTyClDecl</span><span class='hs-layout'>)</span>
<a name="line-24"></a> <span class='hs-layout'>(</span><span class='hs-varid'>filter</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-varop'>.</span> <span class='hs-varid'>isFamInstDecl</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unLoc</span><span class='hs-layout'>)</span> <span class='hs-varid'>alg_decls</span><span class='hs-layout'>)</span>
<a name="line-25"></a>
<a name="line-26"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>kc_syn_decls</span><span class='hs-layout'>,</span> <span class='hs-varid'>kc_alg_decls</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-27"></a> <span class='hs-keyword'>where</span>
<a name="line-28"></a> <span class='hs-comment'>-- get all declarations relevant for determining the initial kind</span>
<a name="line-29"></a> <span class='hs-comment'>-- environment</span>
<a name="line-30"></a> <span class='hs-varid'>allDecls</span> <span class='hs-layout'>(</span><span class='hs-varid'>decl</span><span class='hs-keyglyph'>@</span><span class='hs-conid'>ClassDecl</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdATs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ats</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>decl</span> <span class='hs-conop'>:</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>at</span>
<a name="line-31"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>at</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ats</span>
<a name="line-32"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>isFamilyDecl</span> <span class='hs-varid'>at</span><span class='hs-keyglyph'>]</span>
<a name="line-33"></a> <span class='hs-varid'>allDecls</span> <span class='hs-varid'>decl</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isFamInstDecl</span> <span class='hs-varid'>decl</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-34"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>decl</span><span class='hs-keyglyph'>]</span>
<a name="line-35"></a>
<a name="line-36"></a><a name="getInitialKind"></a><span class='hs-comment'>------------------------------------------------------------------------</span>
<a name="line-37"></a><span class='hs-definition'>getInitialKind</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyClDecl</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'>Name</span><span class='hs-layout'>,</span> <span class='hs-conid'>TcKind</span><span class='hs-layout'>)</span>
<a name="line-38"></a><span class='hs-comment'>-- Only for data type, class, and indexed type declarations</span>
<a name="line-39"></a><span class='hs-comment'>-- Get as much info as possible from the data, class, or indexed type decl,</span>
<a name="line-40"></a><span class='hs-comment'>-- so as to maximise usefulness of error messages</span>
<a name="line-41"></a><span class='hs-definition'>getInitialKind</span> <span class='hs-varid'>decl</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'>arg_kinds</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>mk_arg_kind</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unLoc</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyClDeclTyVars</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span>
<a name="line-43"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>res_kind</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mk_res_kind</span> <span class='hs-varid'>decl</span>
<a name="line-44"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdName</span> <span class='hs-varid'>decl</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkArrowKinds</span> <span class='hs-varid'>arg_kinds</span> <span class='hs-varid'>res_kind</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-45"></a> <span class='hs-keyword'>where</span>
<a name="line-46"></a> <span class='hs-varid'>mk_arg_kind</span> <span class='hs-layout'>(</span><span class='hs-conid'>UserTyVar</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>newKindVar</span>
<a name="line-47"></a> <span class='hs-varid'>mk_arg_kind</span> <span class='hs-layout'>(</span><span class='hs-conid'>KindedTyVar</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>kind</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varid'>kind</span>
<a name="line-48"></a>
<a name="line-49"></a> <span class='hs-varid'>mk_res_kind</span> <span class='hs-layout'>(</span><span class='hs-conid'>TyFamily</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcdKind</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>kind</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varid'>kind</span>
<a name="line-50"></a> <span class='hs-varid'>mk_res_kind</span> <span class='hs-layout'>(</span><span class='hs-conid'>TyData</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcdKindSig</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>kind</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varid'>kind</span>
<a name="line-51"></a> <span class='hs-comment'>-- On GADT-style declarations we allow a kind signature</span>
<a name="line-52"></a> <span class='hs-comment'>-- data T :: *->* where { ... }</span>
<a name="line-53"></a> <span class='hs-varid'>mk_res_kind</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varid'>liftedTypeKind</span>
<a name="line-54"></a>
<a name="line-55"></a>
<a name="line-56"></a><a name="kcSynDecls"></a><span class='hs-comment'>----------------</span>
<a name="line-57"></a><span class='hs-definition'>kcSynDecls</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>SCC</span> <span class='hs-layout'>(</span><span class='hs-conid'>LTyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-58"></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'>LTyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Kind-annotated decls</span>
<a name="line-59"></a> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Name</span><span class='hs-layout'>,</span><span class='hs-conid'>TcKind</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Kind bindings</span>
<a name="line-60"></a><span class='hs-definition'>kcSynDecls</span> <span class='hs-conid'>[]</span>
<a name="line-61"></a> <span class='hs-keyglyph'>=</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-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-62"></a><span class='hs-definition'>kcSynDecls</span> <span class='hs-layout'>(</span><span class='hs-varid'>group</span> <span class='hs-conop'>:</span> <span class='hs-varid'>groups</span><span class='hs-layout'>)</span>
<a name="line-63"></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'>decl</span><span class='hs-layout'>,</span> <span class='hs-varid'>nk</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kcSynDecl</span> <span class='hs-varid'>group</span>
<a name="line-64"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>decls</span><span class='hs-layout'>,</span> <span class='hs-varid'>nks</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcExtendKindEnv</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>nk</span><span class='hs-keyglyph'>]</span> <span class='hs-layout'>(</span><span class='hs-varid'>kcSynDecls</span> <span class='hs-varid'>groups</span><span class='hs-layout'>)</span>
<a name="line-65"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>decl</span><span class='hs-conop'>:</span><span class='hs-varid'>decls</span><span class='hs-layout'>,</span> <span class='hs-varid'>nk</span><span class='hs-conop'>:</span><span class='hs-varid'>nks</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-66"></a>
<a name="line-67"></a><a name="kcSynDecl"></a><span class='hs-comment'>----------------</span>
<a name="line-68"></a><span class='hs-definition'>kcSynDecl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SCC</span> <span class='hs-layout'>(</span><span class='hs-conid'>LTyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-layout'>)</span>
<a name="line-69"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>LTyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Kind-annotated decls</span>
<a name="line-70"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Name</span><span class='hs-layout'>,</span><span class='hs-conid'>TcKind</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Kind bindings</span>
<a name="line-71"></a><span class='hs-definition'>kcSynDecl</span> <span class='hs-layout'>(</span><span class='hs-conid'>AcyclicSCC</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-72"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcAddDeclCtxt</span> <span class='hs-varid'>decl</span> <span class='hs-varop'>$</span>
<a name="line-73"></a> <span class='hs-varid'>kcHsTyVars</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdTyVars</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>k_tvs</span> <span class='hs-keyglyph'>-></span>
<a name="line-74"></a> <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'>"kcd1"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdLName</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>brackets</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdTyVars</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-75"></a> <span class='hs-varop'><+></span> <span class='hs-varid'>brackets</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>k_tvs</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-76"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>k_rhs</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs_kind</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kcLHsType</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdSynRhs</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span>
<a name="line-77"></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'>"kcd2"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdLName</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-78"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>tc_kind</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkArrowKind</span> <span class='hs-varop'>.</span> <span class='hs-varid'>kindedTyVarKind</span><span class='hs-layout'>)</span> <span class='hs-varid'>rhs_kind</span> <span class='hs-varid'>k_tvs</span>
<a name="line-79"></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-varid'>decl</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcdTyVars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>k_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdSynRhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>k_rhs</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-80"></a> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdLName</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>tc_kind</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-81"></a>
<a name="line-82"></a><span class='hs-definition'>kcSynDecl</span> <span class='hs-layout'>(</span><span class='hs-conid'>CyclicSCC</span> <span class='hs-varid'>decls</span><span class='hs-layout'>)</span>
<a name="line-83"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>recSynErr</span> <span class='hs-varid'>decls</span><span class='hs-layout'>;</span> <span class='hs-varid'>failM</span> <span class='hs-layout'>}</span> <span class='hs-comment'>-- Fail here to avoid error cascade</span>
<a name="line-84"></a> <span class='hs-comment'>-- of out-of-scope tycons</span>
<a name="line-85"></a>
<a name="line-86"></a><a name="kindedTyVarKind"></a><span class='hs-definition'>kindedTyVarKind</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LHsTyVarBndr</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Kind</span>
<a name="line-87"></a><span class='hs-definition'>kindedTyVarKind</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'>KindedTyVar</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>k</span>
<a name="line-88"></a><span class='hs-definition'>kindedTyVarKind</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"kindedTyVarKind"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-89"></a>
<a name="line-90"></a><a name="kcTyClDecl"></a><span class='hs-comment'>------------------------------------------------------------------------</span>
<a name="line-91"></a><span class='hs-definition'>kcTyClDecl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyClDecl</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'>TyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-layout'>)</span>
<a name="line-92"></a> <span class='hs-comment'>-- Not used for type synonyms (see kcSynDecl)</span>
<a name="line-93"></a>
<a name="line-94"></a><span class='hs-definition'>kcTyClDecl</span> <span class='hs-varid'>decl</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>TyData</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-95"></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-varop'>.</span> <span class='hs-varid'>isFamInstDecl</span> <span class='hs-varop'>$</span> <span class='hs-varid'>decl</span> <span class='hs-layout'>)</span> <span class='hs-comment'>-- must not be a family instance</span>
<a name="line-96"></a> <span class='hs-varid'>kcTyClDeclBody</span> <span class='hs-varid'>decl</span> <span class='hs-varop'>$</span>
<a name="line-97"></a> <span class='hs-varid'>kcDataDecl</span> <span class='hs-varid'>decl</span>
<a name="line-98"></a>
<a name="line-99"></a><span class='hs-definition'>kcTyClDecl</span> <span class='hs-varid'>decl</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>TyFamily</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-100"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>kcFamilyDecl</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>decl</span> <span class='hs-comment'>-- the empty list signals a toplevel decl </span>
<a name="line-101"></a>
<a name="line-102"></a><span class='hs-definition'>kcTyClDecl</span> <span class='hs-varid'>decl</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>ClassDecl</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdCtxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdSigs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sigs</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdATs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ats</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-103"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>kcTyClDeclBody</span> <span class='hs-varid'>decl</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>tvs'</span> <span class='hs-keyglyph'>-></span>
<a name="line-104"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ctxt'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kcHsContext</span> <span class='hs-varid'>ctxt</span>
<a name="line-105"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>ats'</span> <span class='hs-keyglyph'><-</span> <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'>kcFamilyDecl</span> <span class='hs-varid'>tvs'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>ats</span>
<a name="line-106"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>sigs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>wrapLocM</span> <span class='hs-varid'>kc_sig</span><span class='hs-layout'>)</span> <span class='hs-varid'>sigs</span>
<a name="line-107"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>decl</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdTyVars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdCtxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ctxt'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdSigs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sigs'</span><span class='hs-layout'>,</span>
<a name="line-108"></a> <span class='hs-varid'>tcdATs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ats'</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-109"></a> <span class='hs-keyword'>where</span>
<a name="line-110"></a> <span class='hs-varid'>kc_sig</span> <span class='hs-layout'>(</span><span class='hs-conid'>TypeSig</span> <span class='hs-varid'>nm</span> <span class='hs-varid'>op_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>op_ty'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kcHsLiftedSigType</span> <span class='hs-varid'>op_ty</span>
<a name="line-111"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>TypeSig</span> <span class='hs-varid'>nm</span> <span class='hs-varid'>op_ty'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-112"></a> <span class='hs-varid'>kc_sig</span> <span class='hs-varid'>other_sig</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varid'>other_sig</span>
<a name="line-113"></a>
<a name="line-114"></a><span class='hs-definition'>kcTyClDecl</span> <span class='hs-varid'>decl</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>ForeignType</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-115"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varid'>decl</span>
<a name="line-116"></a>
<a name="line-117"></a><span class='hs-definition'>kcTyClDecl</span> <span class='hs-layout'>(</span><span class='hs-conid'>TySynonym</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"kcTyClDecl TySynonym"</span>
<a name="line-118"></a>
<a name="line-119"></a><a name="kcTyClDeclBody"></a><span class='hs-definition'>kcTyClDeclBody</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyClDecl</span> <span class='hs-conid'>Name</span>
<a name="line-120"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>LHsTyVarBndr</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-121"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span>
<a name="line-122"></a><span class='hs-comment'>-- getInitialKind has made a suitably-shaped kind for the type or class</span>
<a name="line-123"></a><span class='hs-comment'>-- Unpack it, and attribute those kinds to the type variables</span>
<a name="line-124"></a><span class='hs-comment'>-- Extend the env with bindings for the tyvars, taken from</span>
<a name="line-125"></a><span class='hs-comment'>-- the kind of the tycon/class. Give it to the thing inside, and </span>
<a name="line-126"></a><span class='hs-comment'>-- check the result kind matches</span>
<a name="line-127"></a><span class='hs-definition'>kcTyClDeclBody</span> <span class='hs-varid'>decl</span> <span class='hs-varid'>thing_inside</span>
<a name="line-128"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcAddDeclCtxt</span> <span class='hs-varid'>decl</span> <span class='hs-varop'>$</span>
<a name="line-129"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tc_ty_thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupLocated</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdLName</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span>
<a name="line-130"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>tc_kind</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>tc_ty_thing</span> <span class='hs-keyword'>of</span>
<a name="line-131"></a> <span class='hs-conid'>AThing</span> <span class='hs-varid'>k</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>k</span>
<a name="line-132"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"kcTyClDeclBody"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>tc_ty_thing</span><span class='hs-layout'>)</span>
<a name="line-133"></a> <span class='hs-layout'>(</span><span class='hs-varid'>kinds</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitKindFunTys</span> <span class='hs-varid'>tc_kind</span>
<a name="line-134"></a> <span class='hs-varid'>hs_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcdTyVars</span> <span class='hs-varid'>decl</span>
<a name="line-135"></a> <span class='hs-varid'>kinded_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span> <span class='hs-varid'>length</span> <span class='hs-varid'>kinds</span> <span class='hs-varop'>>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>hs_tvs</span> <span class='hs-layout'>)</span>
<a name="line-136"></a> <span class='hs-keyglyph'>[</span> <span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-layout'>(</span><span class='hs-conid'>KindedTyVar</span> <span class='hs-layout'>(</span><span class='hs-varid'>hsTyVarName</span> <span class='hs-varid'>tv</span><span class='hs-layout'>)</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span>
<a name="line-137"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>tv</span><span class='hs-layout'>,</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zip</span> <span class='hs-varid'>hs_tvs</span> <span class='hs-varid'>kinds</span><span class='hs-keyglyph'>]</span>
<a name="line-138"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tcExtendKindEnvTvs</span> <span class='hs-varid'>kinded_tvs</span> <span class='hs-layout'>(</span><span class='hs-varid'>thing_inside</span> <span class='hs-varid'>kinded_tvs</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-139"></a>
<a name="line-140"></a><a name="kcDataDecl"></a><span class='hs-comment'>-- Kind check a data declaration, assuming that we already extended the</span>
<a name="line-141"></a><span class='hs-comment'>-- kind environment with the type variables of the left-hand side (these</span>
<a name="line-142"></a><span class='hs-comment'>-- kinded type variables are also passed as the second parameter).</span>
<a name="line-143"></a><span class='hs-comment'>--</span>
<a name="line-144"></a><span class='hs-definition'>kcDataDecl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyClDecl</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LHsTyVarBndr</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>TyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-layout'>)</span>
<a name="line-145"></a><span class='hs-definition'>kcDataDecl</span> <span class='hs-varid'>decl</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>TyData</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdND</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>new_or_data</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdCtxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdCons</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cons</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-146"></a> <span class='hs-varid'>tvs</span>
<a name="line-147"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ctxt'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kcHsContext</span> <span class='hs-varid'>ctxt</span>
<a name="line-148"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>cons'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>wrapLocM</span> <span class='hs-varid'>kc_con_decl</span><span class='hs-layout'>)</span> <span class='hs-varid'>cons</span>
<a name="line-149"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>decl</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdTyVars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdCtxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ctxt'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdCons</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cons'</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-150"></a> <span class='hs-keyword'>where</span>
<a name="line-151"></a> <span class='hs-comment'>-- doc comments are typechecked to Nothing here</span>
<a name="line-152"></a> <span class='hs-varid'>kc_con_decl</span> <span class='hs-varid'>con_decl</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>ConDecl</span> <span class='hs-layout'>{</span> <span class='hs-varid'>con_name</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>name</span><span class='hs-layout'>,</span> <span class='hs-varid'>con_qvars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ex_tvs</span>
<a name="line-153"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>con_cxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ex_ctxt</span><span class='hs-layout'>,</span> <span class='hs-varid'>con_details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>details</span><span class='hs-layout'>,</span> <span class='hs-varid'>con_res</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>res</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-154"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addErrCtxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConCtxt</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-155"></a> <span class='hs-varid'>kcHsTyVars</span> <span class='hs-varid'>ex_tvs</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ex_tvs'</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-156"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ex_ctxt'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kcHsContext</span> <span class='hs-varid'>ex_ctxt</span>
<a name="line-157"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>details'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kc_con_details</span> <span class='hs-varid'>details</span>
<a name="line-158"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>res'</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>res</span> <span class='hs-keyword'>of</span>
<a name="line-159"></a> <span class='hs-conid'>ResTyH98</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>ResTyH98</span>
<a name="line-160"></a> <span class='hs-conid'>ResTyGADT</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ty'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kcHsSigType</span> <span class='hs-varid'>ty</span><span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>ResTyGADT</span> <span class='hs-varid'>ty'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-161"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>con_decl</span> <span class='hs-layout'>{</span> <span class='hs-varid'>con_qvars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ex_tvs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>con_cxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ex_ctxt'</span>
<a name="line-162"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>con_details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>details'</span><span class='hs-layout'>,</span> <span class='hs-varid'>con_res</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>res'</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-163"></a>
<a name="line-164"></a> <span class='hs-varid'>kc_con_details</span> <span class='hs-layout'>(</span><span class='hs-conid'>PrefixCon</span> <span class='hs-varid'>btys</span><span class='hs-layout'>)</span>
<a name="line-165"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>btys'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>kc_larg_ty</span> <span class='hs-varid'>btys</span>
<a name="line-166"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>PrefixCon</span> <span class='hs-varid'>btys'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-167"></a> <span class='hs-varid'>kc_con_details</span> <span class='hs-layout'>(</span><span class='hs-conid'>InfixCon</span> <span class='hs-varid'>bty1</span> <span class='hs-varid'>bty2</span><span class='hs-layout'>)</span>
<a name="line-168"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>bty1'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kc_larg_ty</span> <span class='hs-varid'>bty1</span>
<a name="line-169"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>bty2'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kc_larg_ty</span> <span class='hs-varid'>bty2</span>
<a name="line-170"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>InfixCon</span> <span class='hs-varid'>bty1'</span> <span class='hs-varid'>bty2'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-171"></a> <span class='hs-varid'>kc_con_details</span> <span class='hs-layout'>(</span><span class='hs-conid'>RecCon</span> <span class='hs-varid'>fields</span><span class='hs-layout'>)</span>
<a name="line-172"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>fields'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>kc_field</span> <span class='hs-varid'>fields</span>
<a name="line-173"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>RecCon</span> <span class='hs-varid'>fields'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-174"></a>
<a name="line-175"></a> <span class='hs-varid'>kc_field</span> <span class='hs-layout'>(</span><span class='hs-conid'>ConDeclField</span> <span class='hs-varid'>fld</span> <span class='hs-varid'>bty</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>bty'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>kc_larg_ty</span> <span class='hs-varid'>bty</span>
<a name="line-176"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>ConDeclField</span> <span class='hs-varid'>fld</span> <span class='hs-varid'>bty'</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-177"></a>
<a name="line-178"></a> <span class='hs-varid'>kc_larg_ty</span> <span class='hs-varid'>bty</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>new_or_data</span> <span class='hs-keyword'>of</span>
<a name="line-179"></a> <span class='hs-conid'>DataType</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>kcHsSigType</span> <span class='hs-varid'>bty</span>
<a name="line-180"></a> <span class='hs-conid'>NewType</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>kcHsLiftedSigType</span> <span class='hs-varid'>bty</span>
<a name="line-181"></a> <span class='hs-comment'>-- Can't allow an unlifted type for newtypes, because we're effectively</span>
<a name="line-182"></a> <span class='hs-comment'>-- going to remove the constructor while coercing it to a lifted type.</span>
<a name="line-183"></a> <span class='hs-comment'>-- And newtypes can't be bang'd</span>
<a name="line-184"></a><span class='hs-definition'>kcDataDecl</span> <span class='hs-varid'>d</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"kcDataDecl"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>
<a name="line-185"></a>
<a name="line-186"></a><a name="kcFamilyDecl"></a><span class='hs-comment'>-- Kind check a family declaration or type family default declaration.</span>
<a name="line-187"></a><span class='hs-comment'>--</span>
<a name="line-188"></a><span class='hs-definition'>kcFamilyDecl</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LHsTyVarBndr</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- tyvars of enclosing class decl if any</span>
<a name="line-189"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TyClDecl</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'>TyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-layout'>)</span>
<a name="line-190"></a><span class='hs-definition'>kcFamilyDecl</span> <span class='hs-varid'>classTvs</span> <span class='hs-varid'>decl</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>TyFamily</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdKind</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>kind</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-191"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>kcTyClDeclBody</span> <span class='hs-varid'>decl</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>tvs'</span> <span class='hs-keyglyph'>-></span>
<a name="line-192"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>mapM_</span> <span class='hs-varid'>unifyClassParmKinds</span> <span class='hs-varid'>tvs'</span>
<a name="line-193"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>decl</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdTyVars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs'</span><span class='hs-layout'>,</span>
<a name="line-194"></a> <span class='hs-varid'>tcdKind</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>kind</span> <span class='hs-varop'>`mplus`</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>liftedTypeKind</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-195"></a> <span class='hs-comment'>-- default result kind is '*'</span>
<a name="line-196"></a> <span class='hs-layout'>}</span>
<a name="line-197"></a> <span class='hs-keyword'>where</span>
<a name="line-198"></a> <span class='hs-varid'>unifyClassParmKinds</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'>KindedTyVar</span> <span class='hs-varid'>n</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-199"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>classParmKind</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lookup</span> <span class='hs-varid'>n</span> <span class='hs-varid'>classTyKinds</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unifyKind</span> <span class='hs-varid'>k</span> <span class='hs-varid'>classParmKind</span>
<a name="line-200"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-201"></a> <span class='hs-varid'>unifyClassParmKinds</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"kcFamilyDecl/unifyClassParmKinds"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-202"></a> <span class='hs-varid'>classTyKinds</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-layout'>,</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>KindedTyVar</span> <span class='hs-varid'>n</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>classTvs</span><span class='hs-keyglyph'>]</span>
<a name="line-203"></a><span class='hs-definition'>kcFamilyDecl</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>TySynonym</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- type family defaults</span>
<a name="line-204"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"TcTyClsDecls.kcFamilyDecl: not implemented yet"</span>
<a name="line-205"></a><span class='hs-definition'>kcFamilyDecl</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"kcFamilyDecl"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Type checking}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="tcSynDecls"></a><span class='hs-definition'>tcSynDecls</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LTyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyThing</span><span class='hs-keyglyph'>]</span>
<a name="line-2"></a><span class='hs-definition'>tcSynDecls</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>[]</span>
<a name="line-3"></a><span class='hs-definition'>tcSynDecls</span> <span class='hs-layout'>(</span><span class='hs-varid'>decl</span> <span class='hs-conop'>:</span> <span class='hs-varid'>decls</span><span class='hs-layout'>)</span>
<a name="line-4"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>syn_tc</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>addLocM</span> <span class='hs-varid'>tcSynDecl</span> <span class='hs-varid'>decl</span>
<a name="line-5"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>syn_tcs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcExtendGlobalEnv</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>syn_tc</span><span class='hs-keyglyph'>]</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcSynDecls</span> <span class='hs-varid'>decls</span><span class='hs-layout'>)</span>
<a name="line-6"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>syn_tc</span> <span class='hs-conop'>:</span> <span class='hs-varid'>syn_tcs</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-7"></a>
<a name="line-8"></a> <span class='hs-comment'>-- "type"</span>
<a name="line-9"></a><a name="tcSynDecl"></a><span class='hs-definition'>tcSynDecl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyClDecl</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TyThing</span>
<a name="line-10"></a><span class='hs-definition'>tcSynDecl</span>
<a name="line-11"></a> <span class='hs-layout'>(</span><span class='hs-conid'>TySynonym</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdLName</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdTyVars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdSynRhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rhs_ty</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcTyVarBndrs</span> <span class='hs-varid'>tvs</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>tvs'</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-13"></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'>"tcd1"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-14"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>rhs_ty'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcHsKindedType</span> <span class='hs-varid'>rhs_ty</span>
<a name="line-15"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tycon</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>buildSynTyCon</span> <span class='hs-varid'>tc_name</span> <span class='hs-varid'>tvs'</span> <span class='hs-layout'>(</span><span class='hs-conid'>SynonymTyCon</span> <span class='hs-varid'>rhs_ty'</span><span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-layout'>(</span><span class='hs-varid'>typeKind</span> <span class='hs-varid'>rhs_ty'</span><span class='hs-layout'>)</span> <span class='hs-conid'>Nothing</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'>ATyCon</span> <span class='hs-varid'>tycon</span><span class='hs-layout'>)</span>
<a name="line-18"></a> <span class='hs-layout'>}</span>
<a name="line-19"></a><span class='hs-definition'>tcSynDecl</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcSynDecl"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>
<a name="line-20"></a>
<a name="line-21"></a><a name="tcTyClDecl"></a><span class='hs-comment'>--------------------</span>
<a name="line-22"></a><span class='hs-definition'>tcTyClDecl</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RecFlag</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TyClDecl</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyThing</span><span class='hs-keyglyph'>]</span>
<a name="line-23"></a>
<a name="line-24"></a><span class='hs-definition'>tcTyClDecl</span> <span class='hs-varid'>calc_isrec</span> <span class='hs-varid'>decl</span>
<a name="line-25"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcAddDeclCtxt</span> <span class='hs-varid'>decl</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcTyClDecl1</span> <span class='hs-varid'>calc_isrec</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-comment'>-- "type family" declarations</span>
<a name="line-28"></a><a name="tcTyClDecl1"></a><span class='hs-definition'>tcTyClDecl1</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RecFlag</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TyClDecl</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyThing</span><span class='hs-keyglyph'>]</span>
<a name="line-29"></a><span class='hs-definition'>tcTyClDecl1</span> <span class='hs-sel'>_calc_isrec</span>
<a name="line-30"></a> <span class='hs-layout'>(</span><span class='hs-conid'>TyFamily</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdFlavour</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>TypeFamily</span><span class='hs-layout'>,</span>
<a name="line-31"></a> <span class='hs-varid'>tcdLName</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdTyVars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs</span><span class='hs-layout'>,</span>
<a name="line-32"></a> <span class='hs-varid'>tcdKind</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>kind</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- NB: kind at latest added during kind checking</span>
<a name="line-33"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcTyVarBndrs</span> <span class='hs-varid'>tvs</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>tvs'</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-34"></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'>"type family: "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-35"></a>
<a name="line-36"></a> <span class='hs-comment'>-- Check that we don't use families without -XTypeFamilies</span>
<a name="line-37"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>idx_tys</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_TypeFamilies</span>
<a name="line-38"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-varid'>idx_tys</span> <span class='hs-varop'>$</span> <span class='hs-varid'>badFamInstDecl</span> <span class='hs-varid'>tc_name</span>
<a name="line-39"></a>
<a name="line-40"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tycon</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>buildSynTyCon</span> <span class='hs-varid'>tc_name</span> <span class='hs-varid'>tvs'</span> <span class='hs-layout'>(</span><span class='hs-conid'>OpenSynTyCon</span> <span class='hs-varid'>kind</span> <span class='hs-conid'>Nothing</span><span class='hs-layout'>)</span> <span class='hs-varid'>kind</span> <span class='hs-conid'>Nothing</span>
<a name="line-41"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>ATyCon</span> <span class='hs-varid'>tycon</span><span class='hs-keyglyph'>]</span>
<a name="line-42"></a> <span class='hs-layout'>}</span>
<a name="line-43"></a>
<a name="line-44"></a> <span class='hs-comment'>-- "data family" declaration</span>
<a name="line-45"></a><span class='hs-definition'>tcTyClDecl1</span> <span class='hs-sel'>_calc_isrec</span>
<a name="line-46"></a> <span class='hs-layout'>(</span><span class='hs-conid'>TyFamily</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdFlavour</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>DataFamily</span><span class='hs-layout'>,</span>
<a name="line-47"></a> <span class='hs-varid'>tcdLName</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdTyVars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdKind</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mb_kind</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-48"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcTyVarBndrs</span> <span class='hs-varid'>tvs</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>tvs'</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-49"></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'>"data family: "</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-50"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>extra_tvs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcDataKindSig</span> <span class='hs-varid'>mb_kind</span>
<a name="line-51"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>final_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs'</span> <span class='hs-varop'>++</span> <span class='hs-varid'>extra_tvs</span> <span class='hs-comment'>-- we may not need these</span>
<a name="line-52"></a>
<a name="line-53"></a>
<a name="line-54"></a> <span class='hs-comment'>-- Check that we don't use families without -XTypeFamilies</span>
<a name="line-55"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>idx_tys</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_TypeFamilies</span>
<a name="line-56"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-varid'>idx_tys</span> <span class='hs-varop'>$</span> <span class='hs-varid'>badFamInstDecl</span> <span class='hs-varid'>tc_name</span>
<a name="line-57"></a>
<a name="line-58"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tycon</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>buildAlgTyCon</span> <span class='hs-varid'>tc_name</span> <span class='hs-varid'>final_tvs</span> <span class='hs-conid'>[]</span>
<a name="line-59"></a> <span class='hs-varid'>mkOpenDataTyConRhs</span> <span class='hs-conid'>Recursive</span> <span class='hs-conid'>False</span> <span class='hs-conid'>True</span> <span class='hs-conid'>Nothing</span>
<a name="line-60"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>ATyCon</span> <span class='hs-varid'>tycon</span><span class='hs-keyglyph'>]</span>
<a name="line-61"></a> <span class='hs-layout'>}</span>
<a name="line-62"></a>
<a name="line-63"></a> <span class='hs-comment'>-- "newtype" and "data"</span>
<a name="line-64"></a> <span class='hs-comment'>-- NB: not used for newtype/data instances (whether associated or not)</span>
<a name="line-65"></a><span class='hs-definition'>tcTyClDecl1</span> <span class='hs-varid'>calc_isrec</span>
<a name="line-66"></a> <span class='hs-layout'>(</span><span class='hs-conid'>TyData</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdND</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>new_or_data</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdCtxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdTyVars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs</span><span class='hs-layout'>,</span>
<a name="line-67"></a> <span class='hs-varid'>tcdLName</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdKindSig</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mb_ksig</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdCons</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cons</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-68"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcTyVarBndrs</span> <span class='hs-varid'>tvs</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>tvs'</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-69"></a> <span class='hs-layout'>{</span> <span class='hs-varid'>extra_tvs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcDataKindSig</span> <span class='hs-varid'>mb_ksig</span>
<a name="line-70"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>final_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs'</span> <span class='hs-varop'>++</span> <span class='hs-varid'>extra_tvs</span>
<a name="line-71"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>stupid_theta</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcHsKindedContext</span> <span class='hs-varid'>ctxt</span>
<a name="line-72"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>want_generic</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_Generics</span>
<a name="line-73"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>unbox_strict</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_UnboxStrictFields</span>
<a name="line-74"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>empty_data_decls</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_EmptyDataDecls</span>
<a name="line-75"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>kind_signatures</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_KindSignatures</span>
<a name="line-76"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>existential_ok</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_ExistentialQuantification</span>
<a name="line-77"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>gadt_ok</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_GADTs</span>
<a name="line-78"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>is_boot</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcIsHsBoot</span> <span class='hs-comment'>-- Are we compiling an hs-boot file?</span>
<a name="line-79"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>ex_ok</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>existential_ok</span> <span class='hs-varop'>||</span> <span class='hs-varid'>gadt_ok</span> <span class='hs-comment'>-- Data cons can have existential context</span>
<a name="line-80"></a>
<a name="line-81"></a> <span class='hs-comment'>-- Check that we don't use GADT syntax in H98 world</span>
<a name="line-82"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>gadt_ok</span> <span class='hs-varop'>||</span> <span class='hs-varid'>h98_syntax</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>badGadtDecl</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-83"></a>
<a name="line-84"></a> <span class='hs-comment'>-- Check that we don't use kind signatures without Glasgow extensions</span>
<a name="line-85"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>kind_signatures</span> <span class='hs-varop'>||</span> <span class='hs-varid'>isNothing</span> <span class='hs-varid'>mb_ksig</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>badSigTyDecl</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-86"></a>
<a name="line-87"></a> <span class='hs-comment'>-- Check that the stupid theta is empty for a GADT-style declaration</span>
<a name="line-88"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>stupid_theta</span> <span class='hs-varop'>||</span> <span class='hs-varid'>h98_syntax</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>badStupidTheta</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-89"></a>
<a name="line-90"></a> <span class='hs-comment'>-- Check that a newtype has exactly one constructor</span>
<a name="line-91"></a> <span class='hs-comment'>-- Do this before checking for empty data decls, so that</span>
<a name="line-92"></a> <span class='hs-comment'>-- we don't suggest -XEmptyDataDecls for newtypes</span>
<a name="line-93"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>new_or_data</span> <span class='hs-varop'>==</span> <span class='hs-conid'>DataType</span> <span class='hs-varop'>||</span> <span class='hs-varid'>isSingleton</span> <span class='hs-varid'>cons</span><span class='hs-layout'>)</span>
<a name="line-94"></a> <span class='hs-layout'>(</span><span class='hs-varid'>newtypeConError</span> <span class='hs-varid'>tc_name</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>cons</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-95"></a>
<a name="line-96"></a> <span class='hs-comment'>-- Check that there's at least one condecl,</span>
<a name="line-97"></a> <span class='hs-comment'>-- or else we're reading an hs-boot file, or -XEmptyDataDecls</span>
<a name="line-98"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</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'>cons</span><span class='hs-layout'>)</span> <span class='hs-varop'>||</span> <span class='hs-varid'>empty_data_decls</span> <span class='hs-varop'>||</span> <span class='hs-varid'>is_boot</span><span class='hs-layout'>)</span>
<a name="line-99"></a> <span class='hs-layout'>(</span><span class='hs-varid'>emptyConDeclsErr</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-100"></a>
<a name="line-101"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tycon</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>fixM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>tycon</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-102"></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'>mkTyConApp</span> <span class='hs-varid'>tycon</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkTyVarTys</span> <span class='hs-varid'>final_tvs</span><span class='hs-layout'>)</span>
<a name="line-103"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>data_cons</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcConDecls</span> <span class='hs-varid'>unbox_strict</span> <span class='hs-varid'>ex_ok</span>
<a name="line-104"></a> <span class='hs-varid'>tycon</span> <span class='hs-layout'>(</span><span class='hs-varid'>final_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>cons</span>
<a name="line-105"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tc_rhs</span> <span class='hs-keyglyph'><-</span>
<a name="line-106"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>null</span> <span class='hs-varid'>cons</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>is_boot</span> <span class='hs-comment'>-- In a hs-boot file, empty cons means</span>
<a name="line-107"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-conid'>AbstractTyCon</span> <span class='hs-comment'>-- "don't know"; hence Abstract</span>
<a name="line-108"></a> <span class='hs-keyword'>else</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>new_or_data</span> <span class='hs-keyword'>of</span>
<a name="line-109"></a> <span class='hs-conid'>DataType</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkDataTyConRhs</span> <span class='hs-varid'>data_cons</span><span class='hs-layout'>)</span>
<a name="line-110"></a> <span class='hs-conid'>NewType</span> <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'>data_cons</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-111"></a> <span class='hs-varid'>mkNewTyConRhs</span> <span class='hs-varid'>tc_name</span> <span class='hs-varid'>tycon</span> <span class='hs-layout'>(</span><span class='hs-varid'>head</span> <span class='hs-varid'>data_cons</span><span class='hs-layout'>)</span>
<a name="line-112"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>buildAlgTyCon</span> <span class='hs-varid'>tc_name</span> <span class='hs-varid'>final_tvs</span> <span class='hs-varid'>stupid_theta</span> <span class='hs-varid'>tc_rhs</span> <span class='hs-varid'>is_rec</span>
<a name="line-113"></a> <span class='hs-layout'>(</span><span class='hs-varid'>want_generic</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>canDoGenerics</span> <span class='hs-varid'>data_cons</span><span class='hs-layout'>)</span> <span class='hs-varid'>h98_syntax</span> <span class='hs-conid'>Nothing</span>
<a name="line-114"></a> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-115"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>ATyCon</span> <span class='hs-varid'>tycon</span><span class='hs-keyglyph'>]</span>
<a name="line-116"></a> <span class='hs-layout'>}</span>
<a name="line-117"></a> <span class='hs-keyword'>where</span>
<a name="line-118"></a> <span class='hs-varid'>is_rec</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>calc_isrec</span> <span class='hs-varid'>tc_name</span>
<a name="line-119"></a> <span class='hs-varid'>h98_syntax</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>consUseH98Syntax</span> <span class='hs-varid'>cons</span>
<a name="line-120"></a>
<a name="line-121"></a><span class='hs-definition'>tcTyClDecl1</span> <span class='hs-varid'>calc_isrec</span>
<a name="line-122"></a> <span class='hs-layout'>(</span><span class='hs-conid'>ClassDecl</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdLName</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>class_name</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdTyVars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs</span><span class='hs-layout'>,</span>
<a name="line-123"></a> <span class='hs-varid'>tcdCtxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdMeths</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>meths</span><span class='hs-layout'>,</span>
<a name="line-124"></a> <span class='hs-varid'>tcdFDs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fundeps</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdSigs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sigs</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdATs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ats</span><span class='hs-layout'>}</span> <span class='hs-layout'>)</span>
<a name="line-125"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcTyVarBndrs</span> <span class='hs-varid'>tvs</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>tvs'</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-126"></a> <span class='hs-layout'>{</span> <span class='hs-varid'>ctxt'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcHsKindedContext</span> <span class='hs-varid'>ctxt</span>
<a name="line-127"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>fds'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>addLocM</span> <span class='hs-varid'>tc_fundep</span><span class='hs-layout'>)</span> <span class='hs-varid'>fundeps</span>
<a name="line-128"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>atss</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>addLocM</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcTyClDecl1</span> <span class='hs-layout'>(</span><span class='hs-varid'>const</span> <span class='hs-conid'>Recursive</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>ats</span>
<a name="line-129"></a> <span class='hs-comment'>-- NB: 'ats' only contains "type family" and "data family"</span>
<a name="line-130"></a> <span class='hs-comment'>-- declarations as well as type family defaults</span>
<a name="line-131"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>ats'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>setAssocFamilyPermutation</span> <span class='hs-varid'>tvs'</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>concat</span> <span class='hs-varid'>atss</span><span class='hs-layout'>)</span>
<a name="line-132"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>sig_stuff</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcClassSigs</span> <span class='hs-varid'>class_name</span> <span class='hs-varid'>sigs</span> <span class='hs-varid'>meths</span>
<a name="line-133"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>clas</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>fixM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>clas</span> <span class='hs-keyglyph'>-></span>
<a name="line-134"></a> <span class='hs-keyword'>let</span> <span class='hs-comment'>-- This little knot is just so we can get</span>
<a name="line-135"></a> <span class='hs-comment'>-- hold of the name of the class TyCon, which we</span>
<a name="line-136"></a> <span class='hs-comment'>-- need to look up its recursiveness</span>
<a name="line-137"></a> <span class='hs-varid'>tycon_name</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tyConName</span> <span class='hs-layout'>(</span><span class='hs-varid'>classTyCon</span> <span class='hs-varid'>clas</span><span class='hs-layout'>)</span>
<a name="line-138"></a> <span class='hs-varid'>tc_isrec</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>calc_isrec</span> <span class='hs-varid'>tycon_name</span>
<a name="line-139"></a> <span class='hs-keyword'>in</span>
<a name="line-140"></a> <span class='hs-varid'>buildClass</span> <span class='hs-conid'>False</span> <span class='hs-comment'>{- Must include unfoldings for selectors -}</span>
<a name="line-141"></a> <span class='hs-varid'>class_name</span> <span class='hs-varid'>tvs'</span> <span class='hs-varid'>ctxt'</span> <span class='hs-varid'>fds'</span> <span class='hs-varid'>ats'</span>
<a name="line-142"></a> <span class='hs-varid'>sig_stuff</span> <span class='hs-varid'>tc_isrec</span><span class='hs-layout'>)</span>
<a name="line-143"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>AClass</span> <span class='hs-varid'>clas</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ats'</span><span class='hs-layout'>)</span>
<a name="line-144"></a> <span class='hs-comment'>-- NB: Order is important due to the call to `mkGlobalThings' when</span>
<a name="line-145"></a> <span class='hs-comment'>-- tying the the type and class declaration type checking knot.</span>
<a name="line-146"></a> <span class='hs-layout'>}</span>
<a name="line-147"></a> <span class='hs-keyword'>where</span>
<a name="line-148"></a> <span class='hs-varid'>tc_fundep</span> <span class='hs-layout'>(</span><span class='hs-varid'>tvs1</span><span class='hs-layout'>,</span> <span class='hs-varid'>tvs2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tvs1'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>tcLookupTyVar</span> <span class='hs-varid'>tvs1</span> <span class='hs-layout'>;</span>
<a name="line-149"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tvs2'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>tcLookupTyVar</span> <span class='hs-varid'>tvs2</span> <span class='hs-layout'>;</span>
<a name="line-150"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tvs1'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tvs2'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-151"></a>
<a name="line-152"></a><span class='hs-definition'>tcTyClDecl1</span> <span class='hs-keyword'>_</span>
<a name="line-153"></a> <span class='hs-layout'>(</span><span class='hs-conid'>ForeignType</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcdLName</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcdExtName</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tc_ext_name</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-154"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>ATyCon</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkForeignTyCon</span> <span class='hs-varid'>tc_name</span> <span class='hs-varid'>tc_ext_name</span> <span class='hs-varid'>liftedTypeKind</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-155"></a>
<a name="line-156"></a><span class='hs-definition'>tcTyClDecl1</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcTyClDecl1"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>
<a name="line-157"></a>
<a name="line-158"></a><a name="tcConDecls"></a><span class='hs-comment'>-----------------------------------</span>
<a name="line-159"></a><span class='hs-definition'>tcConDecls</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TyCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>TyVar</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span>
<a name="line-160"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LConDecl</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>DataCon</span><span class='hs-keyglyph'>]</span>
<a name="line-161"></a><span class='hs-definition'>tcConDecls</span> <span class='hs-varid'>unbox</span> <span class='hs-varid'>ex_ok</span> <span class='hs-varid'>rep_tycon</span> <span class='hs-varid'>res_tmpl</span> <span class='hs-varid'>cons</span>
<a name="line-162"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>addLocM</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcConDecl</span> <span class='hs-varid'>unbox</span> <span class='hs-varid'>ex_ok</span> <span class='hs-varid'>rep_tycon</span> <span class='hs-varid'>res_tmpl</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>cons</span>
<a name="line-163"></a>
<a name="line-164"></a><a name="tcConDecl"></a><span class='hs-definition'>tcConDecl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- True <=> -funbox-strict_fields</span>
<a name="line-165"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- True <=> -XExistentialQuantificaton or -XGADTs</span>
<a name="line-166"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TyCon</span> <span class='hs-comment'>-- Representation tycon</span>
<a name="line-167"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>TyVar</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Return type template (with its template tyvars)</span>
<a name="line-168"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ConDecl</span> <span class='hs-conid'>Name</span>
<a name="line-169"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>DataCon</span>
<a name="line-170"></a>
<a name="line-171"></a><span class='hs-definition'>tcConDecl</span> <span class='hs-varid'>unbox_strict</span> <span class='hs-varid'>existential_ok</span> <span class='hs-varid'>rep_tycon</span> <span class='hs-varid'>res_tmpl</span> <span class='hs-comment'>-- Data types</span>
<a name="line-172"></a> <span class='hs-layout'>(</span><span class='hs-conid'>ConDecl</span> <span class='hs-layout'>{</span><span class='hs-varid'>con_name</span> <span class='hs-keyglyph'>=</span><span class='hs-varid'>name</span><span class='hs-layout'>,</span> <span class='hs-varid'>con_qvars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>con_cxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ctxt</span>
<a name="line-173"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>con_details</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>details</span><span class='hs-layout'>,</span> <span class='hs-varid'>con_res</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>res_ty</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-174"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addErrCtxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConCtxt</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-175"></a> <span class='hs-varid'>tcTyVarBndrs</span> <span class='hs-varid'>tvs</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>tvs'</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-176"></a> <span class='hs-layout'>{</span> <span class='hs-varid'>ctxt'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcHsKindedContext</span> <span class='hs-varid'>ctxt</span>
<a name="line-177"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>existential_ok</span> <span class='hs-varop'>||</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>tvs</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>null</span> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-varid'>ctxt</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-178"></a> <span class='hs-layout'>(</span><span class='hs-varid'>badExistential</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span>
<a name="line-179"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>univ_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ex_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>eq_preds</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'>tcResultType</span> <span class='hs-varid'>res_tmpl</span> <span class='hs-varid'>tvs'</span> <span class='hs-varid'>res_ty</span>
<a name="line-180"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span>
<a name="line-181"></a> <span class='hs-varid'>tc_datacon</span> <span class='hs-varid'>is_infix</span> <span class='hs-varid'>field_lbls</span> <span class='hs-varid'>btys</span>
<a name="line-182"></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'>arg_tys</span><span class='hs-layout'>,</span> <span class='hs-varid'>stricts</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapAndUnzipM</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcConArg</span> <span class='hs-varid'>unbox_strict</span><span class='hs-layout'>)</span> <span class='hs-varid'>btys</span>
<a name="line-183"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>buildDataCon</span> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span> <span class='hs-varid'>is_infix</span>
<a name="line-184"></a> <span class='hs-varid'>stricts</span> <span class='hs-varid'>field_lbls</span>
<a name="line-185"></a> <span class='hs-varid'>univ_tvs</span> <span class='hs-varid'>ex_tvs</span> <span class='hs-varid'>eq_preds</span> <span class='hs-varid'>ctxt'</span> <span class='hs-varid'>arg_tys</span>
<a name="line-186"></a> <span class='hs-varid'>res_ty'</span> <span class='hs-varid'>rep_tycon</span> <span class='hs-layout'>}</span>
<a name="line-187"></a> <span class='hs-comment'>-- NB: we put data_tc, the type constructor gotten from the</span>
<a name="line-188"></a> <span class='hs-comment'>-- constructor type signature into the data constructor;</span>
<a name="line-189"></a> <span class='hs-comment'>-- that way checkValidDataCon can complain if it's wrong.</span>
<a name="line-190"></a>
<a name="line-191"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>details</span> <span class='hs-keyword'>of</span>
<a name="line-192"></a> <span class='hs-conid'>PrefixCon</span> <span class='hs-varid'>btys</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>tc_datacon</span> <span class='hs-conid'>False</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>btys</span>
<a name="line-193"></a> <span class='hs-conid'>InfixCon</span> <span class='hs-varid'>bty1</span> <span class='hs-varid'>bty2</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>tc_datacon</span> <span class='hs-conid'>True</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>bty1</span><span class='hs-layout'>,</span><span class='hs-varid'>bty2</span><span class='hs-keyglyph'>]</span>
<a name="line-194"></a> <span class='hs-conid'>RecCon</span> <span class='hs-varid'>fields</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>tc_datacon</span> <span class='hs-conid'>False</span> <span class='hs-varid'>field_names</span> <span class='hs-varid'>btys</span>
<a name="line-195"></a> <span class='hs-keyword'>where</span>
<a name="line-196"></a> <span class='hs-varid'>field_names</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>unLoc</span> <span class='hs-varop'>.</span> <span class='hs-varid'>cd_fld_name</span><span class='hs-layout'>)</span> <span class='hs-varid'>fields</span>
<a name="line-197"></a> <span class='hs-varid'>btys</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>cd_fld_type</span> <span class='hs-varid'>fields</span>
<a name="line-198"></a> <span class='hs-layout'>}</span>
<a name="line-199"></a>
<a name="line-200"></a><span class='hs-comment'>-- Example</span>
<a name="line-201"></a><span class='hs-comment'>-- data instance T (b,c) where </span>
<a name="line-202"></a><span class='hs-comment'>-- TI :: forall e. e -> T (e,e)</span>
<a name="line-203"></a><span class='hs-comment'>--</span>
<a name="line-204"></a><span class='hs-comment'>-- The representation tycon looks like this:</span>
<a name="line-205"></a><span class='hs-comment'>-- data :R7T b c where </span>
<a name="line-206"></a><span class='hs-comment'>-- TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1</span>
<a name="line-207"></a><span class='hs-comment'>-- In this case orig_res_ty = T (e,e)</span>
<a name="line-208"></a>
<a name="line-209"></a><a name="tcResultType"></a><span class='hs-definition'>tcResultType</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>TyVar</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Template for result type; e.g.</span>
<a name="line-210"></a> <span class='hs-comment'>-- data instance T [a] b c = ... </span>
<a name="line-211"></a> <span class='hs-comment'>-- gives template ([a,b,c], T [a] b c)</span>
<a name="line-212"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyVar</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- where MkT :: forall x y z. ...</span>
<a name="line-213"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ResType</span> <span class='hs-conid'>Name</span>
<a name="line-214"></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'>TyVar</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Universal</span>
<a name="line-215"></a> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyVar</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Existential (distinct OccNames from univs)</span>
<a name="line-216"></a> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>TyVar</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-comment'>-- Equality predicates</span>
<a name="line-217"></a> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Typechecked return type</span>
<a name="line-218"></a> <span class='hs-comment'>-- We don't check that the TyCon given in the ResTy is</span>
<a name="line-219"></a> <span class='hs-comment'>-- the same as the parent tycon, becuase we are in the middle</span>
<a name="line-220"></a> <span class='hs-comment'>-- of a recursive knot; so it's postponed until checkValidDataCon</span>
<a name="line-221"></a>
<a name="line-222"></a><span class='hs-definition'>tcResultType</span> <span class='hs-layout'>(</span><span class='hs-varid'>tmpl_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>dc_tvs</span> <span class='hs-conid'>ResTyH98</span>
<a name="line-223"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tmpl_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>dc_tvs</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span>
<a name="line-224"></a> <span class='hs-comment'>-- In H98 syntax the dc_tvs are the existential ones</span>
<a name="line-225"></a> <span class='hs-comment'>-- data T a b c = forall d e. MkT ...</span>
<a name="line-226"></a> <span class='hs-comment'>-- The {a,b,c} are tc_tvs, and {d,e} are dc_tvs</span>
<a name="line-227"></a>
<a name="line-228"></a><span class='hs-definition'>tcResultType</span> <span class='hs-layout'>(</span><span class='hs-varid'>tmpl_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>res_tmpl</span><span class='hs-layout'>)</span> <span class='hs-varid'>dc_tvs</span> <span class='hs-layout'>(</span><span class='hs-conid'>ResTyGADT</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span>
<a name="line-229"></a> <span class='hs-comment'>-- E.g. data T [a] b c where</span>
<a name="line-230"></a> <span class='hs-comment'>-- MkT :: forall x y z. T [(x,y)] z z</span>
<a name="line-231"></a> <span class='hs-comment'>-- Then we generate</span>
<a name="line-232"></a> <span class='hs-comment'>-- Univ tyvars Eq-spec</span>
<a name="line-233"></a> <span class='hs-comment'>-- a a~(x,y)</span>
<a name="line-234"></a> <span class='hs-comment'>-- b b~z</span>
<a name="line-235"></a> <span class='hs-comment'>-- z </span>
<a name="line-236"></a> <span class='hs-comment'>-- Existentials are the leftover type vars: [x,y]</span>
<a name="line-237"></a> <span class='hs-comment'>-- So we return ([a,b,z], [x,y], [a~(x,y),b~z], T [(x,y)] z z)</span>
<a name="line-238"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>res_ty'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcHsKindedType</span> <span class='hs-varid'>res_ty</span>
<a name="line-239"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>subst</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcMatchTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkVarSet</span> <span class='hs-varid'>tmpl_tvs</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_tmpl</span> <span class='hs-varid'>res_ty'</span>
<a name="line-240"></a>
<a name="line-241"></a> <span class='hs-comment'>-- /Lazily/ figure out the univ_tvs etc</span>
<a name="line-242"></a> <span class='hs-comment'>-- Each univ_tv is either a dc_tv or a tmpl_tv</span>
<a name="line-243"></a> <span class='hs-layout'>(</span><span class='hs-varid'>univ_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>eq_spec</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-varid'>choose</span> <span class='hs-layout'>(</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-varid'>tidy_tmpl_tvs</span>
<a name="line-244"></a> <span class='hs-varid'>choose</span> <span class='hs-varid'>tmpl</span> <span class='hs-layout'>(</span><span class='hs-varid'>univs</span><span class='hs-layout'>,</span> <span class='hs-varid'>eqs</span><span class='hs-layout'>)</span>
<a name="line-245"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lookupTyVar</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>tmpl</span>
<a name="line-246"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>tcGetTyVar_maybe</span> <span class='hs-varid'>ty</span> <span class='hs-keyword'>of</span>
<a name="line-247"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>tv</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>tv</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>univs</span><span class='hs-layout'>)</span>
<a name="line-248"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>tv</span><span class='hs-conop'>:</span><span class='hs-varid'>univs</span><span class='hs-layout'>,</span> <span class='hs-varid'>eqs</span><span class='hs-layout'>)</span>
<a name="line-249"></a> <span class='hs-sel'>_other</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>tmpl</span><span class='hs-conop'>:</span><span class='hs-varid'>univs</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>tmpl</span><span class='hs-layout'>,</span><span class='hs-varid'>ty</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>eqs</span><span class='hs-layout'>)</span>
<a name="line-250"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcResultType"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span>
<a name="line-251"></a> <span class='hs-varid'>ex_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dc_tvs</span> <span class='hs-varop'>`minusList`</span> <span class='hs-varid'>univ_tvs</span>
<a name="line-252"></a>
<a name="line-253"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>univ_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ex_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>eq_spec</span><span class='hs-layout'>,</span> <span class='hs-varid'>res_ty'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-254"></a> <span class='hs-keyword'>where</span>
<a name="line-255"></a> <span class='hs-comment'>-- NB: tmpl_tvs and dc_tvs are distinct, but</span>
<a name="line-256"></a> <span class='hs-comment'>-- we want them to be *visibly* distinct, both for</span>
<a name="line-257"></a> <span class='hs-comment'>-- interface files and general confusion. So rename</span>
<a name="line-258"></a> <span class='hs-comment'>-- the tc_tvs, since they are not used yet (no </span>
<a name="line-259"></a> <span class='hs-comment'>-- consequential renaming needed)</span>
<a name="line-260"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>tidy_tmpl_tvs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapAccumL</span> <span class='hs-varid'>tidy_one</span> <span class='hs-varid'>init_occ_env</span> <span class='hs-varid'>tmpl_tvs</span>
<a name="line-261"></a> <span class='hs-varid'>init_occ_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>initTidyOccEnv</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>getOccName</span> <span class='hs-varid'>dc_tvs</span><span class='hs-layout'>)</span>
<a name="line-262"></a> <span class='hs-varid'>tidy_one</span> <span class='hs-varid'>env</span> <span class='hs-varid'>tv</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>env'</span><span class='hs-layout'>,</span> <span class='hs-varid'>setTyVarName</span> <span class='hs-varid'>tv</span> <span class='hs-layout'>(</span><span class='hs-varid'>tidyNameOcc</span> <span class='hs-varid'>name</span> <span class='hs-varid'>occ'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-263"></a> <span class='hs-keyword'>where</span>
<a name="line-264"></a> <span class='hs-varid'>name</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tyVarName</span> <span class='hs-varid'>tv</span>
<a name="line-265"></a> <span class='hs-layout'>(</span><span class='hs-varid'>env'</span><span class='hs-layout'>,</span> <span class='hs-varid'>occ'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tidyOccName</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-varid'>getOccName</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span>
<a name="line-266"></a>
<a name="line-267"></a><a name="consUseH98Syntax"></a><span class='hs-definition'>consUseH98Syntax</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LConDecl</span> <span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-268"></a><span class='hs-definition'>consUseH98Syntax</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'>ConDecl</span> <span class='hs-layout'>{</span> <span class='hs-varid'>con_res</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ResTyGADT</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-269"></a><span class='hs-definition'>consUseH98Syntax</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-270"></a> <span class='hs-comment'>-- All constructors have same shape</span>
<a name="line-271"></a>
<a name="line-272"></a><a name="tcConArg"></a><span class='hs-comment'>-------------------</span>
<a name="line-273"></a><span class='hs-definition'>tcConArg</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- True <=> -funbox-strict_fields</span>
<a name="line-274"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LHsType</span> <span class='hs-conid'>Name</span>
<a name="line-275"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>TcType</span><span class='hs-layout'>,</span> <span class='hs-conid'>StrictnessMark</span><span class='hs-layout'>)</span>
<a name="line-276"></a><span class='hs-definition'>tcConArg</span> <span class='hs-varid'>unbox_strict</span> <span class='hs-varid'>bty</span>
<a name="line-277"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>arg_ty</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcHsBangType</span> <span class='hs-varid'>bty</span>
<a name="line-278"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>bang</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>getBangStrictness</span> <span class='hs-varid'>bty</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'>arg_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>chooseBoxingStrategy</span> <span class='hs-varid'>unbox_strict</span> <span class='hs-varid'>arg_ty</span> <span class='hs-varid'>bang</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-280"></a>
<a name="line-281"></a><a name="chooseBoxingStrategy"></a><span class='hs-comment'>-- We attempt to unbox/unpack a strict field when either:</span>
<a name="line-282"></a><span class='hs-comment'>-- (i) The field is marked '!!', or</span>
<a name="line-283"></a><span class='hs-comment'>-- (ii) The field is marked '!', and the -funbox-strict-fields flag is on.</span>
<a name="line-284"></a><span class='hs-comment'>--</span>
<a name="line-285"></a><span class='hs-comment'>-- We have turned off unboxing of newtypes because coercions make unboxing </span>
<a name="line-286"></a><span class='hs-comment'>-- and reboxing more complicated</span>
<a name="line-287"></a><span class='hs-definition'>chooseBoxingStrategy</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HsBang</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StrictnessMark</span>
<a name="line-288"></a><span class='hs-definition'>chooseBoxingStrategy</span> <span class='hs-varid'>unbox_strict_fields</span> <span class='hs-varid'>arg_ty</span> <span class='hs-varid'>bang</span>
<a name="line-289"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>bang</span> <span class='hs-keyword'>of</span>
<a name="line-290"></a> <span class='hs-conid'>HsNoBang</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NotMarkedStrict</span>
<a name="line-291"></a> <span class='hs-conid'>HsStrict</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>unbox_strict_fields</span>
<a name="line-292"></a> <span class='hs-varop'>&&</span> <span class='hs-varid'>can_unbox</span> <span class='hs-varid'>arg_ty</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MarkedUnboxed</span>
<a name="line-293"></a> <span class='hs-conid'>HsUnbox</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>can_unbox</span> <span class='hs-varid'>arg_ty</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MarkedUnboxed</span>
<a name="line-294"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MarkedStrict</span>
<a name="line-295"></a> <span class='hs-keyword'>where</span>
<a name="line-296"></a> <span class='hs-comment'>-- we can unbox if the type is a chain of newtypes with a product tycon</span>
<a name="line-297"></a> <span class='hs-comment'>-- at the end</span>
<a name="line-298"></a> <span class='hs-varid'>can_unbox</span> <span class='hs-varid'>arg_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>splitTyConApp_maybe</span> <span class='hs-varid'>arg_ty</span> <span class='hs-keyword'>of</span>
<a name="line-299"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>False</span>
<a name="line-300"></a> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>arg_tycon</span><span class='hs-layout'>,</span> <span class='hs-varid'>tycon_args</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-301"></a> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isRecursiveTyCon</span> <span class='hs-varid'>arg_tycon</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span> <span class='hs-comment'>-- Note [Recusive unboxing]</span>
<a name="line-302"></a> <span class='hs-varid'>isProductTyCon</span> <span class='hs-varid'>arg_tycon</span> <span class='hs-varop'>&&</span>
<a name="line-303"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>isNewTyCon</span> <span class='hs-varid'>arg_tycon</span> <span class='hs-keyword'>then</span>
<a name="line-304"></a> <span class='hs-varid'>can_unbox</span> <span class='hs-layout'>(</span><span class='hs-varid'>newTyConInstRhs</span> <span class='hs-varid'>arg_tycon</span> <span class='hs-varid'>tycon_args</span><span class='hs-layout'>)</span>
<a name="line-305"></a> <span class='hs-keyword'>else</span> <span class='hs-conid'>True</span><span class='hs-layout'>)</span>
</pre>\end{code}
Note [Recursive unboxing]
~~~~~~~~~~~~~~~~~~~~~~~~~
Be careful not to try to unbox this!
data T = MkT !T Int
But it's the *argument* type that matters. This is fine:
data S = MkS S !Int
because Int is non-recursive.
%************************************************************************
%* *
Validity checking
%* *
%************************************************************************
Validity checking is done once the mutually-recursive knot has been
tied, so we can look at things freely.
\begin{code}
<pre><a name="line-1"></a><a name="checkCycleErrs"></a><span class='hs-definition'>checkCycleErrs</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LTyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</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'>checkCycleErrs</span> <span class='hs-varid'>tyclss</span>
<a name="line-3"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>null</span> <span class='hs-varid'>cls_cycles</span>
<a name="line-4"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-5"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-6"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>mapM_</span> <span class='hs-varid'>recClsErr</span> <span class='hs-varid'>cls_cycles</span>
<a name="line-7"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>failM</span> <span class='hs-layout'>}</span> <span class='hs-comment'>-- Give up now, because later checkValidTyCl</span>
<a name="line-8"></a> <span class='hs-comment'>-- will loop if the synonym is recursive</span>
<a name="line-9"></a> <span class='hs-keyword'>where</span>
<a name="line-10"></a> <span class='hs-varid'>cls_cycles</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>calcClassCycles</span> <span class='hs-varid'>tyclss</span>
<a name="line-11"></a>
<a name="line-12"></a><a name="checkValidTyCl"></a><span class='hs-definition'>checkValidTyCl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyClDecl</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-13"></a><span class='hs-comment'>-- We do the validity check over declarations, rather than TyThings</span>
<a name="line-14"></a><span class='hs-comment'>-- only so that we can add a nice context with tcAddDeclCtxt</span>
<a name="line-15"></a><span class='hs-definition'>checkValidTyCl</span> <span class='hs-varid'>decl</span>
<a name="line-16"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcAddDeclCtxt</span> <span class='hs-varid'>decl</span> <span class='hs-varop'>$</span>
<a name="line-17"></a> <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'>tcLookupLocatedGlobal</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcdLName</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span>
<a name="line-18"></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'>"Validity of"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span>
<a name="line-19"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>thing</span> <span class='hs-keyword'>of</span>
<a name="line-20"></a> <span class='hs-conid'>ATyCon</span> <span class='hs-varid'>tc</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>checkValidTyCon</span> <span class='hs-varid'>tc</span>
<a name="line-21"></a> <span class='hs-conid'>AClass</span> <span class='hs-varid'>cl</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>checkValidClass</span> <span class='hs-varid'>cl</span>
<a name="line-22"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>panic</span> <span class='hs-str'>"checkValidTyCl"</span>
<a name="line-23"></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'>"Done validity of"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span>
<a name="line-24"></a> <span class='hs-layout'>}</span>
<a name="line-25"></a>
<a name="line-26"></a><span class='hs-comment'>-------------------------</span>
<a name="line-27"></a><span class='hs-comment'>-- For data types declared with record syntax, we require</span>
<a name="line-28"></a><span class='hs-comment'>-- that each constructor that has a field 'f' </span>
<a name="line-29"></a><span class='hs-comment'>-- (a) has the same result type</span>
<a name="line-30"></a><span class='hs-comment'>-- (b) has the same type for 'f'</span>
<a name="line-31"></a><span class='hs-comment'>-- module alpha conversion of the quantified type variables</span>
<a name="line-32"></a><span class='hs-comment'>-- of the constructor.</span>
<a name="line-33"></a><span class='hs-comment'>--</span>
<a name="line-34"></a><span class='hs-comment'>-- Note that we allow existentials to match becuase the</span>
<a name="line-35"></a><span class='hs-comment'>-- fields can never meet. E.g</span>
<a name="line-36"></a><span class='hs-comment'>-- data T where</span>
<a name="line-37"></a><span class='hs-comment'>-- T1 { f1 :: b, f2 :: a, f3 ::Int } :: T</span>
<a name="line-38"></a><span class='hs-comment'>-- T2 { f1 :: c, f2 :: c, f3 ::Int } :: T </span>
<a name="line-39"></a><span class='hs-comment'>-- Here we do not complain about f1,f2 because they are existential</span>
<a name="line-40"></a>
<a name="line-41"></a><a name="checkValidTyCon"></a><span class='hs-definition'>checkValidTyCon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-42"></a><span class='hs-definition'>checkValidTyCon</span> <span class='hs-varid'>tc</span>
<a name="line-43"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isSynTyCon</span> <span class='hs-varid'>tc</span>
<a name="line-44"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>synTyConRhs</span> <span class='hs-varid'>tc</span> <span class='hs-keyword'>of</span>
<a name="line-45"></a> <span class='hs-conid'>OpenSynTyCon</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-46"></a> <span class='hs-conid'>SynonymTyCon</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>checkValidType</span> <span class='hs-varid'>syn_ctxt</span> <span class='hs-varid'>ty</span>
<a name="line-47"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-48"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-comment'>-- Check the context on the data decl</span>
<a name="line-49"></a> <span class='hs-varid'>checkValidTheta</span> <span class='hs-layout'>(</span><span class='hs-conid'>DataTyCtxt</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConStupidTheta</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
<a name="line-50"></a>
<a name="line-51"></a> <span class='hs-comment'>-- Check arg types of data constructors</span>
<a name="line-52"></a> <span class='hs-varid'>mapM_</span> <span class='hs-layout'>(</span><span class='hs-varid'>checkValidDataCon</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span> <span class='hs-varid'>data_cons</span>
<a name="line-53"></a>
<a name="line-54"></a> <span class='hs-comment'>-- Check that fields with the same name share a type</span>
<a name="line-55"></a> <span class='hs-varid'>mapM_</span> <span class='hs-varid'>check_fields</span> <span class='hs-varid'>groups</span>
<a name="line-56"></a>
<a name="line-57"></a> <span class='hs-keyword'>where</span>
<a name="line-58"></a> <span class='hs-varid'>syn_ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>TySynCtxt</span> <span class='hs-varid'>name</span>
<a name="line-59"></a> <span class='hs-varid'>name</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tyConName</span> <span class='hs-varid'>tc</span>
<a name="line-60"></a> <span class='hs-varid'>data_cons</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tyConDataCons</span> <span class='hs-varid'>tc</span>
<a name="line-61"></a>
<a name="line-62"></a> <span class='hs-varid'>groups</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>equivClasses</span> <span class='hs-varid'>cmp_fld</span> <span class='hs-layout'>(</span><span class='hs-varid'>concatMap</span> <span class='hs-varid'>get_fields</span> <span class='hs-varid'>data_cons</span><span class='hs-layout'>)</span>
<a name="line-63"></a> <span class='hs-varid'>cmp_fld</span> <span class='hs-layout'>(</span><span class='hs-varid'>f1</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>f2</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>f1</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>f2</span>
<a name="line-64"></a> <span class='hs-varid'>get_fields</span> <span class='hs-varid'>con</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConFieldLabels</span> <span class='hs-varid'>con</span> <span class='hs-varop'>`zip`</span> <span class='hs-varid'>repeat</span> <span class='hs-varid'>con</span>
<a name="line-65"></a> <span class='hs-comment'>-- dataConFieldLabels may return the empty list, which is fine</span>
<a name="line-66"></a>
<a name="line-67"></a> <span class='hs-comment'>-- See Note [GADT record selectors] in MkId.lhs</span>
<a name="line-68"></a> <span class='hs-comment'>-- We must check (a) that the named field has the same </span>
<a name="line-69"></a> <span class='hs-comment'>-- type in each constructor</span>
<a name="line-70"></a> <span class='hs-comment'>-- (b) that those constructors have the same result type</span>
<a name="line-71"></a> <span class='hs-comment'>--</span>
<a name="line-72"></a> <span class='hs-comment'>-- However, the constructors may have differently named type variable</span>
<a name="line-73"></a> <span class='hs-comment'>-- and (worse) we don't know how the correspond to each other. E.g.</span>
<a name="line-74"></a> <span class='hs-comment'>-- C1 :: forall a b. { f :: a, g :: b } -> T a b</span>
<a name="line-75"></a> <span class='hs-comment'>-- C2 :: forall d c. { f :: c, g :: c } -> T c d</span>
<a name="line-76"></a> <span class='hs-comment'>-- </span>
<a name="line-77"></a> <span class='hs-comment'>-- So what we do is to ust Unify.tcMatchTys to compare the first candidate's</span>
<a name="line-78"></a> <span class='hs-comment'>-- result type against other candidates' types BOTH WAYS ROUND.</span>
<a name="line-79"></a> <span class='hs-comment'>-- If they magically agrees, take the substitution and</span>
<a name="line-80"></a> <span class='hs-comment'>-- apply them to the latter ones, and see if they match perfectly.</span>
<a name="line-81"></a> <span class='hs-varid'>check_fields</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>label</span><span class='hs-layout'>,</span> <span class='hs-varid'>con1</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>other_fields</span><span class='hs-layout'>)</span>
<a name="line-82"></a> <span class='hs-comment'>-- These fields all have the same name, but are from</span>
<a name="line-83"></a> <span class='hs-comment'>-- different constructors in the data type</span>
<a name="line-84"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>recoverM</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mapM_</span> <span class='hs-varid'>checkOne</span> <span class='hs-varid'>other_fields</span>
<a name="line-85"></a> <span class='hs-comment'>-- Check that all the fields in the group have the same type</span>
<a name="line-86"></a> <span class='hs-comment'>-- NB: this check assumes that all the constructors of a given</span>
<a name="line-87"></a> <span class='hs-comment'>-- data type use the same type variables</span>
<a name="line-88"></a> <span class='hs-keyword'>where</span>
<a name="line-89"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tvs1</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>res1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConSig</span> <span class='hs-varid'>con1</span>
<a name="line-90"></a> <span class='hs-varid'>ts1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVarSet</span> <span class='hs-varid'>tvs1</span>
<a name="line-91"></a> <span class='hs-varid'>fty1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConFieldType</span> <span class='hs-varid'>con1</span> <span class='hs-varid'>label</span>
<a name="line-92"></a>
<a name="line-93"></a> <span class='hs-varid'>checkOne</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>con2</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Do it bothways to ensure they are structurally identical</span>
<a name="line-94"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>checkFieldCompat</span> <span class='hs-varid'>label</span> <span class='hs-varid'>con1</span> <span class='hs-varid'>con2</span> <span class='hs-varid'>ts1</span> <span class='hs-varid'>res1</span> <span class='hs-varid'>res2</span> <span class='hs-varid'>fty1</span> <span class='hs-varid'>fty2</span>
<a name="line-95"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkFieldCompat</span> <span class='hs-varid'>label</span> <span class='hs-varid'>con2</span> <span class='hs-varid'>con1</span> <span class='hs-varid'>ts2</span> <span class='hs-varid'>res2</span> <span class='hs-varid'>res1</span> <span class='hs-varid'>fty2</span> <span class='hs-varid'>fty1</span> <span class='hs-layout'>}</span>
<a name="line-96"></a> <span class='hs-keyword'>where</span>
<a name="line-97"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tvs2</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>res2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConSig</span> <span class='hs-varid'>con2</span>
<a name="line-98"></a> <span class='hs-varid'>ts2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVarSet</span> <span class='hs-varid'>tvs2</span>
<a name="line-99"></a> <span class='hs-varid'>fty2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConFieldType</span> <span class='hs-varid'>con2</span> <span class='hs-varid'>label</span>
<a name="line-100"></a> <span class='hs-varid'>check_fields</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"checkValidTyCon/check_fields []"</span>
<a name="line-101"></a>
<a name="line-102"></a><a name="checkFieldCompat"></a><span class='hs-definition'>checkFieldCompat</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TyVarSet</span>
<a name="line-103"></a> <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'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-104"></a><span class='hs-definition'>checkFieldCompat</span> <span class='hs-varid'>fld</span> <span class='hs-varid'>con1</span> <span class='hs-varid'>con2</span> <span class='hs-varid'>tvs1</span> <span class='hs-varid'>res1</span> <span class='hs-varid'>res2</span> <span class='hs-varid'>fty1</span> <span class='hs-varid'>fty2</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-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>isJust</span> <span class='hs-varid'>mb_subst1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>resultTypeMisMatch</span> <span class='hs-varid'>fld</span> <span class='hs-varid'>con1</span> <span class='hs-varid'>con2</span><span class='hs-layout'>)</span>
<a name="line-106"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>isJust</span> <span class='hs-varid'>mb_subst2</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>fieldTypeMisMatch</span> <span class='hs-varid'>fld</span> <span class='hs-varid'>con1</span> <span class='hs-varid'>con2</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-107"></a> <span class='hs-keyword'>where</span>
<a name="line-108"></a> <span class='hs-varid'>mb_subst1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcMatchTy</span> <span class='hs-varid'>tvs1</span> <span class='hs-varid'>res1</span> <span class='hs-varid'>res2</span>
<a name="line-109"></a> <span class='hs-varid'>mb_subst2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcMatchTyX</span> <span class='hs-varid'>tvs1</span> <span class='hs-layout'>(</span><span class='hs-varid'>expectJust</span> <span class='hs-str'>"checkFieldCompat"</span> <span class='hs-varid'>mb_subst1</span><span class='hs-layout'>)</span> <span class='hs-varid'>fty1</span> <span class='hs-varid'>fty2</span>
<a name="line-110"></a>
<a name="line-111"></a><a name="checkValidDataCon"></a><span class='hs-comment'>-------------------------------</span>
<a name="line-112"></a><span class='hs-definition'>checkValidDataCon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-113"></a><span class='hs-definition'>checkValidDataCon</span> <span class='hs-varid'>tc</span> <span class='hs-varid'>con</span>
<a name="line-114"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>setSrcSpan</span> <span class='hs-layout'>(</span><span class='hs-varid'>srcLocSpan</span> <span class='hs-layout'>(</span><span class='hs-varid'>getSrcLoc</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-115"></a> <span class='hs-varid'>addErrCtxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConCtxt</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-116"></a> <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'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Validity of data con"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span>
<a name="line-117"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>tc_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tyConTyVars</span> <span class='hs-varid'>tc</span>
<a name="line-118"></a> <span class='hs-varid'>res_ty_tmpl</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkFamilyTyConApp</span> <span class='hs-varid'>tc</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkTyVarTys</span> <span class='hs-varid'>tc_tvs</span><span class='hs-layout'>)</span>
<a name="line-119"></a> <span class='hs-varid'>actual_res_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConOrigResTy</span> <span class='hs-varid'>con</span>
<a name="line-120"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>isJust</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcMatchTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkVarSet</span> <span class='hs-varid'>tc_tvs</span><span class='hs-layout'>)</span>
<a name="line-121"></a> <span class='hs-varid'>res_ty_tmpl</span>
<a name="line-122"></a> <span class='hs-varid'>actual_res_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-123"></a> <span class='hs-layout'>(</span><span class='hs-varid'>badDataConTyCon</span> <span class='hs-varid'>con</span> <span class='hs-varid'>res_ty_tmpl</span> <span class='hs-varid'>actual_res_ty</span><span class='hs-layout'>)</span>
<a name="line-124"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkValidMonoType</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConOrigResTy</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span>
<a name="line-125"></a> <span class='hs-comment'>-- Disallow MkT :: T (forall a. a->a)</span>
<a name="line-126"></a> <span class='hs-comment'>-- Reason: it's really the argument of an equality constraint</span>
<a name="line-127"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkValidType</span> <span class='hs-varid'>ctxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConUserType</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span>
<a name="line-128"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>when</span> <span class='hs-layout'>(</span><span class='hs-varid'>isNewTyCon</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>checkNewDataCon</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span>
<a name="line-129"></a> <span class='hs-layout'>}</span>
<a name="line-130"></a> <span class='hs-keyword'>where</span>
<a name="line-131"></a> <span class='hs-varid'>ctxt</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ConArgCtxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConName</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span>
<a name="line-132"></a>
<a name="line-133"></a><a name="checkNewDataCon"></a><span class='hs-comment'>-------------------------------</span>
<a name="line-134"></a><span class='hs-definition'>checkNewDataCon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-135"></a><span class='hs-comment'>-- Checks for the data constructor of a newtype</span>
<a name="line-136"></a><span class='hs-definition'>checkNewDataCon</span> <span class='hs-varid'>con</span>
<a name="line-137"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>isSingleton</span> <span class='hs-varid'>arg_tys</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>newtypeFieldErr</span> <span class='hs-varid'>con</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>arg_tys</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-138"></a> <span class='hs-comment'>-- One argument</span>
<a name="line-139"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>eq_spec</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>newtypePredError</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span>
<a name="line-140"></a> <span class='hs-comment'>-- Return type is (T a b c)</span>
<a name="line-141"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>ex_tvs</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>null</span> <span class='hs-varid'>eq_theta</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>null</span> <span class='hs-varid'>dict_theta</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>newtypeExError</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span>
<a name="line-142"></a> <span class='hs-comment'>-- No existentials</span>
<a name="line-143"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>any</span> <span class='hs-varid'>isMarkedStrict</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConStrictMarks</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-144"></a> <span class='hs-layout'>(</span><span class='hs-varid'>newtypeStrictError</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span>
<a name="line-145"></a> <span class='hs-comment'>-- No strictness</span>
<a name="line-146"></a> <span class='hs-layout'>}</span>
<a name="line-147"></a> <span class='hs-keyword'>where</span>
<a name="line-148"></a> <span class='hs-layout'>(</span><span class='hs-sel'>_univ_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ex_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>eq_spec</span><span class='hs-layout'>,</span> <span class='hs-varid'>eq_theta</span><span class='hs-layout'>,</span> <span class='hs-varid'>dict_theta</span><span class='hs-layout'>,</span> <span class='hs-varid'>arg_tys</span><span class='hs-layout'>,</span> <span class='hs-sel'>_res_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConFullSig</span> <span class='hs-varid'>con</span>
<a name="line-149"></a>
<a name="line-150"></a><a name="checkValidClass"></a><span class='hs-comment'>-------------------------------</span>
<a name="line-151"></a><span class='hs-definition'>checkValidClass</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Class</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-152"></a><span class='hs-definition'>checkValidClass</span> <span class='hs-varid'>cls</span>
<a name="line-153"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>constrained_class_methods</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_ConstrainedClassMethods</span>
<a name="line-154"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>multi_param_type_classes</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_MultiParamTypeClasses</span>
<a name="line-155"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>fundep_classes</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doptM</span> <span class='hs-conid'>Opt_FunctionalDependencies</span>
<a name="line-156"></a>
<a name="line-157"></a> <span class='hs-comment'>-- Check that the class is unary, unless GlaExs</span>
<a name="line-158"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>notNull</span> <span class='hs-varid'>tyvars</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>nullaryClassErr</span> <span class='hs-varid'>cls</span><span class='hs-layout'>)</span>
<a name="line-159"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>multi_param_type_classes</span> <span class='hs-varop'>||</span> <span class='hs-varid'>unary</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>classArityErr</span> <span class='hs-varid'>cls</span><span class='hs-layout'>)</span>
<a name="line-160"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>fundep_classes</span> <span class='hs-varop'>||</span> <span class='hs-varid'>null</span> <span class='hs-varid'>fundeps</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>classFunDepsErr</span> <span class='hs-varid'>cls</span><span class='hs-layout'>)</span>
<a name="line-161"></a>
<a name="line-162"></a> <span class='hs-comment'>-- Check the super-classes</span>
<a name="line-163"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkValidTheta</span> <span class='hs-layout'>(</span><span class='hs-conid'>ClassSCCtxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>className</span> <span class='hs-varid'>cls</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>theta</span>
<a name="line-164"></a>
<a name="line-165"></a> <span class='hs-comment'>-- Check the class operations</span>
<a name="line-166"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>mapM_</span> <span class='hs-layout'>(</span><span class='hs-varid'>check_op</span> <span class='hs-varid'>constrained_class_methods</span><span class='hs-layout'>)</span> <span class='hs-varid'>op_stuff</span>
<a name="line-167"></a>
<a name="line-168"></a> <span class='hs-comment'>-- Check that if the class has generic methods, then the</span>
<a name="line-169"></a> <span class='hs-comment'>-- class has only one parameter. We can't do generic</span>
<a name="line-170"></a> <span class='hs-comment'>-- multi-parameter type classes!</span>
<a name="line-171"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>unary</span> <span class='hs-varop'>||</span> <span class='hs-varid'>no_generics</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>genericMultiParamErr</span> <span class='hs-varid'>cls</span><span class='hs-layout'>)</span>
<a name="line-172"></a> <span class='hs-layout'>}</span>
<a name="line-173"></a> <span class='hs-keyword'>where</span>
<a name="line-174"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tyvars</span><span class='hs-layout'>,</span> <span class='hs-varid'>fundeps</span><span class='hs-layout'>,</span> <span class='hs-varid'>theta</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>op_stuff</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>classExtraBigSig</span> <span class='hs-varid'>cls</span>
<a name="line-175"></a> <span class='hs-varid'>unary</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isSingleton</span> <span class='hs-varid'>tyvars</span>
<a name="line-176"></a> <span class='hs-varid'>no_generics</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>null</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>()</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-conid'>GenDefMeth</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>op_stuff</span><span class='hs-keyglyph'>]</span>
<a name="line-177"></a>
<a name="line-178"></a> <span class='hs-varid'>check_op</span> <span class='hs-varid'>constrained_class_methods</span> <span class='hs-layout'>(</span><span class='hs-varid'>sel_id</span><span class='hs-layout'>,</span> <span class='hs-varid'>dm</span><span class='hs-layout'>)</span>
<a name="line-179"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addErrCtxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>classOpCtxt</span> <span class='hs-varid'>sel_id</span> <span class='hs-varid'>tau</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-180"></a> <span class='hs-layout'>{</span> <span class='hs-varid'>checkValidTheta</span> <span class='hs-conid'>SigmaCtxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>tail</span> <span class='hs-varid'>theta</span><span class='hs-layout'>)</span>
<a name="line-181"></a> <span class='hs-comment'>-- The 'tail' removes the initial (C a) from the</span>
<a name="line-182"></a> <span class='hs-comment'>-- class itself, leaving just the method type</span>
<a name="line-183"></a>
<a name="line-184"></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'>"class op type"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>op_ty</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tau</span><span class='hs-layout'>)</span>
<a name="line-185"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkValidType</span> <span class='hs-layout'>(</span><span class='hs-conid'>FunSigCtxt</span> <span class='hs-varid'>op_name</span><span class='hs-layout'>)</span> <span class='hs-varid'>tau</span>
<a name="line-186"></a>
<a name="line-187"></a> <span class='hs-comment'>-- Check that the type mentions at least one of</span>
<a name="line-188"></a> <span class='hs-comment'>-- the class type variables...or at least one reachable</span>
<a name="line-189"></a> <span class='hs-comment'>-- from one of the class variables. Example: tc223</span>
<a name="line-190"></a> <span class='hs-comment'>-- class Error e => Game b mv e | b -> mv e where</span>
<a name="line-191"></a> <span class='hs-comment'>-- newBoard :: MonadState b m => m ()</span>
<a name="line-192"></a> <span class='hs-comment'>-- Here, MonadState has a fundep m->b, so newBoard is fine</span>
<a name="line-193"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>grown_tyvars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>growThetaTyVars</span> <span class='hs-varid'>theta</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkVarSet</span> <span class='hs-varid'>tyvars</span><span class='hs-layout'>)</span>
<a name="line-194"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyVarsOfType</span> <span class='hs-varid'>tau</span> <span class='hs-varop'>`intersectsVarSet`</span> <span class='hs-varid'>grown_tyvars</span><span class='hs-layout'>)</span>
<a name="line-195"></a> <span class='hs-layout'>(</span><span class='hs-varid'>noClassTyVarErr</span> <span class='hs-varid'>cls</span> <span class='hs-varid'>sel_id</span><span class='hs-layout'>)</span>
<a name="line-196"></a>
<a name="line-197"></a> <span class='hs-comment'>-- Check that for a generic method, the type of </span>
<a name="line-198"></a> <span class='hs-comment'>-- the method is sufficiently simple</span>
<a name="line-199"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>dm</span> <span class='hs-varop'>/=</span> <span class='hs-conid'>GenDefMeth</span> <span class='hs-varop'>||</span> <span class='hs-varid'>validGenericMethodType</span> <span class='hs-varid'>tau</span><span class='hs-layout'>)</span>
<a name="line-200"></a> <span class='hs-layout'>(</span><span class='hs-varid'>badGenericMethodType</span> <span class='hs-varid'>op_name</span> <span class='hs-varid'>op_ty</span><span class='hs-layout'>)</span>
<a name="line-201"></a> <span class='hs-layout'>}</span>
<a name="line-202"></a> <span class='hs-keyword'>where</span>
<a name="line-203"></a> <span class='hs-varid'>op_name</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>idName</span> <span class='hs-varid'>sel_id</span>
<a name="line-204"></a> <span class='hs-varid'>op_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>sel_id</span>
<a name="line-205"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>theta1</span><span class='hs-layout'>,</span><span class='hs-varid'>tau1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcSplitSigmaTy</span> <span class='hs-varid'>op_ty</span>
<a name="line-206"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>theta2</span><span class='hs-layout'>,</span><span class='hs-varid'>tau2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcSplitSigmaTy</span> <span class='hs-varid'>tau1</span>
<a name="line-207"></a> <span class='hs-layout'>(</span><span class='hs-varid'>theta</span><span class='hs-layout'>,</span><span class='hs-varid'>tau</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>constrained_class_methods</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>theta1</span> <span class='hs-varop'>++</span> <span class='hs-varid'>theta2</span><span class='hs-layout'>,</span> <span class='hs-varid'>tau2</span><span class='hs-layout'>)</span>
<a name="line-208"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>theta1</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkPhiTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>tail</span> <span class='hs-varid'>theta1</span><span class='hs-layout'>)</span> <span class='hs-varid'>tau1</span><span class='hs-layout'>)</span>
<a name="line-209"></a> <span class='hs-comment'>-- Ugh! The function might have a type like</span>
<a name="line-210"></a> <span class='hs-comment'>-- op :: forall a. C a => forall b. (Eq b, Eq a) => tau2</span>
<a name="line-211"></a> <span class='hs-comment'>-- With -XConstrainedClassMethods, we want to allow this, even though the inner </span>
<a name="line-212"></a> <span class='hs-comment'>-- forall has an (Eq a) constraint. Whereas in general, each constraint </span>
<a name="line-213"></a> <span class='hs-comment'>-- in the context of a for-all must mention at least one quantified</span>
<a name="line-214"></a> <span class='hs-comment'>-- type variable. What a mess!</span>
</pre>\end{code}
%************************************************************************
%* *
Building record selectors
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="mkAuxBinds"></a><span class='hs-definition'>mkAuxBinds</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyThing</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HsValBinds</span> <span class='hs-conid'>Name</span>
<a name="line-2"></a><span class='hs-comment'>-- NB We produce *un-typechecked* bindings, rather like 'deriving'</span>
<a name="line-3"></a><span class='hs-comment'>-- This makes life easier, because the later type checking will add</span>
<a name="line-4"></a><span class='hs-comment'>-- all necessary type abstractions and applications</span>
<a name="line-5"></a><span class='hs-definition'>mkAuxBinds</span> <span class='hs-varid'>ty_things</span>
<a name="line-6"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ValBindsOut</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>NonRecursive</span><span class='hs-layout'>,</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>binds</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>sigs</span>
<a name="line-7"></a> <span class='hs-keyword'>where</span>
<a name="line-8"></a> <span class='hs-layout'>(</span><span class='hs-varid'>sigs</span><span class='hs-layout'>,</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unzip</span> <span class='hs-varid'>rec_sels</span>
<a name="line-9"></a> <span class='hs-varid'>rec_sels</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>mkRecSelBind</span> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-varid'>tc</span><span class='hs-layout'>,</span><span class='hs-varid'>fld</span><span class='hs-layout'>)</span>
<a name="line-10"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>ATyCon</span> <span class='hs-varid'>tc</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ty_things</span>
<a name="line-11"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>fld</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tyConFields</span> <span class='hs-varid'>tc</span> <span class='hs-keyglyph'>]</span>
<a name="line-12"></a>
<a name="line-13"></a><a name="mkRecSelBind"></a><span class='hs-definition'>mkRecSelBind</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>TyCon</span><span class='hs-layout'>,</span> <span class='hs-conid'>FieldLabel</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>LSig</span> <span class='hs-conid'>Name</span><span class='hs-layout'>,</span> <span class='hs-conid'>LHsBinds</span> <span class='hs-conid'>Name</span><span class='hs-layout'>)</span>
<a name="line-14"></a><span class='hs-definition'>mkRecSelBind</span> <span class='hs-layout'>(</span><span class='hs-varid'>tycon</span><span class='hs-layout'>,</span> <span class='hs-varid'>sel_name</span><span class='hs-layout'>)</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=</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'>IdSig</span> <span class='hs-varid'>sel_id</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>unitBag</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>sel_bind</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-keyword'>where</span>
<a name="line-17"></a> <span class='hs-varid'>loc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>getSrcSpan</span> <span class='hs-varid'>tycon</span>
<a name="line-18"></a> <span class='hs-varid'>sel_id</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Var</span><span class='hs-varop'>.</span><span class='hs-varid'>mkLocalVar</span> <span class='hs-varid'>rec_details</span> <span class='hs-varid'>sel_name</span> <span class='hs-varid'>sel_ty</span> <span class='hs-varid'>vanillaIdInfo</span>
<a name="line-19"></a> <span class='hs-varid'>rec_details</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RecSelId</span> <span class='hs-layout'>{</span> <span class='hs-varid'>sel_tycon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tycon</span><span class='hs-layout'>,</span> <span class='hs-varid'>sel_naughty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>is_naughty</span> <span class='hs-layout'>}</span>
<a name="line-20"></a>
<a name="line-21"></a> <span class='hs-comment'>-- Find a representative constructor, con1</span>
<a name="line-22"></a> <span class='hs-varid'>all_cons</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tyConDataCons</span> <span class='hs-varid'>tycon</span>
<a name="line-23"></a> <span class='hs-varid'>cons_w_field</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>con</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>con</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>all_cons</span>
<a name="line-24"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>sel_name</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>dataConFieldLabels</span> <span class='hs-varid'>con</span> <span class='hs-keyglyph'>]</span>
<a name="line-25"></a> <span class='hs-varid'>con1</span> <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'>cons_w_field</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span> <span class='hs-varid'>head</span> <span class='hs-varid'>cons_w_field</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-comment'>-- Selector type; Note [Polymorphic selectors]</span>
<a name="line-28"></a> <span class='hs-varid'>field_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConFieldType</span> <span class='hs-varid'>con1</span> <span class='hs-varid'>sel_name</span>
<a name="line-29"></a> <span class='hs-varid'>data_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConOrigResTy</span> <span class='hs-varid'>con1</span>
<a name="line-30"></a> <span class='hs-varid'>data_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tyVarsOfType</span> <span class='hs-varid'>data_ty</span>
<a name="line-31"></a> <span class='hs-varid'>is_naughty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyVarsOfType</span> <span class='hs-varid'>field_ty</span> <span class='hs-varop'>`subVarSet`</span> <span class='hs-varid'>data_tvs</span><span class='hs-layout'>)</span>
<a name="line-32"></a> <span class='hs-layout'>(</span><span class='hs-varid'>field_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>field_theta</span><span class='hs-layout'>,</span> <span class='hs-varid'>field_tau</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcSplitSigmaTy</span> <span class='hs-varid'>field_ty</span>
<a name="line-33"></a> <span class='hs-varid'>sel_ty</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>is_naughty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unitTy</span> <span class='hs-comment'>-- See Note [Naughty record selectors]</span>
<a name="line-34"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkForAllTys</span> <span class='hs-layout'>(</span><span class='hs-varid'>varSetElems</span> <span class='hs-varid'>data_tvs</span> <span class='hs-varop'>++</span> <span class='hs-varid'>field_tvs</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-35"></a> <span class='hs-varid'>mkPhiTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConStupidTheta</span> <span class='hs-varid'>con1</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-comment'>-- Urgh!</span>
<a name="line-36"></a> <span class='hs-varid'>mkPhiTy</span> <span class='hs-varid'>field_theta</span> <span class='hs-varop'>$</span> <span class='hs-comment'>-- Urgh!</span>
<a name="line-37"></a> <span class='hs-varid'>mkFunTy</span> <span class='hs-varid'>data_ty</span> <span class='hs-varid'>field_tau</span>
<a name="line-38"></a>
<a name="line-39"></a> <span class='hs-comment'>-- Make the binding: sel (C2 { fld = x }) = x</span>
<a name="line-40"></a> <span class='hs-comment'>-- sel (C7 { fld = x }) = x</span>
<a name="line-41"></a> <span class='hs-comment'>-- where cons_w_field = [C2,C7]</span>
<a name="line-42"></a> <span class='hs-varid'>sel_bind</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>is_naughty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkFunBind</span> <span class='hs-varid'>sel_lname</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mkSimpleMatch</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>unit_rhs</span><span class='hs-keyglyph'>]</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'>mkFunBind</span> <span class='hs-varid'>sel_lname</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>mk_match</span> <span class='hs-varid'>cons_w_field</span> <span class='hs-varop'>++</span> <span class='hs-varid'>deflt</span><span class='hs-layout'>)</span>
<a name="line-44"></a> <span class='hs-varid'>mk_match</span> <span class='hs-varid'>con</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkSimpleMatch</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-layout'>(</span><span class='hs-varid'>mk_sel_pat</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-45"></a> <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'>HsVar</span> <span class='hs-varid'>field_var</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-46"></a> <span class='hs-varid'>mk_sel_pat</span> <span class='hs-varid'>con</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ConPatIn</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-varid'>getName</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>RecCon</span> <span class='hs-varid'>rec_fields</span><span class='hs-layout'>)</span>
<a name="line-47"></a> <span class='hs-varid'>rec_fields</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>HsRecFields</span> <span class='hs-layout'>{</span> <span class='hs-varid'>rec_flds</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>rec_field</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-varid'>rec_dotdot</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span> <span class='hs-layout'>}</span>
<a name="line-48"></a> <span class='hs-varid'>rec_field</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>HsRecField</span> <span class='hs-layout'>{</span> <span class='hs-varid'>hsRecFieldId</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sel_lname</span>
<a name="line-49"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>hsRecFieldArg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nlVarPat</span> <span class='hs-varid'>field_var</span>
<a name="line-50"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>hsRecPun</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> <span class='hs-layout'>}</span>
<a name="line-51"></a> <span class='hs-varid'>sel_lname</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>sel_name</span>
<a name="line-52"></a> <span class='hs-varid'>field_var</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkInternalName</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-layout'>(</span><span class='hs-varid'>getOccName</span> <span class='hs-varid'>sel_name</span><span class='hs-layout'>)</span> <span class='hs-varid'>loc</span>
<a name="line-53"></a>
<a name="line-54"></a> <span class='hs-comment'>-- Add catch-all default case unless the case is exhaustive</span>
<a name="line-55"></a> <span class='hs-comment'>-- We do this explicitly so that we get a nice error message that</span>
<a name="line-56"></a> <span class='hs-comment'>-- mentions this particular record selector</span>
<a name="line-57"></a> <span class='hs-varid'>deflt</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>any</span> <span class='hs-varid'>is_unused</span> <span class='hs-varid'>all_cons</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-58"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mkSimpleMatch</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>nlWildPat</span><span class='hs-keyglyph'>]</span>
<a name="line-59"></a> <span class='hs-layout'>(</span><span class='hs-varid'>nlHsApp</span> <span class='hs-layout'>(</span><span class='hs-varid'>nlHsVar</span> <span class='hs-layout'>(</span><span class='hs-varid'>getName</span> <span class='hs-varid'>rEC_SEL_ERROR_ID</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-60"></a> <span class='hs-layout'>(</span><span class='hs-varid'>nlHsLit</span> <span class='hs-varid'>msg_lit</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-61"></a>
<a name="line-62"></a> <span class='hs-comment'>-- Do not add a default case unless there are unmatched</span>
<a name="line-63"></a> <span class='hs-comment'>-- constructors. We must take account of GADTs, else we</span>
<a name="line-64"></a> <span class='hs-comment'>-- get overlap warning messages from the pattern-match checker</span>
<a name="line-65"></a> <span class='hs-varid'>is_unused</span> <span class='hs-varid'>con</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>con</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>cons_w_field</span>
<a name="line-66"></a> <span class='hs-varop'>||</span> <span class='hs-varid'>dataConCannotMatch</span> <span class='hs-varid'>inst_tys</span> <span class='hs-varid'>con</span><span class='hs-layout'>)</span>
<a name="line-67"></a> <span class='hs-varid'>inst_tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tyConAppArgs</span> <span class='hs-varid'>data_ty</span>
<a name="line-68"></a>
<a name="line-69"></a> <span class='hs-varid'>unit_rhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkLHsTupleExpr</span> <span class='hs-conid'>[]</span>
<a name="line-70"></a> <span class='hs-varid'>msg_lit</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>HsStringPrim</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mkFastString</span> <span class='hs-varop'>$</span>
<a name="line-71"></a> <span class='hs-varid'>occNameString</span> <span class='hs-layout'>(</span><span class='hs-varid'>getOccName</span> <span class='hs-varid'>sel_name</span><span class='hs-layout'>)</span>
<a name="line-72"></a>
<a name="line-73"></a><a name="tyConFields"></a><span class='hs-comment'>---------------</span>
<a name="line-74"></a><span class='hs-definition'>tyConFields</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>FieldLabel</span><span class='hs-keyglyph'>]</span>
<a name="line-75"></a><span class='hs-definition'>tyConFields</span> <span class='hs-varid'>tc</span>
<a name="line-76"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isAlgTyCon</span> <span class='hs-varid'>tc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nub</span> <span class='hs-layout'>(</span><span class='hs-varid'>concatMap</span> <span class='hs-varid'>dataConFieldLabels</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConDataCons</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-77"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
</pre>\end{code}
Note [Polymorphic selectors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When a record has a polymorphic field, we pull the foralls out to the front.
data T = MkT { f :: forall a. [a] -> a }
Then f :: forall a. T -> [a] -> a
NOT f :: T -> forall a. [a] -> a
This is horrid. It's only needed in deeply obscure cases, which I hate.
The only case I know is test tc163, which is worth looking at. It's far
from clear that this test should succeed at all!
Note [Naughty record selectors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A "naughty" field is one for which we can't define a record
selector, because an existential type variable would escape. For example:
data T = forall a. MkT { x,y::a }
We obviously can't define
x (MkT v _) = v
Nevertheless we *do* put a RecSelId into the type environment
so that if the user tries to use 'x' as a selector we can bleat
helpfully, rather than saying unhelpfully that 'x' is not in scope.
Hence the sel_naughty flag, to identify record selectors that don't really exist.
In general, a field is "naughty" if its type mentions a type variable that
isn't in the result type of the constructor. Note that this *allows*
GADT record selectors (Note [GADT record selectors]) whose types may look
like sel :: T [a] -> a
For naughty selectors we make a dummy binding
sel = ()
for naughty selectors, so that the later type-check will add them to the
environment, and they'll be exported. The function is never called, because
the tyepchecker spots the sel_naughty field.
Note [GADT record selectors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For GADTs, we require that all constructors with a common field 'f' have the same
result type (modulo alpha conversion). [Checked in TcTyClsDecls.checkValidTyCon]
E.g.
data T where
T1 { f :: Maybe a } :: T [a]
T2 { f :: Maybe a, y :: b } :: T [a]
and now the selector takes that result type as its argument:
f :: forall a. T [a] -> Maybe a
Details: the "real" types of T1,T2 are:
T1 :: forall r a. (r~[a]) => a -> T r
T2 :: forall r a b. (r~[a]) => a -> b -> T r
So the selector loooks like this:
f :: forall a. T [a] -> Maybe a
f (a:*) (t:T [a])
= case t of
T1 c (g:[a]~[c]) (v:Maybe c) -> v `cast` Maybe (right (sym g))
T2 c d (g:[a]~[c]) (v:Maybe c) (w:d) -> v `cast` Maybe (right (sym g))
Note the forall'd tyvars of the selector are just the free tyvars
of the result type; there may be other tyvars in the constructor's
type (e.g. 'b' in T2).
Note the need for casts in the result!
Note [Selector running example]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's OK to combine GADTs and type families. Here's a running example:
data instance T [a] where
T1 { fld :: b } :: T [Maybe b]
The representation type looks like this
data :R7T a where
T1 { fld :: b } :: :R7T (Maybe b)
and there's coercion from the family type to the representation type
:CoR7T a :: T [a] ~ :R7T a
The selector we want for fld looks like this:
fld :: forall b. T [Maybe b] -> b
fld = /\b. \(d::T [Maybe b]).
case d `cast` :CoR7T (Maybe b) of
T1 (x::b) -> x
The scrutinee of the case has type :R7T (Maybe b), which can be
gotten by appying the eq_spec to the univ_tvs of the data con.
%************************************************************************
%* *
Error messages
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="resultTypeMisMatch"></a><span class='hs-definition'>resultTypeMisMatch</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-2"></a><span class='hs-definition'>resultTypeMisMatch</span> <span class='hs-varid'>field_name</span> <span class='hs-varid'>con1</span> <span class='hs-varid'>con2</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>vcat</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'>"Constructors"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>con1</span> <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'>"and"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>con2</span><span class='hs-layout'>,</span>
<a name="line-4"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"have a common field"</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'>field_name</span><span class='hs-layout'>)</span> <span class='hs-varop'><></span> <span class='hs-varid'>comma</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span>
<a name="line-5"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <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'>"but have different result types"</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-6"></a>
<a name="line-7"></a><a name="fieldTypeMisMatch"></a><span class='hs-definition'>fieldTypeMisMatch</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-8"></a><span class='hs-definition'>fieldTypeMisMatch</span> <span class='hs-varid'>field_name</span> <span class='hs-varid'>con1</span> <span class='hs-varid'>con2</span>
<a name="line-9"></a> <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'>"Constructors"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>con1</span> <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'>"and"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>con2</span><span class='hs-layout'>,</span>
<a name="line-10"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"give different types for field"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>field_name</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-11"></a>
<a name="line-12"></a><a name="dataConCtxt"></a><span class='hs-definition'>dataConCtxt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Outputable</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-13"></a><span class='hs-definition'>dataConCtxt</span> <span class='hs-varid'>con</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'>"In the definition of data constructor"</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'>con</span><span class='hs-layout'>)</span>
<a name="line-14"></a>
<a name="line-15"></a><a name="classOpCtxt"></a><span class='hs-definition'>classOpCtxt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Var</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-16"></a><span class='hs-definition'>classOpCtxt</span> <span class='hs-varid'>sel_id</span> <span class='hs-varid'>tau</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'>"When checking the class method:"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-17"></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-varid'>sel_id</span> <span class='hs-varop'><+></span> <span class='hs-varid'>dcolon</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tau</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-18"></a>
<a name="line-19"></a><a name="nullaryClassErr"></a><span class='hs-definition'>nullaryClassErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Class</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-20"></a><span class='hs-definition'>nullaryClassErr</span> <span class='hs-varid'>cls</span>
<a name="line-21"></a> <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'>"No parameters for class"</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'>cls</span><span class='hs-layout'>)</span>
<a name="line-22"></a>
<a name="line-23"></a><a name="classArityErr"></a><span class='hs-definition'>classArityErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Class</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-24"></a><span class='hs-definition'>classArityErr</span> <span class='hs-varid'>cls</span>
<a name="line-25"></a> <span class='hs-keyglyph'>=</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'>"Too many parameters for class"</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'>cls</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-26"></a> <span class='hs-varid'>parens</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'>"Use -XMultiParamTypeClasses to allow multi-parameter classes"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-27"></a>
<a name="line-28"></a><a name="classFunDepsErr"></a><span class='hs-definition'>classFunDepsErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Class</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-29"></a><span class='hs-definition'>classFunDepsErr</span> <span class='hs-varid'>cls</span>
<a name="line-30"></a> <span class='hs-keyglyph'>=</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'>"Fundeps in class"</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'>cls</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-31"></a> <span class='hs-varid'>parens</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'>"Use -XFunctionalDependencies to allow fundeps"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-32"></a>
<a name="line-33"></a><a name="noClassTyVarErr"></a><span class='hs-definition'>noClassTyVarErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Class</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Var</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-34"></a><span class='hs-definition'>noClassTyVarErr</span> <span class='hs-varid'>clas</span> <span class='hs-varid'>op</span>
<a name="line-35"></a> <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 class method"</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'>op</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-36"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"mentions none of the type variables of the class"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span>
<a name="line-37"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>clas</span> <span class='hs-varop'><+></span> <span class='hs-varid'>hsep</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>classTyVars</span> <span class='hs-varid'>clas</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-38"></a>
<a name="line-39"></a><a name="genericMultiParamErr"></a><span class='hs-definition'>genericMultiParamErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Class</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-40"></a><span class='hs-definition'>genericMultiParamErr</span> <span class='hs-varid'>clas</span>
<a name="line-41"></a> <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 multi-parameter class"</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'>clas</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span>
<a name="line-42"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"cannot have generic methods"</span><span class='hs-layout'>)</span>
<a name="line-43"></a>
<a name="line-44"></a><a name="badGenericMethodType"></a><span class='hs-definition'>badGenericMethodType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Kind</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-45"></a><span class='hs-definition'>badGenericMethodType</span> <span class='hs-varid'>op</span> <span class='hs-varid'>op_ty</span>
<a name="line-46"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hang</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'>"Generic method type is too complex"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-47"></a> <span class='hs-num'>4</span> <span class='hs-layout'>(</span><span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>op</span> <span class='hs-varop'><+></span> <span class='hs-varid'>dcolon</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>op_ty</span><span class='hs-layout'>,</span>
<a name="line-48"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"You can only use type variables, arrows, lists, and tuples"</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-49"></a>
<a name="line-50"></a><a name="recSynErr"></a><span class='hs-definition'>recSynErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LTyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcRn</span> <span class='hs-conid'>()</span>
<a name="line-51"></a><span class='hs-definition'>recSynErr</span> <span class='hs-varid'>syn_decls</span>
<a name="line-52"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>setSrcSpan</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'>sorted_decls</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-53"></a> <span class='hs-varid'>addErr</span> <span class='hs-layout'>(</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'>"Cycle in type synonym declarations:"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-54"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>vcat</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>ppr_decl</span> <span class='hs-varid'>sorted_decls</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-55"></a> <span class='hs-keyword'>where</span>
<a name="line-56"></a> <span class='hs-varid'>sorted_decls</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sortLocated</span> <span class='hs-varid'>syn_decls</span>
<a name="line-57"></a> <span class='hs-varid'>ppr_decl</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>loc</span> <span class='hs-varop'><></span> <span class='hs-varid'>colon</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>decl</span>
<a name="line-58"></a>
<a name="line-59"></a><a name="recClsErr"></a><span class='hs-definition'>recClsErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Located</span> <span class='hs-layout'>(</span><span class='hs-conid'>TyClDecl</span> <span class='hs-conid'>Name</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcRn</span> <span class='hs-conid'>()</span>
<a name="line-60"></a><span class='hs-definition'>recClsErr</span> <span class='hs-varid'>cls_decls</span>
<a name="line-61"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>setSrcSpan</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'>sorted_decls</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-62"></a> <span class='hs-varid'>addErr</span> <span class='hs-layout'>(</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'>"Cycle in class declarations (via superclasses):"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-63"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>vcat</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>ppr_decl</span> <span class='hs-varid'>sorted_decls</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-64"></a> <span class='hs-keyword'>where</span>
<a name="line-65"></a> <span class='hs-varid'>sorted_decls</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sortLocated</span> <span class='hs-varid'>cls_decls</span>
<a name="line-66"></a> <span class='hs-varid'>ppr_decl</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>decl</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>loc</span> <span class='hs-varop'><></span> <span class='hs-varid'>colon</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>decl</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcdSigs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-67"></a>
<a name="line-68"></a><a name="sortLocated"></a><span class='hs-definition'>sortLocated</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Located</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-conid'>Located</span> <span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span>
<a name="line-69"></a><span class='hs-definition'>sortLocated</span> <span class='hs-varid'>things</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sortLe</span> <span class='hs-varid'>le</span> <span class='hs-varid'>things</span>
<a name="line-70"></a> <span class='hs-keyword'>where</span>
<a name="line-71"></a> <span class='hs-varid'>le</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>l1</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>l2</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>l1</span> <span class='hs-varop'><=</span> <span class='hs-varid'>l2</span>
<a name="line-72"></a>
<a name="line-73"></a><a name="badDataConTyCon"></a><span class='hs-definition'>badDataConTyCon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DataCon</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'>SDoc</span>
<a name="line-74"></a><span class='hs-definition'>badDataConTyCon</span> <span class='hs-varid'>data_con</span> <span class='hs-varid'>res_ty_tmpl</span> <span class='hs-varid'>actual_res_ty</span>
<a name="line-75"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hang</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'>"Data constructor"</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'>data_con</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span>
<a name="line-76"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"returns type"</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'>actual_res_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-77"></a> <span class='hs-num'>2</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'>"instead of an instance of its parent type"</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'>res_ty_tmpl</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-78"></a>
<a name="line-79"></a><a name="badGadtDecl"></a><span class='hs-definition'>badGadtDecl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-80"></a><span class='hs-definition'>badGadtDecl</span> <span class='hs-varid'>tc_name</span>
<a name="line-81"></a> <span class='hs-keyglyph'>=</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'>"Illegal generalised algebraic data declaration 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'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-82"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>parens</span> <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'>"Use -XGADTs to allow GADTs"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>]</span>
<a name="line-83"></a>
<a name="line-84"></a><a name="badExistential"></a><span class='hs-definition'>badExistential</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Located</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-85"></a><span class='hs-definition'>badExistential</span> <span class='hs-varid'>con_name</span>
<a name="line-86"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hang</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'>"Data constructor"</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'>con_name</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span>
<a name="line-87"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"has existential type variables, or a context"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-88"></a> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>parens</span> <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'>"Use -XExistentialQuantification or -XGADTs to allow this"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-89"></a>
<a name="line-90"></a><a name="badStupidTheta"></a><span class='hs-definition'>badStupidTheta</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-91"></a><span class='hs-definition'>badStupidTheta</span> <span class='hs-varid'>tc_name</span>
<a name="line-92"></a> <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'>"A data type declared in GADT style cannot have a context:"</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'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-93"></a>
<a name="line-94"></a><a name="newtypeConError"></a><span class='hs-definition'>newtypeConError</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-95"></a><span class='hs-definition'>newtypeConError</span> <span class='hs-varid'>tycon</span> <span class='hs-varid'>n</span>
<a name="line-96"></a> <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'>"A newtype must have exactly one constructor,"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-97"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <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'>"but"</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'>tycon</span><span class='hs-layout'>)</span> <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'>"has"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>speakN</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>]</span>
<a name="line-98"></a>
<a name="line-99"></a><a name="newtypeExError"></a><span class='hs-definition'>newtypeExError</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-100"></a><span class='hs-definition'>newtypeExError</span> <span class='hs-varid'>con</span>
<a name="line-101"></a> <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'>"A newtype constructor cannot have an existential context,"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-102"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <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'>"but"</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'>con</span><span class='hs-layout'>)</span> <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'>"does"</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-103"></a>
<a name="line-104"></a><a name="newtypeStrictError"></a><span class='hs-definition'>newtypeStrictError</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-105"></a><span class='hs-definition'>newtypeStrictError</span> <span class='hs-varid'>con</span>
<a name="line-106"></a> <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'>"A newtype constructor cannot have a strictness annotation,"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-107"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <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'>"but"</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'>con</span><span class='hs-layout'>)</span> <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'>"does"</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-108"></a>
<a name="line-109"></a><a name="newtypePredError"></a><span class='hs-definition'>newtypePredError</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-110"></a><span class='hs-definition'>newtypePredError</span> <span class='hs-varid'>con</span>
<a name="line-111"></a> <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'>"A newtype constructor must have a return type of form T a1 ... an"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-112"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <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'>"but"</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'>con</span><span class='hs-layout'>)</span> <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'>"does not"</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-113"></a>
<a name="line-114"></a><a name="newtypeFieldErr"></a><span class='hs-definition'>newtypeFieldErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-115"></a><span class='hs-definition'>newtypeFieldErr</span> <span class='hs-varid'>con_name</span> <span class='hs-varid'>n_flds</span>
<a name="line-116"></a> <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 constructor of a newtype must have exactly one field"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-117"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <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'>"but"</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'>con_name</span><span class='hs-layout'>)</span> <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'>"has"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>speakN</span> <span class='hs-varid'>n_flds</span><span class='hs-keyglyph'>]</span>
<a name="line-118"></a>
<a name="line-119"></a><a name="badSigTyDecl"></a><span class='hs-definition'>badSigTyDecl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-120"></a><span class='hs-definition'>badSigTyDecl</span> <span class='hs-varid'>tc_name</span>
<a name="line-121"></a> <span class='hs-keyglyph'>=</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'>"Illegal kind signature"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span>
<a name="line-122"></a> <span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-123"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>parens</span> <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'>"Use -XKindSignatures to allow kind signatures"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>]</span>
<a name="line-124"></a>
<a name="line-125"></a><a name="badFamInstDecl"></a><span class='hs-definition'>badFamInstDecl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Outputable</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-126"></a><span class='hs-definition'>badFamInstDecl</span> <span class='hs-varid'>tc_name</span>
<a name="line-127"></a> <span class='hs-keyglyph'>=</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'>"Illegal family instance for"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span>
<a name="line-128"></a> <span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-129"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>parens</span> <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'>"Use -XTypeFamilies to allow indexed type families"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>]</span>
<a name="line-130"></a>
<a name="line-131"></a><a name="tooManyParmsErr"></a><span class='hs-definition'>tooManyParmsErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Located</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-132"></a><span class='hs-definition'>tooManyParmsErr</span> <span class='hs-varid'>tc_name</span>
<a name="line-133"></a> <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'>"Family instance has too many parameters:"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span>
<a name="line-134"></a> <span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span>
<a name="line-135"></a>
<a name="line-136"></a><a name="tooFewParmsErr"></a><span class='hs-definition'>tooFewParmsErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Arity</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-137"></a><span class='hs-definition'>tooFewParmsErr</span> <span class='hs-varid'>arity</span>
<a name="line-138"></a> <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'>"Family instance has too few parameters; expected"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span>
<a name="line-139"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>arity</span>
<a name="line-140"></a>
<a name="line-141"></a><a name="wrongNumberOfParmsErr"></a><span class='hs-definition'>wrongNumberOfParmsErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Arity</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-142"></a><span class='hs-definition'>wrongNumberOfParmsErr</span> <span class='hs-varid'>exp_arity</span>
<a name="line-143"></a> <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'>"Number of parameters must match family declaration; expected"</span><span class='hs-layout'>)</span>
<a name="line-144"></a> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>exp_arity</span>
<a name="line-145"></a>
<a name="line-146"></a><a name="badBootFamInstDeclErr"></a><span class='hs-definition'>badBootFamInstDeclErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SDoc</span>
<a name="line-147"></a><span class='hs-definition'>badBootFamInstDeclErr</span>
<a name="line-148"></a> <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'>"Illegal family instance in hs-boot file"</span><span class='hs-layout'>)</span>
<a name="line-149"></a>
<a name="line-150"></a><a name="notFamily"></a><span class='hs-definition'>notFamily</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-151"></a><span class='hs-definition'>notFamily</span> <span class='hs-varid'>tycon</span>
<a name="line-152"></a> <span class='hs-keyglyph'>=</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'>"Illegal family instance 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'>tycon</span><span class='hs-layout'>)</span>
<a name="line-153"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varop'>$</span> <span class='hs-varid'>parens</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>tycon</span> <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'>"is not an indexed type family"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-154"></a>
<a name="line-155"></a><a name="wrongKindOfFamily"></a><span class='hs-definition'>wrongKindOfFamily</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-156"></a><span class='hs-definition'>wrongKindOfFamily</span> <span class='hs-varid'>family</span>
<a name="line-157"></a> <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'>"Wrong category of family instance; declaration was for a"</span><span class='hs-layout'>)</span>
<a name="line-158"></a> <span class='hs-varop'><+></span> <span class='hs-varid'>kindOfFamily</span>
<a name="line-159"></a> <span class='hs-keyword'>where</span>
<a name="line-160"></a> <span class='hs-varid'>kindOfFamily</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isSynTyCon</span> <span class='hs-varid'>family</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'>"type synonym"</span><span class='hs-layout'>)</span>
<a name="line-161"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isAlgTyCon</span> <span class='hs-varid'>family</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'>"data type"</span><span class='hs-layout'>)</span>
<a name="line-162"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"wrongKindOfFamily"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>family</span><span class='hs-layout'>)</span>
<a name="line-163"></a>
<a name="line-164"></a><a name="emptyConDeclsErr"></a><span class='hs-definition'>emptyConDeclsErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-165"></a><span class='hs-definition'>emptyConDeclsErr</span> <span class='hs-varid'>tycon</span>
<a name="line-166"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>tycon</span><span class='hs-layout'>)</span> <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'>"has no constructors"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-167"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <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'>"(-XEmptyDataDecls permits this)"</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
</pre>\end{code}
</body>
</html>
