Sophie

Sophie

distrib > Fedora > 14 > x86_64 > media > updates > by-pkgid > 33ad064c4b642ed30353356a1d094330 > files > 89

ghc-haddock-devel-2.7.2-3.fc14.x86_64.rpm

<?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>src/Haddock/Convert.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>{-# LANGUAGE PatternGuards #-}</span>
<a name="line-2"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span>
<a name="line-3"></a><span class='hs-comment'>-- |</span>
<a name="line-4"></a><span class='hs-comment'>-- Module      :  Haddock.Convert</span>
<a name="line-5"></a><span class='hs-comment'>-- Copyright   :  (c) Isaac Dupree 2009,</span>
<a name="line-6"></a><span class='hs-comment'>-- License     :  BSD-like</span>
<a name="line-7"></a><span class='hs-comment'>--</span>
<a name="line-8"></a><span class='hs-comment'>-- Maintainer  :  haddock@projects.haskell.org</span>
<a name="line-9"></a><span class='hs-comment'>-- Stability   :  experimental</span>
<a name="line-10"></a><span class='hs-comment'>-- Portability :  portable</span>
<a name="line-11"></a><span class='hs-comment'>--</span>
<a name="line-12"></a><span class='hs-comment'>-- Conversion between TyThing and HsDecl. This functionality may be moved into</span>
<a name="line-13"></a><span class='hs-comment'>-- GHC at some point.</span>
<a name="line-14"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span>
<a name="line-15"></a>
<a name="line-16"></a><span class='hs-comment'>-- Some other functions turned out to be useful for converting</span>
<a name="line-17"></a><span class='hs-comment'>-- instance heads, which aren't TyThings, so just export everything.</span>
<a name="line-18"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Haddock</span><span class='hs-varop'>.</span><span class='hs-conid'>Convert</span> <span class='hs-keyword'>where</span>
<a name="line-19"></a>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HsSyn</span>
<a name="line-21"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcType</span> <span class='hs-layout'>(</span> <span class='hs-varid'>tcSplitSigmaTy</span> <span class='hs-layout'>)</span>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TypeRep</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Type</span> <span class='hs-layout'>(</span> <span class='hs-varid'>splitKindFunTys</span> <span class='hs-layout'>)</span>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span>
<a name="line-25"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Var</span>
<a name="line-26"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Class</span>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TyCon</span>
<a name="line-28"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DataCon</span>
<a name="line-29"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>BasicTypes</span>
<a name="line-30"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TysPrim</span> <span class='hs-layout'>(</span> <span class='hs-varid'>alphaTyVars</span> <span class='hs-layout'>)</span>
<a name="line-31"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TysWiredIn</span> <span class='hs-layout'>(</span> <span class='hs-varid'>listTyConName</span> <span class='hs-layout'>)</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Bag</span> <span class='hs-layout'>(</span> <span class='hs-varid'>emptyBag</span> <span class='hs-layout'>)</span>
<a name="line-33"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>SrcLoc</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Located</span><span class='hs-layout'>,</span> <span class='hs-varid'>noLoc</span><span class='hs-layout'>,</span> <span class='hs-varid'>unLoc</span> <span class='hs-layout'>)</span>
<a name="line-34"></a>
<a name="line-35"></a><a name="tyThingToLHsDecl"></a><span class='hs-comment'>-- the main function here! yay!</span>
<a name="line-36"></a><span class='hs-definition'>tyThingToLHsDecl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyThing</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>LHsDecl</span> <span class='hs-conid'>Name</span>
<a name="line-37"></a><span class='hs-definition'>tyThingToLHsDecl</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>t</span> <span class='hs-keyword'>of</span>
<a name="line-38"></a>  <span class='hs-comment'>-- ids (functions and zero-argument a.k.a. CAFs) get a type signature.</span>
<a name="line-39"></a>  <span class='hs-comment'>-- Including built-in functions like seq.</span>
<a name="line-40"></a>  <span class='hs-comment'>-- foreign-imported functions could be represented with ForD</span>
<a name="line-41"></a>  <span class='hs-comment'>-- instead of SigD if we wanted...</span>
<a name="line-42"></a>  <span class='hs-comment'>--</span>
<a name="line-43"></a>  <span class='hs-comment'>-- in a future code version we could turn idVarDetails = foreign-call</span>
<a name="line-44"></a>  <span class='hs-comment'>-- into a ForD instead of a SigD if we wanted.  Haddock doesn't</span>
<a name="line-45"></a>  <span class='hs-comment'>-- need to care.</span>
<a name="line-46"></a>  <span class='hs-conid'>AnId</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>SigD</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyIdSig</span> <span class='hs-conid'>ImplicitizeForAll</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span>
<a name="line-47"></a>  <span class='hs-comment'>-- type-constructors (e.g. Maybe) are complicated, put the definition</span>
<a name="line-48"></a>  <span class='hs-comment'>-- later in the file (also it's used for class associated-types too.)</span>
<a name="line-49"></a>  <span class='hs-conid'>ATyCon</span> <span class='hs-varid'>tc</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TyClD</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyTyCon</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
<a name="line-50"></a>  <span class='hs-comment'>-- a data-constructor alone just gets rendered as a function:</span>
<a name="line-51"></a>  <span class='hs-conid'>ADataCon</span> <span class='hs-varid'>dc</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>SigD</span> <span class='hs-layout'>(</span><span class='hs-conid'>TypeSig</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyName</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span>
<a name="line-52"></a>    <span class='hs-layout'>(</span><span class='hs-varid'>synifyType</span> <span class='hs-conid'>ImplicitizeForAll</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConUserType</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-53"></a>  <span class='hs-comment'>-- classes are just a little tedious</span>
<a name="line-54"></a>  <span class='hs-conid'>AClass</span> <span class='hs-varid'>cl</span> <span class='hs-keyglyph'>-&gt;</span>
<a name="line-55"></a>    <span class='hs-conid'>TyClD</span> <span class='hs-varop'>$</span> <span class='hs-conid'>ClassDecl</span>
<a name="line-56"></a>      <span class='hs-layout'>(</span><span class='hs-varid'>synifyCtx</span> <span class='hs-layout'>(</span><span class='hs-varid'>classSCTheta</span> <span class='hs-varid'>cl</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-57"></a>      <span class='hs-layout'>(</span><span class='hs-varid'>synifyName</span> <span class='hs-varid'>cl</span><span class='hs-layout'>)</span>
<a name="line-58"></a>      <span class='hs-layout'>(</span><span class='hs-varid'>synifyTyVars</span> <span class='hs-layout'>(</span><span class='hs-varid'>classTyVars</span> <span class='hs-varid'>cl</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-59"></a>      <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-layout'>(</span><span class='hs-varid'>l</span><span class='hs-layout'>,</span><span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>noLoc</span>
<a name="line-60"></a>                 <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>getName</span> <span class='hs-varid'>l</span><span class='hs-layout'>,</span> <span class='hs-varid'>map</span> <span class='hs-varid'>getName</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-61"></a>         <span class='hs-varid'>snd</span> <span class='hs-varop'>$</span> <span class='hs-varid'>classTvsFds</span> <span class='hs-varid'>cl</span><span class='hs-layout'>)</span>
<a name="line-62"></a>      <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>noLoc</span> <span class='hs-varop'>.</span> <span class='hs-varid'>synifyIdSig</span> <span class='hs-conid'>DeleteTopLevelQuantification</span><span class='hs-layout'>)</span>
<a name="line-63"></a>           <span class='hs-layout'>(</span><span class='hs-varid'>classMethods</span> <span class='hs-varid'>cl</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-64"></a>      <span class='hs-varid'>emptyBag</span> <span class='hs-comment'>--ignore default method definitions, they don't affect signature</span>
<a name="line-65"></a>      <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>synifyClassAT</span> <span class='hs-layout'>(</span><span class='hs-varid'>classATs</span> <span class='hs-varid'>cl</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-66"></a>      <span class='hs-conid'>[]</span> <span class='hs-comment'>--we don't have any docs at this point</span>
<a name="line-67"></a>
<a name="line-68"></a><a name="synifyClassAT"></a><span class='hs-comment'>-- class associated-types are a subset of TyCon</span>
<a name="line-69"></a><span class='hs-comment'>-- (mainly only type/data-families)</span>
<a name="line-70"></a><span class='hs-definition'>synifyClassAT</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyCon</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>LTyClDecl</span> <span class='hs-conid'>Name</span>
<a name="line-71"></a><span class='hs-definition'>synifyClassAT</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>.</span> <span class='hs-varid'>synifyTyCon</span>
<a name="line-72"></a>
<a name="line-73"></a><a name="synifyTyCon"></a><span class='hs-definition'>synifyTyCon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyCon</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TyClDecl</span> <span class='hs-conid'>Name</span>
<a name="line-74"></a><span class='hs-definition'>synifyTyCon</span> <span class='hs-varid'>tc</span>
<a name="line-75"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isFunTyCon</span> <span class='hs-varid'>tc</span> <span class='hs-varop'>||</span> <span class='hs-varid'>isPrimTyCon</span> <span class='hs-varid'>tc</span> <span class='hs-keyglyph'>=</span>
<a name="line-76"></a>    <span class='hs-conid'>TyData</span>
<a name="line-77"></a>      <span class='hs-comment'>-- arbitrary lie, they are neither algebraic data nor newtype:</span>
<a name="line-78"></a>      <span class='hs-conid'>DataType</span>
<a name="line-79"></a>      <span class='hs-comment'>-- no built-in type has any stupidTheta:</span>
<a name="line-80"></a>      <span class='hs-layout'>(</span><span class='hs-varid'>noLoc</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-81"></a>      <span class='hs-layout'>(</span><span class='hs-varid'>synifyName</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
<a name="line-82"></a>      <span class='hs-comment'>-- tyConTyVars doesn't work on fun/prim, but we can make them up:</span>
<a name="line-83"></a>      <span class='hs-layout'>(</span><span class='hs-varid'>zipWith</span>
<a name="line-84"></a>         <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>fakeTyVar</span> <span class='hs-varid'>realKind</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span>
<a name="line-85"></a>             <span class='hs-conid'>KindedTyVar</span> <span class='hs-layout'>(</span><span class='hs-varid'>getName</span> <span class='hs-varid'>fakeTyVar</span><span class='hs-layout'>)</span> <span class='hs-varid'>realKind</span><span class='hs-layout'>)</span>
<a name="line-86"></a>         <span class='hs-varid'>alphaTyVars</span> <span class='hs-comment'>--a, b, c... which are unfortunately all kind *</span>
<a name="line-87"></a>         <span class='hs-layout'>(</span><span class='hs-varid'>fst</span> <span class='hs-varop'>.</span> <span class='hs-varid'>splitKindFunTys</span> <span class='hs-varop'>$</span> <span class='hs-varid'>tyConKind</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
<a name="line-88"></a>      <span class='hs-layout'>)</span>
<a name="line-89"></a>      <span class='hs-comment'>-- assume primitive types aren't members of data/newtype families:</span>
<a name="line-90"></a>      <span class='hs-conid'>Nothing</span>
<a name="line-91"></a>      <span class='hs-comment'>-- we have their kind accurately:</span>
<a name="line-92"></a>      <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConKind</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-93"></a>      <span class='hs-comment'>-- no algebraic constructors:</span>
<a name="line-94"></a>      <span class='hs-conid'>[]</span>
<a name="line-95"></a>      <span class='hs-comment'>-- "deriving" needn't be specified:</span>
<a name="line-96"></a>      <span class='hs-conid'>Nothing</span>
<a name="line-97"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isOpenSynTyCon</span> <span class='hs-varid'>tc</span> <span class='hs-keyglyph'>=</span>
<a name="line-98"></a>      <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-99"></a>        <span class='hs-conid'>OpenSynTyCon</span> <span class='hs-varid'>rhs_kind</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-&gt;</span>
<a name="line-100"></a>          <span class='hs-conid'>TyFamily</span> <span class='hs-conid'>TypeFamily</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyName</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyTyVars</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConTyVars</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-101"></a>               <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>rhs_kind</span><span class='hs-layout'>)</span>
<a name="line-102"></a>        <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>error</span> <span class='hs-str'>"synifyTyCon: impossible open type synonym?"</span>
<a name="line-103"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isOpenTyCon</span> <span class='hs-varid'>tc</span> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>--(why no "isOpenAlgTyCon"?)</span>
<a name="line-104"></a>      <span class='hs-keyword'>case</span> <span class='hs-varid'>algTyConRhs</span> <span class='hs-varid'>tc</span> <span class='hs-keyword'>of</span>
<a name="line-105"></a>        <span class='hs-conid'>OpenTyCon</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-&gt;</span>
<a name="line-106"></a>          <span class='hs-conid'>TyFamily</span> <span class='hs-conid'>DataFamily</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyName</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyTyVars</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConTyVars</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-107"></a>               <span class='hs-conid'>Nothing</span> <span class='hs-comment'>--always kind '*'</span>
<a name="line-108"></a>        <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>error</span> <span class='hs-str'>"synifyTyCon: impossible open data type?"</span>
<a name="line-109"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span>
<a name="line-110"></a>  <span class='hs-comment'>-- (closed) type, newtype, and data</span>
<a name="line-111"></a>  <span class='hs-keyword'>let</span>
<a name="line-112"></a>  <span class='hs-comment'>-- alg_ only applies to newtype/data</span>
<a name="line-113"></a>  <span class='hs-comment'>-- syn_ only applies to type</span>
<a name="line-114"></a>  <span class='hs-comment'>-- others apply to both</span>
<a name="line-115"></a>  <span class='hs-varid'>alg_nd</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>isNewTyCon</span> <span class='hs-varid'>tc</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>NewType</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>DataType</span>
<a name="line-116"></a>  <span class='hs-varid'>alg_ctx</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyCtx</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-117"></a>  <span class='hs-varid'>name</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyName</span> <span class='hs-varid'>tc</span>
<a name="line-118"></a>  <span class='hs-varid'>tyvars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyTyVars</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConTyVars</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
<a name="line-119"></a>  <span class='hs-varid'>typats</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>tyConFamInst_maybe</span> <span class='hs-varid'>tc</span> <span class='hs-keyword'>of</span>
<a name="line-120"></a>     <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Nothing</span>
<a name="line-121"></a>     <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>indexes</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span><span class='hs-layout'>)</span> <span class='hs-varid'>indexes</span><span class='hs-layout'>)</span>
<a name="line-122"></a>  <span class='hs-varid'>alg_kindSig</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConKind</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
<a name="line-123"></a>  <span class='hs-comment'>-- The data constructors.</span>
<a name="line-124"></a>  <span class='hs-comment'>--</span>
<a name="line-125"></a>  <span class='hs-comment'>-- Any data-constructors not exported from the module that *defines* the</span>
<a name="line-126"></a>  <span class='hs-comment'>-- type will not (cannot) be included.</span>
<a name="line-127"></a>  <span class='hs-comment'>--</span>
<a name="line-128"></a>  <span class='hs-comment'>-- Very simple constructors, Haskell98 with no existentials or anything,</span>
<a name="line-129"></a>  <span class='hs-comment'>-- probably look nicer in non-GADT syntax.  In source code, all constructors</span>
<a name="line-130"></a>  <span class='hs-comment'>-- must be declared with the same (GADT vs. not) syntax, and it probably</span>
<a name="line-131"></a>  <span class='hs-comment'>-- is less confusing to follow that principle for the documentation as well.</span>
<a name="line-132"></a>  <span class='hs-comment'>--</span>
<a name="line-133"></a>  <span class='hs-comment'>-- There is no sensible infix-representation for GADT-syntax constructor</span>
<a name="line-134"></a>  <span class='hs-comment'>-- declarations.  They cannot be made in source code, but we could end up</span>
<a name="line-135"></a>  <span class='hs-comment'>-- with some here in the case where some constructors use existentials.</span>
<a name="line-136"></a>  <span class='hs-comment'>-- That seems like an acceptable compromise (they'll just be documented</span>
<a name="line-137"></a>  <span class='hs-comment'>-- in prefix position), since, otherwise, the logic (at best) gets much more</span>
<a name="line-138"></a>  <span class='hs-comment'>-- complicated. (would use dataConIsInfix.)</span>
<a name="line-139"></a>  <span class='hs-varid'>alg_use_gadt_syntax</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>any</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-varop'>.</span> <span class='hs-varid'>isVanillaDataCon</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConDataCons</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
<a name="line-140"></a>  <span class='hs-varid'>alg_cons</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyDataCon</span> <span class='hs-varid'>alg_use_gadt_syntax</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConDataCons</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
<a name="line-141"></a>  <span class='hs-comment'>-- "deriving" doesn't affect the signature, no need to specify any.</span>
<a name="line-142"></a>  <span class='hs-varid'>alg_deriv</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-143"></a>  <span class='hs-varid'>syn_type</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span> <span class='hs-layout'>(</span><span class='hs-varid'>synTyConType</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
<a name="line-144"></a> <span class='hs-keyword'>in</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>isSynTyCon</span> <span class='hs-varid'>tc</span>
<a name="line-145"></a>  <span class='hs-keyword'>then</span> <span class='hs-conid'>TySynonym</span> <span class='hs-varid'>name</span> <span class='hs-varid'>tyvars</span> <span class='hs-varid'>typats</span> <span class='hs-varid'>syn_type</span>
<a name="line-146"></a>  <span class='hs-keyword'>else</span> <span class='hs-conid'>TyData</span> <span class='hs-varid'>alg_nd</span> <span class='hs-varid'>alg_ctx</span> <span class='hs-varid'>name</span> <span class='hs-varid'>tyvars</span> <span class='hs-varid'>typats</span> <span class='hs-varid'>alg_kindSig</span> <span class='hs-varid'>alg_cons</span> <span class='hs-varid'>alg_deriv</span>
<a name="line-147"></a>
<a name="line-148"></a><a name="synifyDataCon"></a><span class='hs-comment'>-- User beware: it is your responsibility to pass True (use_gadt_syntax)</span>
<a name="line-149"></a><span class='hs-comment'>-- for any constructor that would be misrepresented by omitting its</span>
<a name="line-150"></a><span class='hs-comment'>-- result-type.</span>
<a name="line-151"></a><span class='hs-comment'>-- But you might want pass False in simple enough cases,</span>
<a name="line-152"></a><span class='hs-comment'>-- if you think it looks better.</span>
<a name="line-153"></a><span class='hs-definition'>synifyDataCon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>LConDecl</span> <span class='hs-conid'>Name</span>
<a name="line-154"></a><span class='hs-definition'>synifyDataCon</span> <span class='hs-varid'>use_gadt_syntax</span> <span class='hs-varid'>dc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span>
<a name="line-155"></a> <span class='hs-keyword'>let</span>
<a name="line-156"></a>  <span class='hs-comment'>-- dataConIsInfix allegedly tells us whether it was declared with</span>
<a name="line-157"></a>  <span class='hs-comment'>-- infix *syntax*.</span>
<a name="line-158"></a>  <span class='hs-varid'>use_infix_syntax</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConIsInfix</span> <span class='hs-varid'>dc</span>
<a name="line-159"></a>  <span class='hs-varid'>use_named_field_syntax</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>field_tys</span><span class='hs-layout'>)</span>
<a name="line-160"></a>  <span class='hs-varid'>name</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyName</span> <span class='hs-varid'>dc</span>
<a name="line-161"></a>  <span class='hs-comment'>-- con_qvars means a different thing depending on gadt-syntax</span>
<a name="line-162"></a>  <span class='hs-varid'>qvars</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>use_gadt_syntax</span>
<a name="line-163"></a>    <span class='hs-keyword'>then</span> <span class='hs-varid'>synifyTyVars</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConAllTyVars</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span>
<a name="line-164"></a>    <span class='hs-keyword'>else</span> <span class='hs-varid'>synifyTyVars</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConExTyVars</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span>
<a name="line-165"></a>  <span class='hs-comment'>-- skip any EqTheta, use 'orig'inal syntax</span>
<a name="line-166"></a>  <span class='hs-varid'>ctx</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyCtx</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConDictTheta</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span>
<a name="line-167"></a>  <span class='hs-varid'>linear_tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>zipWith</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-varid'>strict</span> <span class='hs-keyglyph'>-&gt;</span>
<a name="line-168"></a>            <span class='hs-keyword'>let</span> <span class='hs-varid'>tySyn</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span> <span class='hs-varid'>ty</span>
<a name="line-169"></a>            <span class='hs-keyword'>in</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>strict</span> <span class='hs-keyword'>of</span>
<a name="line-170"></a>                 <span class='hs-conid'>MarkedStrict</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span> <span class='hs-conid'>HsBangTy</span> <span class='hs-conid'>HsStrict</span> <span class='hs-varid'>tySyn</span>
<a name="line-171"></a>                 <span class='hs-conid'>MarkedUnboxed</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span> <span class='hs-conid'>HsBangTy</span> <span class='hs-conid'>HsUnbox</span> <span class='hs-varid'>tySyn</span>
<a name="line-172"></a>                 <span class='hs-conid'>NotMarkedStrict</span> <span class='hs-keyglyph'>-&gt;</span>
<a name="line-173"></a>                      <span class='hs-comment'>-- HsNoBang never appears, it's implied instead.</span>
<a name="line-174"></a>                      <span class='hs-varid'>tySyn</span>
<a name="line-175"></a>          <span class='hs-layout'>)</span>
<a name="line-176"></a>          <span class='hs-layout'>(</span><span class='hs-varid'>dataConOrigArgTys</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConStrictMarks</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span>
<a name="line-177"></a>  <span class='hs-varid'>field_tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>zipWith</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>field</span> <span class='hs-varid'>synTy</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>ConDeclField</span>
<a name="line-178"></a>                                           <span class='hs-layout'>(</span><span class='hs-varid'>synifyName</span> <span class='hs-varid'>field</span><span class='hs-layout'>)</span> <span class='hs-varid'>synTy</span> <span class='hs-conid'>Nothing</span><span class='hs-layout'>)</span>
<a name="line-179"></a>                <span class='hs-layout'>(</span><span class='hs-varid'>dataConFieldLabels</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span> <span class='hs-varid'>linear_tys</span>
<a name="line-180"></a>  <span class='hs-varid'>tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>use_named_field_syntax</span><span class='hs-layout'>,</span> <span class='hs-varid'>use_infix_syntax</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-181"></a>          <span class='hs-layout'>(</span><span class='hs-conid'>True</span><span class='hs-layout'>,</span><span class='hs-conid'>True</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>error</span> <span class='hs-str'>"synifyDataCon: contradiction!"</span>
<a name="line-182"></a>          <span class='hs-layout'>(</span><span class='hs-conid'>True</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>RecCon</span> <span class='hs-varid'>field_tys</span>
<a name="line-183"></a>          <span class='hs-layout'>(</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>PrefixCon</span> <span class='hs-varid'>linear_tys</span>
<a name="line-184"></a>          <span class='hs-layout'>(</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-conid'>True</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>linear_tys</span> <span class='hs-keyword'>of</span>
<a name="line-185"></a>                           <span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>b</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>InfixCon</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span>
<a name="line-186"></a>                           <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>error</span> <span class='hs-str'>"synifyDataCon: infix with non-2 args?"</span>
<a name="line-187"></a>  <span class='hs-varid'>res_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>use_gadt_syntax</span>
<a name="line-188"></a>    <span class='hs-keyword'>then</span> <span class='hs-conid'>ResTyGADT</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConOrigResTy</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-189"></a>    <span class='hs-keyword'>else</span> <span class='hs-conid'>ResTyH98</span>
<a name="line-190"></a> <span class='hs-comment'>-- finally we get synifyDataCon's result!</span>
<a name="line-191"></a> <span class='hs-keyword'>in</span> <span class='hs-conid'>ConDecl</span> <span class='hs-varid'>name</span> <span class='hs-conid'>Implicit</span><span class='hs-comment'>{-we don't know nor care-}</span>
<a name="line-192"></a>      <span class='hs-varid'>qvars</span> <span class='hs-varid'>ctx</span> <span class='hs-varid'>tys</span> <span class='hs-varid'>res_ty</span> <span class='hs-conid'>Nothing</span>
<a name="line-193"></a>      <span class='hs-conid'>False</span> <span class='hs-comment'>--we don't want any "deprecated GADT syntax" warnings!</span>
<a name="line-194"></a>
<a name="line-195"></a><a name="synifyName"></a><span class='hs-definition'>synifyName</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>NamedThing</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>=&gt;</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Located</span> <span class='hs-conid'>Name</span>
<a name="line-196"></a><span class='hs-definition'>synifyName</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>.</span> <span class='hs-varid'>getName</span>
<a name="line-197"></a>
<a name="line-198"></a><a name="synifyIdSig"></a><span class='hs-definition'>synifyIdSig</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SynifyTypeState</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Sig</span> <span class='hs-conid'>Name</span>
<a name="line-199"></a><span class='hs-definition'>synifyIdSig</span> <span class='hs-varid'>s</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>TypeSig</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyName</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyType</span> <span class='hs-varid'>s</span> <span class='hs-layout'>(</span><span class='hs-varid'>varType</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-200"></a>
<a name="line-201"></a>
<a name="line-202"></a><a name="synifyCtx"></a><span class='hs-definition'>synifyCtx</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>PredType</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>LHsContext</span> <span class='hs-conid'>Name</span>
<a name="line-203"></a><span class='hs-definition'>synifyCtx</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-varid'>synifyPred</span>
<a name="line-204"></a>
<a name="line-205"></a><a name="synifyPred"></a><span class='hs-definition'>synifyPred</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>PredType</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>LHsPred</span> <span class='hs-conid'>Name</span>
<a name="line-206"></a><span class='hs-definition'>synifyPred</span> <span class='hs-layout'>(</span><span class='hs-conid'>ClassP</span> <span class='hs-varid'>cls</span> <span class='hs-varid'>tys</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-207"></a>    <span class='hs-keyword'>let</span> <span class='hs-varid'>sTys</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span><span class='hs-layout'>)</span> <span class='hs-varid'>tys</span>
<a name="line-208"></a>    <span class='hs-keyword'>in</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span>
<a name="line-209"></a>        <span class='hs-conid'>HsClassP</span> <span class='hs-layout'>(</span><span class='hs-varid'>getName</span> <span class='hs-varid'>cls</span><span class='hs-layout'>)</span> <span class='hs-varid'>sTys</span>
<a name="line-210"></a><span class='hs-definition'>synifyPred</span> <span class='hs-layout'>(</span><span class='hs-conid'>IParam</span> <span class='hs-varid'>ip</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-211"></a>    <span class='hs-keyword'>let</span> <span class='hs-varid'>sTy</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span> <span class='hs-varid'>ty</span>
<a name="line-212"></a>    <span class='hs-comment'>-- IPName should be in class NamedThing...</span>
<a name="line-213"></a>    <span class='hs-keyword'>in</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span>
<a name="line-214"></a>      <span class='hs-conid'>HsIParam</span> <span class='hs-varid'>ip</span> <span class='hs-varid'>sTy</span>
<a name="line-215"></a><span class='hs-definition'>synifyPred</span> <span class='hs-layout'>(</span><span class='hs-conid'>EqPred</span> <span class='hs-varid'>ty1</span> <span class='hs-varid'>ty2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-216"></a>    <span class='hs-keyword'>let</span>
<a name="line-217"></a>     <span class='hs-varid'>s1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span> <span class='hs-varid'>ty1</span>
<a name="line-218"></a>     <span class='hs-varid'>s2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span> <span class='hs-varid'>ty2</span>
<a name="line-219"></a>    <span class='hs-keyword'>in</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span>
<a name="line-220"></a>      <span class='hs-conid'>HsEqualP</span> <span class='hs-varid'>s1</span> <span class='hs-varid'>s2</span>
<a name="line-221"></a>
<a name="line-222"></a><a name="synifyTyVars"></a><span class='hs-definition'>synifyTyVars</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyVar</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LHsTyVarBndr</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span>
<a name="line-223"></a><span class='hs-definition'>synifyTyVars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>synifyTyVar</span>
<a name="line-224"></a>  <span class='hs-keyword'>where</span>
<a name="line-225"></a>    <span class='hs-varid'>synifyTyVar</span> <span class='hs-varid'>tv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>let</span>
<a name="line-226"></a>      <span class='hs-varid'>kind</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tyVarKind</span> <span class='hs-varid'>tv</span>
<a name="line-227"></a>      <span class='hs-varid'>name</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>getName</span> <span class='hs-varid'>tv</span>
<a name="line-228"></a>     <span class='hs-keyword'>in</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>isLiftedTypeKind</span> <span class='hs-varid'>kind</span>
<a name="line-229"></a>        <span class='hs-keyword'>then</span> <span class='hs-conid'>UserTyVar</span> <span class='hs-varid'>name</span>
<a name="line-230"></a>        <span class='hs-keyword'>else</span> <span class='hs-conid'>KindedTyVar</span> <span class='hs-varid'>name</span> <span class='hs-varid'>kind</span>
<a name="line-231"></a>
<a name="line-232"></a><a name="SynifyTypeState"></a><span class='hs-comment'>--states of what to do with foralls:</span>
<a name="line-233"></a><a name="SynifyTypeState"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>SynifyTypeState</span>
<a name="line-234"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>WithinType</span>
<a name="line-235"></a>  <span class='hs-comment'>-- ^ normal situation.  This is the safe one to use if you don't</span>
<a name="line-236"></a>  <span class='hs-comment'>-- quite understand what's going on.</span>
<a name="line-237"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>ImplicitizeForAll</span>
<a name="line-238"></a>  <span class='hs-comment'>-- ^ beginning of a function definition, in which, to make it look</span>
<a name="line-239"></a>  <span class='hs-comment'>--   less ugly, those rank-1 foralls are made implicit.</span>
<a name="line-240"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>DeleteTopLevelQuantification</span>
<a name="line-241"></a>  <span class='hs-comment'>-- ^ because in class methods the context is added to the type</span>
<a name="line-242"></a>  <span class='hs-comment'>--   (e.g. adding @forall a. Num a =&gt;@ to @(+) :: a -&gt; a -&gt; a@)</span>
<a name="line-243"></a>  <span class='hs-comment'>--   which is rather sensible,</span>
<a name="line-244"></a>  <span class='hs-comment'>--   but we want to restore things to the source-syntax situation where</span>
<a name="line-245"></a>  <span class='hs-comment'>--   the defining class gets to quantify all its functions for free!</span>
<a name="line-246"></a>
<a name="line-247"></a><a name="synifyType"></a><span class='hs-definition'>synifyType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SynifyTypeState</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>LHsType</span> <span class='hs-conid'>Name</span>
<a name="line-248"></a><span class='hs-definition'>synifyType</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>PredTy</span><span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>--should never happen.</span>
<a name="line-249"></a>  <span class='hs-varid'>error</span> <span class='hs-str'>"synifyType: PredTys are not, in themselves, source-level types."</span>
<a name="line-250"></a><span class='hs-definition'>synifyType</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>TyVarTy</span> <span class='hs-varid'>tv</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span> <span class='hs-conid'>HsTyVar</span> <span class='hs-layout'>(</span><span class='hs-varid'>getName</span> <span class='hs-varid'>tv</span><span class='hs-layout'>)</span>
<a name="line-251"></a><span class='hs-definition'>synifyType</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>TyConApp</span> <span class='hs-varid'>tc</span> <span class='hs-varid'>tys</span><span class='hs-layout'>)</span>
<a name="line-252"></a>  <span class='hs-comment'>-- Use non-prefix tuple syntax where possible, because it looks nicer.</span>
<a name="line-253"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isTupleTyCon</span> <span class='hs-varid'>tc</span><span class='hs-layout'>,</span> <span class='hs-varid'>tyConArity</span> <span class='hs-varid'>tc</span> <span class='hs-varop'>==</span> <span class='hs-varid'>length</span> <span class='hs-varid'>tys</span> <span class='hs-keyglyph'>=</span>
<a name="line-254"></a>     <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span> <span class='hs-conid'>HsTupleTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>tupleTyConBoxity</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span><span class='hs-layout'>)</span> <span class='hs-varid'>tys</span><span class='hs-layout'>)</span>
<a name="line-255"></a>  <span class='hs-comment'>-- ditto for lists</span>
<a name="line-256"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>getName</span> <span class='hs-varid'>tc</span> <span class='hs-varop'>==</span> <span class='hs-varid'>listTyConName</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ty</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>tys</span> <span class='hs-keyglyph'>=</span>
<a name="line-257"></a>     <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span> <span class='hs-conid'>HsListTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-258"></a>  <span class='hs-comment'>-- Most TyCons:</span>
<a name="line-259"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span>
<a name="line-260"></a>    <span class='hs-varid'>foldl</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>t1</span> <span class='hs-varid'>t2</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>noLoc</span> <span class='hs-layout'>(</span><span class='hs-conid'>HsAppTy</span> <span class='hs-varid'>t1</span> <span class='hs-varid'>t2</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-261"></a>      <span class='hs-layout'>(</span><span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span> <span class='hs-conid'>HsTyVar</span> <span class='hs-layout'>(</span><span class='hs-varid'>getName</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-262"></a>      <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span><span class='hs-layout'>)</span> <span class='hs-varid'>tys</span><span class='hs-layout'>)</span>
<a name="line-263"></a><span class='hs-definition'>synifyType</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>AppTy</span> <span class='hs-varid'>t1</span> <span class='hs-varid'>t2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span>
<a name="line-264"></a>  <span class='hs-varid'>s1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span> <span class='hs-varid'>t1</span>
<a name="line-265"></a>  <span class='hs-varid'>s2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span> <span class='hs-varid'>t2</span>
<a name="line-266"></a>  <span class='hs-keyword'>in</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span> <span class='hs-conid'>HsAppTy</span> <span class='hs-varid'>s1</span> <span class='hs-varid'>s2</span>
<a name="line-267"></a><span class='hs-definition'>synifyType</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>FunTy</span> <span class='hs-varid'>t1</span> <span class='hs-varid'>t2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span>
<a name="line-268"></a>  <span class='hs-varid'>s1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span> <span class='hs-varid'>t1</span>
<a name="line-269"></a>  <span class='hs-varid'>s2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span> <span class='hs-varid'>t2</span>
<a name="line-270"></a>  <span class='hs-keyword'>in</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span> <span class='hs-conid'>HsFunTy</span> <span class='hs-varid'>s1</span> <span class='hs-varid'>s2</span>
<a name="line-271"></a><span class='hs-definition'>synifyType</span> <span class='hs-varid'>s</span> <span class='hs-varid'>forallty</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>ForAllTy</span> <span class='hs-sel'>_tv</span> <span class='hs-sel'>_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-272"></a>  <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>ctx</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'>tcSplitSigmaTy</span> <span class='hs-varid'>forallty</span>
<a name="line-273"></a>  <span class='hs-keyword'>in</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>s</span> <span class='hs-keyword'>of</span>
<a name="line-274"></a>    <span class='hs-conid'>DeleteTopLevelQuantification</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>synifyType</span> <span class='hs-conid'>ImplicitizeForAll</span> <span class='hs-varid'>tau</span>
<a name="line-275"></a>    <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyword'>let</span>
<a name="line-276"></a>      <span class='hs-varid'>forallPlicitness</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>s</span> <span class='hs-keyword'>of</span>
<a name="line-277"></a>              <span class='hs-conid'>WithinType</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Explicit</span>
<a name="line-278"></a>              <span class='hs-conid'>ImplicitizeForAll</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Implicit</span>
<a name="line-279"></a>              <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>error</span> <span class='hs-str'>"synifyType: impossible case!!!"</span>
<a name="line-280"></a>      <span class='hs-varid'>sTvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyTyVars</span> <span class='hs-varid'>tvs</span>
<a name="line-281"></a>      <span class='hs-varid'>sCtx</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyCtx</span> <span class='hs-varid'>ctx</span>
<a name="line-282"></a>      <span class='hs-varid'>sTau</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>synifyType</span> <span class='hs-conid'>WithinType</span> <span class='hs-varid'>tau</span>
<a name="line-283"></a>     <span class='hs-keyword'>in</span> <span class='hs-varid'>noLoc</span> <span class='hs-varop'>$</span>
<a name="line-284"></a>           <span class='hs-conid'>HsForAllTy</span> <span class='hs-varid'>forallPlicitness</span> <span class='hs-varid'>sTvs</span> <span class='hs-varid'>sCtx</span> <span class='hs-varid'>sTau</span>
<a name="line-285"></a>
<a name="line-286"></a><a name="synifyInstHead"></a><span class='hs-definition'>synifyInstHead</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-keyglyph'>[</span><span class='hs-conid'>PredType</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-conid'>Class</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span>
<a name="line-287"></a>                  <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>HsPred</span> <span class='hs-conid'>Name</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-keyglyph'>[</span><span class='hs-conid'>HsType</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-288"></a><span class='hs-definition'>synifyInstHead</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>preds</span><span class='hs-layout'>,</span> <span class='hs-varid'>cls</span><span class='hs-layout'>,</span> <span class='hs-varid'>ts</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-289"></a>  <span class='hs-layout'>(</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'>synifyPred</span><span class='hs-layout'>)</span> <span class='hs-varid'>preds</span>
<a name="line-290"></a>  <span class='hs-layout'>,</span> <span class='hs-varid'>getName</span> <span class='hs-varid'>cls</span>
<a name="line-291"></a>  <span class='hs-layout'>,</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'>synifyType</span> <span class='hs-conid'>WithinType</span><span class='hs-layout'>)</span> <span class='hs-varid'>ts</span>
<a name="line-292"></a>  <span class='hs-layout'>)</span>
</pre></body>
</html>