<?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>ghci/RtClosureInspect.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span>
<a name="line-2"></a><span class='hs-comment'>--</span>
<a name="line-3"></a><span class='hs-comment'>-- GHC Interactive support for inspecting arbitrary closures at runtime</span>
<a name="line-4"></a><span class='hs-comment'>--</span>
<a name="line-5"></a><span class='hs-comment'>-- Pepe Iborra (supported by Google SoC) 2006</span>
<a name="line-6"></a><span class='hs-comment'>--</span>
<a name="line-7"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span>
<a name="line-8"></a>
<a name="line-9"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>RtClosureInspect</span><span class='hs-layout'>(</span>
<a name="line-10"></a> <span class='hs-varid'>cvObtainTerm</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- :: HscEnv -> Int -> Bool -> Maybe Type -> HValue -> IO Term</span>
<a name="line-11"></a> <span class='hs-varid'>cvReconstructType</span><span class='hs-layout'>,</span>
<a name="line-12"></a> <span class='hs-varid'>improveRTTIType</span><span class='hs-layout'>,</span>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-conid'>Term</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-15"></a> <span class='hs-varid'>isTerm</span><span class='hs-layout'>,</span> <span class='hs-varid'>isSuspension</span><span class='hs-layout'>,</span> <span class='hs-varid'>isPrim</span><span class='hs-layout'>,</span> <span class='hs-varid'>isFun</span><span class='hs-layout'>,</span> <span class='hs-varid'>isFunLike</span><span class='hs-layout'>,</span> <span class='hs-varid'>isNewtypeWrap</span><span class='hs-layout'>,</span>
<a name="line-16"></a> <span class='hs-varid'>isFullyEvaluated</span><span class='hs-layout'>,</span> <span class='hs-varid'>isFullyEvaluatedTerm</span><span class='hs-layout'>,</span>
<a name="line-17"></a> <span class='hs-varid'>termType</span><span class='hs-layout'>,</span> <span class='hs-varid'>mapTermType</span><span class='hs-layout'>,</span> <span class='hs-varid'>termTyVars</span><span class='hs-layout'>,</span>
<a name="line-18"></a> <span class='hs-varid'>foldTerm</span><span class='hs-layout'>,</span> <span class='hs-conid'>TermFold</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>foldTermM</span><span class='hs-layout'>,</span> <span class='hs-conid'>TermFoldM</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>idTermFold</span><span class='hs-layout'>,</span>
<a name="line-19"></a> <span class='hs-varid'>pprTerm</span><span class='hs-layout'>,</span> <span class='hs-varid'>cPprTerm</span><span class='hs-layout'>,</span> <span class='hs-varid'>cPprTermBase</span><span class='hs-layout'>,</span> <span class='hs-conid'>CustomTermPrinter</span><span class='hs-layout'>,</span>
<a name="line-20"></a>
<a name="line-21"></a><span class='hs-comment'>-- unsafeDeepSeq,</span>
<a name="line-22"></a>
<a name="line-23"></a> <span class='hs-conid'>Closure</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>getClosureData</span><span class='hs-layout'>,</span> <span class='hs-conid'>ClosureType</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>isConstr</span><span class='hs-layout'>,</span> <span class='hs-varid'>isIndirection</span><span class='hs-layout'>,</span>
<a name="line-24"></a>
<a name="line-25"></a> <span class='hs-varid'>sigmaType</span>
<a name="line-26"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-27"></a>
<a name="line-28"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-29"></a>
<a name="line-30"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ByteCodeItbls</span> <span class='hs-layout'>(</span> <span class='hs-conid'>StgInfoTable</span> <span class='hs-layout'>)</span>
<a name="line-31"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>ByteCodeItbls</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>BCI</span><span class='hs-layout'>(</span> <span class='hs-conid'>StgInfoTable</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HscTypes</span>
<a name="line-33"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Linker</span>
<a name="line-34"></a>
<a name="line-35"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DataCon</span>
<a name="line-36"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Type</span>
<a name="line-37"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TypeRep</span> <span class='hs-comment'>-- I know I know, this is cheating</span>
<a name="line-38"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Var</span>
<a name="line-39"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcRnMonad</span>
<a name="line-40"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcType</span>
<a name="line-41"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcMType</span>
<a name="line-42"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcUnify</span>
<a name="line-43"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcEnv</span>
<a name="line-44"></a>
<a name="line-45"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TyCon</span>
<a name="line-46"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span>
<a name="line-47"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarEnv</span>
<a name="line-48"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Util</span>
<a name="line-49"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ListSetOps</span>
<a name="line-50"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarSet</span>
<a name="line-51"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TysPrim</span>
<a name="line-52"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>PrelNames</span>
<a name="line-53"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TysWiredIn</span>
<a name="line-54"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DynFlags</span>
<a name="line-55"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-56"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastString</span>
<a name="line-57"></a><span class='hs-comment'>-- import Panic</span>
<a name="line-58"></a>
<a name="line-59"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Constants</span> <span class='hs-layout'>(</span> <span class='hs-varid'>wORD_SIZE</span> <span class='hs-layout'>)</span>
<a name="line-60"></a>
<a name="line-61"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>GHC</span><span class='hs-varop'>.</span><span class='hs-conid'>Arr</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Array</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-62"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>GHC</span><span class='hs-varop'>.</span><span class='hs-conid'>Exts</span>
<a name="line-63"></a>
<a name="line-64"></a><span class='hs-cpp'>#if __GLASGOW_HASKELL__ >= 611</span>
<a name="line-65"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>GHC</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span> <span class='hs-layout'>(</span> <span class='hs-conid'>IO</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-66"></a><span class='hs-cpp'>#else</span>
<a name="line-67"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>GHC</span><span class='hs-varop'>.</span><span class='hs-conid'>IOBase</span> <span class='hs-layout'>(</span> <span class='hs-conid'>IO</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-68"></a><span class='hs-cpp'>#endif</span>
<a name="line-69"></a>
<a name="line-70"></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-71"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Maybe</span>
<a name="line-72"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Array</span><span class='hs-varop'>.</span><span class='hs-conid'>Base</span>
<a name="line-73"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Ix</span>
<a name="line-74"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span>
<a name="line-75"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Sequence</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>Seq</span>
<a name="line-76"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Monoid</span>
<a name="line-77"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Sequence</span> <span class='hs-layout'>(</span><span class='hs-varid'>viewl</span><span class='hs-layout'>,</span> <span class='hs-conid'>ViewL</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-78"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Foreign</span>
<a name="line-79"></a><span class='hs-comment'>-- import System.IO.Unsafe</span>
<a name="line-80"></a>
<a name="line-81"></a><span class='hs-comment'>---------------------------------------------</span>
<a name="line-82"></a><span class='hs-comment'>-- * A representation of semi evaluated Terms</span>
<a name="line-83"></a><span class='hs-comment'>---------------------------------------------</span>
<a name="line-84"></a>
<a name="line-85"></a><a name="Term"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Term</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span>
<a name="line-86"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>dc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Either</span> <span class='hs-conid'>String</span> <span class='hs-conid'>DataCon</span>
<a name="line-87"></a> <span class='hs-comment'>-- Carries a text representation if the datacon is</span>
<a name="line-88"></a> <span class='hs-comment'>-- not exported by the .hi file, which is the case </span>
<a name="line-89"></a> <span class='hs-comment'>-- for private constructors in -O0 compiled libraries</span>
<a name="line-90"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HValue</span>
<a name="line-91"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>subTerms</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Term</span><span class='hs-keyglyph'>]</span> <span class='hs-layout'>}</span>
<a name="line-92"></a>
<a name="line-93"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Prim</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span>
<a name="line-94"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>value</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Word</span><span class='hs-keyglyph'>]</span> <span class='hs-layout'>}</span>
<a name="line-95"></a>
<a name="line-96"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Suspension</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ctype</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ClosureType</span>
<a name="line-97"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span>
<a name="line-98"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HValue</span>
<a name="line-99"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>bound_to</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Name</span> <span class='hs-comment'>-- Useful for printing</span>
<a name="line-100"></a> <span class='hs-layout'>}</span>
<a name="line-101"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>NewtypeWrap</span><span class='hs-layout'>{</span> <span class='hs-comment'>-- At runtime there are no newtypes, and hence no</span>
<a name="line-102"></a> <span class='hs-comment'>-- newtype constructors. A NewtypeWrap is just a</span>
<a name="line-103"></a> <span class='hs-comment'>-- made-up tag saying "heads up, there used to be</span>
<a name="line-104"></a> <span class='hs-comment'>-- a newtype constructor here".</span>
<a name="line-105"></a> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span>
<a name="line-106"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>dc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Either</span> <span class='hs-conid'>String</span> <span class='hs-conid'>DataCon</span>
<a name="line-107"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>wrapped_term</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Term</span> <span class='hs-layout'>}</span>
<a name="line-108"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>RefWrap</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- The contents of a reference</span>
<a name="line-109"></a> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span>
<a name="line-110"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>wrapped_term</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Term</span> <span class='hs-layout'>}</span>
<a name="line-111"></a>
<a name="line-112"></a><a name="isTerm"></a><span class='hs-definition'>isTerm</span><span class='hs-layout'>,</span> <span class='hs-varid'>isSuspension</span><span class='hs-layout'>,</span> <span class='hs-varid'>isPrim</span><span class='hs-layout'>,</span> <span class='hs-varid'>isFun</span><span class='hs-layout'>,</span> <span class='hs-varid'>isFunLike</span><span class='hs-layout'>,</span> <span class='hs-varid'>isNewtypeWrap</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-113"></a><span class='hs-definition'>isTerm</span> <span class='hs-conid'>Term</span><span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-114"></a><span class='hs-definition'>isTerm</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-115"></a><a name="isSuspension"></a><span class='hs-definition'>isSuspension</span> <span class='hs-conid'>Suspension</span><span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-116"></a><span class='hs-definition'>isSuspension</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-117"></a><a name="isPrim"></a><span class='hs-definition'>isPrim</span> <span class='hs-conid'>Prim</span><span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-118"></a><span class='hs-definition'>isPrim</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-119"></a><a name="isNewtypeWrap"></a><span class='hs-definition'>isNewtypeWrap</span> <span class='hs-conid'>NewtypeWrap</span><span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-120"></a><span class='hs-definition'>isNewtypeWrap</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-121"></a>
<a name="line-122"></a><a name="isFun"></a><span class='hs-definition'>isFun</span> <span class='hs-conid'>Suspension</span><span class='hs-layout'>{</span><span class='hs-varid'>ctype</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Fun</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-123"></a><span class='hs-definition'>isFun</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-124"></a>
<a name="line-125"></a><a name="isFunLike"></a><span class='hs-definition'>isFunLike</span> <span class='hs-varid'>s</span><span class='hs-keyglyph'>@</span><span class='hs-conid'>Suspension</span><span class='hs-layout'>{</span><span class='hs-varid'>ty</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>ty</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isFun</span> <span class='hs-varid'>s</span> <span class='hs-varop'>||</span> <span class='hs-varid'>isFunTy</span> <span class='hs-varid'>ty</span>
<a name="line-126"></a><span class='hs-definition'>isFunLike</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-127"></a>
<a name="line-128"></a><a name="termType"></a><span class='hs-definition'>termType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RttiType</span>
<a name="line-129"></a><span class='hs-definition'>termType</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>t</span>
<a name="line-130"></a>
<a name="line-131"></a><a name="isFullyEvaluatedTerm"></a><span class='hs-definition'>isFullyEvaluatedTerm</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-132"></a><span class='hs-definition'>isFullyEvaluatedTerm</span> <span class='hs-conid'>Term</span> <span class='hs-layout'>{</span><span class='hs-varid'>subTerms</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>tt</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>all</span> <span class='hs-varid'>isFullyEvaluatedTerm</span> <span class='hs-varid'>tt</span>
<a name="line-133"></a><span class='hs-definition'>isFullyEvaluatedTerm</span> <span class='hs-conid'>Prim</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-134"></a><span class='hs-definition'>isFullyEvaluatedTerm</span> <span class='hs-conid'>NewtypeWrap</span><span class='hs-layout'>{</span><span class='hs-varid'>wrapped_term</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>t</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isFullyEvaluatedTerm</span> <span class='hs-varid'>t</span>
<a name="line-135"></a><span class='hs-definition'>isFullyEvaluatedTerm</span> <span class='hs-conid'>RefWrap</span><span class='hs-layout'>{</span><span class='hs-varid'>wrapped_term</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>t</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isFullyEvaluatedTerm</span> <span class='hs-varid'>t</span>
<a name="line-136"></a><span class='hs-definition'>isFullyEvaluatedTerm</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-137"></a>
<a name="line-138"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Outputable</span> <span class='hs-layout'>(</span><span class='hs-conid'>Term</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-139"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>doc</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>cPprTerm</span> <span class='hs-varid'>cPprTermBase</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>doc</span>
<a name="line-140"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"Outputable Term instance"</span>
<a name="line-141"></a>
<a name="line-142"></a><a name="ClosureType"></a><span class='hs-comment'>-------------------------------------------------------------------------</span>
<a name="line-143"></a><a name="ClosureType"></a><span class='hs-comment'>-- Runtime Closure Datatype and functions for retrieving closure related stuff</span>
<a name="line-144"></a><a name="ClosureType"></a><span class='hs-comment'>-------------------------------------------------------------------------</span>
<a name="line-145"></a><a name="ClosureType"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>ClosureType</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Constr</span>
<a name="line-146"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Fun</span>
<a name="line-147"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Thunk</span> <span class='hs-conid'>Int</span>
<a name="line-148"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>ThunkSelector</span>
<a name="line-149"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Blackhole</span>
<a name="line-150"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>AP</span>
<a name="line-151"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>PAP</span>
<a name="line-152"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Indirection</span> <span class='hs-conid'>Int</span>
<a name="line-153"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>MutVar</span> <span class='hs-conid'>Int</span>
<a name="line-154"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>MVar</span> <span class='hs-conid'>Int</span>
<a name="line-155"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Other</span> <span class='hs-conid'>Int</span>
<a name="line-156"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Show</span><span class='hs-layout'>,</span> <span class='hs-conid'>Eq</span><span class='hs-layout'>)</span>
<a name="line-157"></a>
<a name="line-158"></a><a name="Closure"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Closure</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Closure</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tipe</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ClosureType</span>
<a name="line-159"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>infoPtr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Ptr</span> <span class='hs-conid'>()</span>
<a name="line-160"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>infoTable</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>StgInfoTable</span>
<a name="line-161"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ptrs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Array</span> <span class='hs-conid'>Int</span> <span class='hs-conid'>HValue</span>
<a name="line-162"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>nonPtrs</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Word</span><span class='hs-keyglyph'>]</span>
<a name="line-163"></a> <span class='hs-layout'>}</span>
<a name="line-164"></a>
<a name="line-165"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Outputable</span> <span class='hs-conid'>ClosureType</span> <span class='hs-keyword'>where</span>
<a name="line-166"></a> <span class='hs-varid'>ppr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-varop'>.</span> <span class='hs-varid'>show</span>
<a name="line-167"></a>
<a name="line-168"></a><span class='hs-cpp'>#include "../includes/rts/storage/ClosureTypes.h"</span>
<a name="line-169"></a>
<a name="line-170"></a><a name="aP_CODE"></a><span class='hs-definition'>aP_CODE</span><span class='hs-layout'>,</span> <span class='hs-varid'>pAP_CODE</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span>
<a name="line-171"></a><span class='hs-definition'>aP_CODE</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AP</span>
<a name="line-172"></a><a name="pAP_CODE"></a><span class='hs-definition'>pAP_CODE</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PAP</span>
<a name="line-173"></a><span class='hs-cpp'>#undef AP</span>
<a name="line-174"></a><span class='hs-cpp'>#undef PAP</span>
<a name="line-175"></a>
<a name="line-176"></a><a name="getClosureData"></a><span class='hs-definition'>getClosureData</span> <span class='hs-keyglyph'>::</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>Closure</span>
<a name="line-177"></a><span class='hs-definition'>getClosureData</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span>
<a name="line-178"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>unpackClosure</span><span class='hs-cpp'>#</span> <span class='hs-varid'>a</span> <span class='hs-keyword'>of</span>
<a name="line-179"></a> <span class='hs-layout'>(</span><span class='hs-cpp'>#</span> <span class='hs-varid'>iptr</span><span class='hs-layout'>,</span> <span class='hs-varid'>ptrs</span><span class='hs-layout'>,</span> <span class='hs-varid'>nptrs</span> <span class='hs-cpp'>#</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-180"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>iptr'</span>
<a name="line-181"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>ghciTablesNextToCode</span> <span class='hs-keyglyph'>=</span>
<a name="line-182"></a> <span class='hs-conid'>Ptr</span> <span class='hs-varid'>iptr</span>
<a name="line-183"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span>
<a name="line-184"></a> <span class='hs-comment'>-- the info pointer we get back from unpackClosure#</span>
<a name="line-185"></a> <span class='hs-comment'>-- is to the beginning of the standard info table,</span>
<a name="line-186"></a> <span class='hs-comment'>-- but the Storable instance for info tables takes</span>
<a name="line-187"></a> <span class='hs-comment'>-- into account the extra entry pointer when</span>
<a name="line-188"></a> <span class='hs-comment'>-- !ghciTablesNextToCode, so we must adjust here:</span>
<a name="line-189"></a> <span class='hs-conid'>Ptr</span> <span class='hs-varid'>iptr</span> <span class='hs-varop'>`plusPtr`</span> <span class='hs-varid'>negate</span> <span class='hs-varid'>wORD_SIZE</span>
<a name="line-190"></a> <span class='hs-varid'>itbl</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>peek</span> <span class='hs-varid'>iptr'</span>
<a name="line-191"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>tipe</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>readCType</span> <span class='hs-layout'>(</span><span class='hs-conid'>BCI</span><span class='hs-varop'>.</span><span class='hs-varid'>tipe</span> <span class='hs-varid'>itbl</span><span class='hs-layout'>)</span>
<a name="line-192"></a> <span class='hs-varid'>elems</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fromIntegral</span> <span class='hs-layout'>(</span><span class='hs-conid'>BCI</span><span class='hs-varop'>.</span><span class='hs-varid'>ptrs</span> <span class='hs-varid'>itbl</span><span class='hs-layout'>)</span>
<a name="line-193"></a> <span class='hs-varid'>ptrsList</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Array</span> <span class='hs-num'>0</span> <span class='hs-layout'>(</span><span class='hs-varid'>elems</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-varid'>elems</span> <span class='hs-varid'>ptrs</span>
<a name="line-194"></a> <span class='hs-varid'>nptrs_data</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>W</span><span class='hs-cpp'>#</span> <span class='hs-layout'>(</span><span class='hs-varid'>indexWordArray</span><span class='hs-cpp'>#</span> <span class='hs-varid'>nptrs</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span>
<a name="line-195"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>I</span><span class='hs-cpp'>#</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span><span class='hs-keyglyph'>..</span> <span class='hs-varid'>fromIntegral</span> <span class='hs-layout'>(</span><span class='hs-conid'>BCI</span><span class='hs-varop'>.</span><span class='hs-varid'>nptrs</span> <span class='hs-varid'>itbl</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>]</span>
<a name="line-196"></a> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span><span class='hs-varid'>elems</span> <span class='hs-varop'>>=</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-197"></a> <span class='hs-varid'>ptrsList</span> <span class='hs-varop'>`seq`</span>
<a name="line-198"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Closure</span> <span class='hs-varid'>tipe</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ptr</span> <span class='hs-varid'>iptr</span><span class='hs-layout'>)</span> <span class='hs-varid'>itbl</span> <span class='hs-varid'>ptrsList</span> <span class='hs-varid'>nptrs_data</span><span class='hs-layout'>)</span>
<a name="line-199"></a>
<a name="line-200"></a><a name="readCType"></a><span class='hs-definition'>readCType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Integral</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'>ClosureType</span>
<a name="line-201"></a><span class='hs-definition'>readCType</span> <span class='hs-varid'>i</span>
<a name="line-202"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i</span> <span class='hs-varop'>>=</span> <span class='hs-conid'>CONSTR</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>i</span> <span class='hs-varop'><=</span> <span class='hs-conid'>CONSTR_NOCAF_STATIC</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Constr</span>
<a name="line-203"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i</span> <span class='hs-varop'>>=</span> <span class='hs-conid'>FUN</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>i</span> <span class='hs-varop'><=</span> <span class='hs-conid'>FUN_STATIC</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Fun</span>
<a name="line-204"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i</span> <span class='hs-varop'>>=</span> <span class='hs-conid'>THUNK</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>i</span> <span class='hs-varop'><</span> <span class='hs-conid'>THUNK_SELECTOR</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Thunk</span> <span class='hs-varid'>i'</span>
<a name="line-205"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i</span> <span class='hs-varop'>==</span> <span class='hs-conid'>THUNK_SELECTOR</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ThunkSelector</span>
<a name="line-206"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i</span> <span class='hs-varop'>==</span> <span class='hs-conid'>BLACKHOLE</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Blackhole</span>
<a name="line-207"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i</span> <span class='hs-varop'>>=</span> <span class='hs-conid'>IND</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>i</span> <span class='hs-varop'><=</span> <span class='hs-conid'>IND_STATIC</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Indirection</span> <span class='hs-varid'>i'</span>
<a name="line-208"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i'</span> <span class='hs-varop'>==</span> <span class='hs-varid'>aP_CODE</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AP</span>
<a name="line-209"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i</span> <span class='hs-varop'>==</span> <span class='hs-conid'>AP_STACK</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AP</span>
<a name="line-210"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i'</span> <span class='hs-varop'>==</span> <span class='hs-varid'>pAP_CODE</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PAP</span>
<a name="line-211"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i</span> <span class='hs-varop'>==</span> <span class='hs-conid'>MUT_VAR_CLEAN</span> <span class='hs-varop'>||</span> <span class='hs-varid'>i</span> <span class='hs-varop'>==</span> <span class='hs-conid'>MUT_VAR_DIRTY</span><span class='hs-keyglyph'>=</span> <span class='hs-conid'>MutVar</span> <span class='hs-varid'>i'</span>
<a name="line-212"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i</span> <span class='hs-varop'>==</span> <span class='hs-conid'>MVAR_CLEAN</span> <span class='hs-varop'>||</span> <span class='hs-varid'>i</span> <span class='hs-varop'>==</span> <span class='hs-conid'>MVAR_DIRTY</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MVar</span> <span class='hs-varid'>i'</span>
<a name="line-213"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Other</span> <span class='hs-varid'>i'</span>
<a name="line-214"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>i'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>i</span>
<a name="line-215"></a>
<a name="line-216"></a><a name="isConstr"></a><span class='hs-definition'>isConstr</span><span class='hs-layout'>,</span> <span class='hs-varid'>isIndirection</span><span class='hs-layout'>,</span> <span class='hs-varid'>isThunk</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ClosureType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-217"></a><span class='hs-definition'>isConstr</span> <span class='hs-conid'>Constr</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-218"></a><span class='hs-definition'>isConstr</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-219"></a>
<a name="line-220"></a><a name="isIndirection"></a><span class='hs-definition'>isIndirection</span> <span class='hs-layout'>(</span><span class='hs-conid'>Indirection</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-221"></a><span class='hs-definition'>isIndirection</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-222"></a>
<a name="line-223"></a><a name="isThunk"></a><span class='hs-definition'>isThunk</span> <span class='hs-layout'>(</span><span class='hs-conid'>Thunk</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-224"></a><span class='hs-definition'>isThunk</span> <span class='hs-conid'>ThunkSelector</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-225"></a><span class='hs-definition'>isThunk</span> <span class='hs-conid'>AP</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-226"></a><span class='hs-definition'>isThunk</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-227"></a>
<a name="line-228"></a><a name="isFullyEvaluated"></a><span class='hs-definition'>isFullyEvaluated</span> <span class='hs-keyglyph'>::</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>Bool</span>
<a name="line-229"></a><span class='hs-definition'>isFullyEvaluated</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-230"></a> <span class='hs-varid'>closure</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getClosureData</span> <span class='hs-varid'>a</span>
<a name="line-231"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>tipe</span> <span class='hs-varid'>closure</span> <span class='hs-keyword'>of</span>
<a name="line-232"></a> <span class='hs-conid'>Constr</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-varid'>are_subs_evaluated</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>amapM</span> <span class='hs-varid'>isFullyEvaluated</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptrs</span> <span class='hs-varid'>closure</span><span class='hs-layout'>)</span>
<a name="line-233"></a> <span class='hs-varid'>return</span><span class='hs-varop'>$</span> <span class='hs-varid'>and</span> <span class='hs-varid'>are_subs_evaluated</span>
<a name="line-234"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>False</span>
<a name="line-235"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>amapM</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sequence</span> <span class='hs-varop'>.</span> <span class='hs-varid'>amap'</span> <span class='hs-varid'>f</span>
<a name="line-236"></a>
<a name="line-237"></a><span class='hs-comment'>-- TODO: Fix it. Probably the otherwise case is failing, trace/debug it</span>
<a name="line-238"></a><span class='hs-comment'>{-
<a name="line-239"></a>unsafeDeepSeq :: a -> b -> b
<a name="line-240"></a>unsafeDeepSeq = unsafeDeepSeq1 2
<a name="line-241"></a> where unsafeDeepSeq1 0 a b = seq a $! b
<a name="line-242"></a> unsafeDeepSeq1 i a b -- 1st case avoids infinite loops for non reducible thunks
<a name="line-243"></a> | not (isConstr tipe) = seq a $! unsafeDeepSeq1 (i-1) a b
<a name="line-244"></a> -- | unsafePerformIO (isFullyEvaluated a) = b
<a name="line-245"></a> | otherwise = case unsafePerformIO (getClosureData a) of
<a name="line-246"></a> closure -> foldl' (flip unsafeDeepSeq) b (ptrs closure)
<a name="line-247"></a> where tipe = unsafePerformIO (getClosureType a)
<a name="line-248"></a>-}</span>
<a name="line-249"></a>
<a name="line-250"></a><a name="TermProcessor"></a><span class='hs-comment'>-----------------------------------</span>
<a name="line-251"></a><a name="TermProcessor"></a><span class='hs-comment'>-- * Traversals for Terms</span>
<a name="line-252"></a><a name="TermProcessor"></a><span class='hs-comment'>-----------------------------------</span>
<a name="line-253"></a><a name="TermProcessor"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>TermProcessor</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Either</span> <span class='hs-conid'>String</span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HValue</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span>
<a name="line-254"></a>
<a name="line-255"></a><a name="TermFold"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>TermFold</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>TermFold</span> <span class='hs-layout'>{</span> <span class='hs-varid'>fTerm</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TermProcessor</span> <span class='hs-varid'>a</span> <span class='hs-varid'>a</span>
<a name="line-256"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>fPrim</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Word</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span>
<a name="line-257"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>fSuspension</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ClosureType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HValue</span>
<a name="line-258"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span>
<a name="line-259"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>fNewtypeWrap</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Either</span> <span class='hs-conid'>String</span> <span class='hs-conid'>DataCon</span>
<a name="line-260"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span>
<a name="line-261"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>fRefWrap</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span>
<a name="line-262"></a> <span class='hs-layout'>}</span>
<a name="line-263"></a>
<a name="line-264"></a>
<a name="line-265"></a><a name="TermFoldM"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>TermFoldM</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span>
<a name="line-266"></a> <span class='hs-conid'>TermFoldM</span> <span class='hs-layout'>{</span><span class='hs-varid'>fTermM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TermProcessor</span> <span class='hs-varid'>a</span> <span class='hs-layout'>(</span><span class='hs-varid'>m</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-267"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>fPrimM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Word</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-268"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>fSuspensionM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ClosureType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HValue</span>
<a name="line-269"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-270"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>fNewtypeWrapM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Either</span> <span class='hs-conid'>String</span> <span class='hs-conid'>DataCon</span>
<a name="line-271"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-272"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>fRefWrapM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-273"></a> <span class='hs-layout'>}</span>
<a name="line-274"></a>
<a name="line-275"></a><a name="foldTerm"></a><span class='hs-definition'>foldTerm</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TermFold</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span>
<a name="line-276"></a><span class='hs-definition'>foldTerm</span> <span class='hs-varid'>tf</span> <span class='hs-layout'>(</span><span class='hs-conid'>Term</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>v</span> <span class='hs-varid'>tt</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fTerm</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>v</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>foldTerm</span> <span class='hs-varid'>tf</span><span class='hs-layout'>)</span> <span class='hs-varid'>tt</span><span class='hs-layout'>)</span>
<a name="line-277"></a><span class='hs-definition'>foldTerm</span> <span class='hs-varid'>tf</span> <span class='hs-layout'>(</span><span class='hs-conid'>Prim</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>v</span> <span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fPrim</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>v</span>
<a name="line-278"></a><span class='hs-definition'>foldTerm</span> <span class='hs-varid'>tf</span> <span class='hs-layout'>(</span><span class='hs-conid'>Suspension</span> <span class='hs-varid'>ct</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>v</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fSuspension</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>ct</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>v</span> <span class='hs-varid'>b</span>
<a name="line-279"></a><span class='hs-definition'>foldTerm</span> <span class='hs-varid'>tf</span> <span class='hs-layout'>(</span><span class='hs-conid'>NewtypeWrap</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fNewtypeWrap</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-layout'>(</span><span class='hs-varid'>foldTerm</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span>
<a name="line-280"></a><span class='hs-definition'>foldTerm</span> <span class='hs-varid'>tf</span> <span class='hs-layout'>(</span><span class='hs-conid'>RefWrap</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fRefWrap</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>foldTerm</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span>
<a name="line-281"></a>
<a name="line-282"></a>
<a name="line-283"></a><a name="foldTermM"></a><span class='hs-definition'>foldTermM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>TermFoldM</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-284"></a><span class='hs-definition'>foldTermM</span> <span class='hs-varid'>tf</span> <span class='hs-layout'>(</span><span class='hs-conid'>Term</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>v</span> <span class='hs-varid'>tt</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>foldTermM</span> <span class='hs-varid'>tf</span><span class='hs-layout'>)</span> <span class='hs-varid'>tt</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>fTermM</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>v</span>
<a name="line-285"></a><span class='hs-definition'>foldTermM</span> <span class='hs-varid'>tf</span> <span class='hs-layout'>(</span><span class='hs-conid'>Prim</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>v</span> <span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fPrimM</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>v</span>
<a name="line-286"></a><span class='hs-definition'>foldTermM</span> <span class='hs-varid'>tf</span> <span class='hs-layout'>(</span><span class='hs-conid'>Suspension</span> <span class='hs-varid'>ct</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>v</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fSuspensionM</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>ct</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>v</span> <span class='hs-varid'>b</span>
<a name="line-287"></a><span class='hs-definition'>foldTermM</span> <span class='hs-varid'>tf</span> <span class='hs-layout'>(</span><span class='hs-conid'>NewtypeWrap</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldTermM</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>t</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>fNewtypeWrapM</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span>
<a name="line-288"></a><span class='hs-definition'>foldTermM</span> <span class='hs-varid'>tf</span> <span class='hs-layout'>(</span><span class='hs-conid'>RefWrap</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldTermM</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>t</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>fRefWrapM</span> <span class='hs-varid'>tf</span> <span class='hs-varid'>ty</span>
<a name="line-289"></a>
<a name="line-290"></a><a name="idTermFold"></a><span class='hs-definition'>idTermFold</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TermFold</span> <span class='hs-conid'>Term</span>
<a name="line-291"></a><span class='hs-definition'>idTermFold</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>TermFold</span> <span class='hs-layout'>{</span>
<a name="line-292"></a> <span class='hs-varid'>fTerm</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Term</span><span class='hs-layout'>,</span>
<a name="line-293"></a> <span class='hs-varid'>fPrim</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Prim</span><span class='hs-layout'>,</span>
<a name="line-294"></a> <span class='hs-varid'>fSuspension</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Suspension</span><span class='hs-layout'>,</span>
<a name="line-295"></a> <span class='hs-varid'>fNewtypeWrap</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>NewtypeWrap</span><span class='hs-layout'>,</span>
<a name="line-296"></a> <span class='hs-varid'>fRefWrap</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RefWrap</span>
<a name="line-297"></a> <span class='hs-layout'>}</span>
<a name="line-298"></a>
<a name="line-299"></a><a name="mapTermType"></a><span class='hs-definition'>mapTermType</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Term</span>
<a name="line-300"></a><span class='hs-definition'>mapTermType</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldTerm</span> <span class='hs-varid'>idTermFold</span> <span class='hs-layout'>{</span>
<a name="line-301"></a> <span class='hs-varid'>fTerm</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>tt</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Term</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>tt</span><span class='hs-layout'>,</span>
<a name="line-302"></a> <span class='hs-varid'>fSuspension</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ct</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>-></span>
<a name="line-303"></a> <span class='hs-conid'>Suspension</span> <span class='hs-varid'>ct</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>n</span><span class='hs-layout'>,</span>
<a name="line-304"></a> <span class='hs-varid'>fNewtypeWrap</span><span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NewtypeWrap</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>t</span><span class='hs-layout'>,</span>
<a name="line-305"></a> <span class='hs-varid'>fRefWrap</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RefWrap</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>t</span><span class='hs-layout'>}</span>
<a name="line-306"></a>
<a name="line-307"></a><a name="mapTermTypeM"></a><span class='hs-definition'>mapTermTypeM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>Term</span>
<a name="line-308"></a><span class='hs-definition'>mapTermTypeM</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldTermM</span> <span class='hs-conid'>TermFoldM</span> <span class='hs-layout'>{</span>
<a name="line-309"></a> <span class='hs-varid'>fTermM</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>tt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>f</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty'</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Term</span> <span class='hs-varid'>ty'</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>tt</span><span class='hs-layout'>,</span>
<a name="line-310"></a> <span class='hs-varid'>fPrimM</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span><span class='hs-varop'>.</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-conid'>Prim</span><span class='hs-layout'>,</span>
<a name="line-311"></a> <span class='hs-varid'>fSuspensionM</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ct</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>-></span>
<a name="line-312"></a> <span class='hs-varid'>f</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty'</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Suspension</span> <span class='hs-varid'>ct</span> <span class='hs-varid'>ty'</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>n</span><span class='hs-layout'>,</span>
<a name="line-313"></a> <span class='hs-varid'>fNewtypeWrapM</span><span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>f</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty'</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>NewtypeWrap</span> <span class='hs-varid'>ty'</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>t</span><span class='hs-layout'>,</span>
<a name="line-314"></a> <span class='hs-varid'>fRefWrapM</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>f</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty'</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>RefWrap</span> <span class='hs-varid'>ty'</span> <span class='hs-varid'>t</span><span class='hs-layout'>}</span>
<a name="line-315"></a>
<a name="line-316"></a><a name="termTyVars"></a><span class='hs-definition'>termTyVars</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TyVarSet</span>
<a name="line-317"></a><span class='hs-definition'>termTyVars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldTerm</span> <span class='hs-conid'>TermFold</span> <span class='hs-layout'>{</span>
<a name="line-318"></a> <span class='hs-varid'>fTerm</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>tt</span> <span class='hs-keyglyph'>-></span>
<a name="line-319"></a> <span class='hs-varid'>tyVarsOfType</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>`plusVarEnv`</span> <span class='hs-varid'>concatVarEnv</span> <span class='hs-varid'>tt</span><span class='hs-layout'>,</span>
<a name="line-320"></a> <span class='hs-varid'>fSuspension</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-keyword'>_</span> <span class='hs-varid'>ty</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>tyVarsOfType</span> <span class='hs-varid'>ty</span><span class='hs-layout'>,</span>
<a name="line-321"></a> <span class='hs-varid'>fPrim</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>emptyVarEnv</span><span class='hs-layout'>,</span>
<a name="line-322"></a> <span class='hs-varid'>fNewtypeWrap</span><span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>tyVarsOfType</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>`plusVarEnv`</span> <span class='hs-varid'>t</span><span class='hs-layout'>,</span>
<a name="line-323"></a> <span class='hs-varid'>fRefWrap</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>tyVarsOfType</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>`plusVarEnv`</span> <span class='hs-varid'>t</span><span class='hs-layout'>}</span>
<a name="line-324"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>concatVarEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-varid'>plusVarEnv</span> <span class='hs-varid'>emptyVarEnv</span>
<a name="line-325"></a>
<a name="line-326"></a><span class='hs-comment'>----------------------------------</span>
<a name="line-327"></a><span class='hs-comment'>-- Pretty printing of terms</span>
<a name="line-328"></a><span class='hs-comment'>----------------------------------</span>
<a name="line-329"></a>
<a name="line-330"></a><a name="Precedence"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>Precedence</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Int</span>
<a name="line-331"></a><a name="TermPrinter"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>TermPrinter</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Precedence</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-332"></a><a name="TermPrinterM"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>TermPrinterM</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Precedence</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>SDoc</span>
<a name="line-333"></a>
<a name="line-334"></a><a name="app_prec"></a><span class='hs-definition'>app_prec</span><span class='hs-layout'>,</span><span class='hs-varid'>cons_prec</span><span class='hs-layout'>,</span> <span class='hs-varid'>max_prec</span> <span class='hs-keyglyph'>::</span><span class='hs-conid'>Int</span>
<a name="line-335"></a><a name="max_prec"></a><span class='hs-definition'>max_prec</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>10</span>
<a name="line-336"></a><span class='hs-definition'>app_prec</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>max_prec</span>
<a name="line-337"></a><a name="cons_prec"></a><span class='hs-definition'>cons_prec</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>5</span> <span class='hs-comment'>-- TODO Extract this info from GHC itself</span>
<a name="line-338"></a>
<a name="line-339"></a><a name="pprTerm"></a><span class='hs-definition'>pprTerm</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TermPrinter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TermPrinter</span>
<a name="line-340"></a><span class='hs-definition'>pprTerm</span> <span class='hs-varid'>y</span> <span class='hs-varid'>p</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>doc</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>pprTermM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>p</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Just</span> <span class='hs-varop'>.</span> <span class='hs-varid'>y</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span> <span class='hs-varid'>p</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>doc</span>
<a name="line-341"></a><span class='hs-definition'>pprTerm</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"pprTerm"</span>
<a name="line-342"></a>
<a name="line-343"></a><a name="pprTermM"></a><span class='hs-definition'>pprTermM</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppr_termM</span><span class='hs-layout'>,</span> <span class='hs-varid'>pprNewtypeWrap</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>TermPrinterM</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TermPrinterM</span> <span class='hs-varid'>m</span>
<a name="line-344"></a><span class='hs-definition'>pprTermM</span> <span class='hs-varid'>y</span> <span class='hs-varid'>p</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprDeeper</span> <span class='hs-varop'>`liftM`</span> <span class='hs-varid'>ppr_termM</span> <span class='hs-varid'>y</span> <span class='hs-varid'>p</span> <span class='hs-varid'>t</span>
<a name="line-345"></a>
<a name="line-346"></a><a name="ppr_termM"></a><span class='hs-definition'>ppr_termM</span> <span class='hs-varid'>y</span> <span class='hs-varid'>p</span> <span class='hs-conid'>Term</span><span class='hs-layout'>{</span><span class='hs-varid'>dc</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Left</span> <span class='hs-varid'>dc_tag</span><span class='hs-layout'>,</span> <span class='hs-varid'>subTerms</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>tt</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-347"></a> <span class='hs-varid'>tt_docs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>y</span> <span class='hs-varid'>app_prec</span><span class='hs-layout'>)</span> <span class='hs-varid'>tt</span>
<a name="line-348"></a> <span class='hs-varid'>return</span><span class='hs-varop'>$</span> <span class='hs-varid'>cparen</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'>tt</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>p</span> <span class='hs-varop'>>=</span> <span class='hs-varid'>app_prec</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-varid'>dc_tag</span> <span class='hs-varop'><+></span> <span class='hs-varid'>pprDeeperList</span> <span class='hs-varid'>fsep</span> <span class='hs-varid'>tt_docs</span><span class='hs-layout'>)</span>
<a name="line-349"></a>
<a name="line-350"></a><span class='hs-definition'>ppr_termM</span> <span class='hs-varid'>y</span> <span class='hs-varid'>p</span> <span class='hs-conid'>Term</span><span class='hs-layout'>{</span><span class='hs-varid'>dc</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Right</span> <span class='hs-varid'>dc</span><span class='hs-layout'>,</span> <span class='hs-varid'>subTerms</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>tt</span><span class='hs-layout'>}</span>
<a name="line-351"></a><span class='hs-comment'>{- | dataConIsInfix dc, (t1:t2:tt') <- tt --TODO fixity
<a name="line-352"></a> = parens (ppr_term1 True t1 <+> ppr dc <+> ppr_term1 True ppr t2)
<a name="line-353"></a> <+> hsep (map (ppr_term1 True) tt)
<a name="line-354"></a>-}</span> <span class='hs-comment'>-- TODO Printing infix constructors properly</span>
<a name="line-355"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>null</span> <span class='hs-varid'>tt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span><span class='hs-varop'>$</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>dc</span>
<a name="line-356"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-357"></a> <span class='hs-varid'>tt_docs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>y</span> <span class='hs-varid'>app_prec</span><span class='hs-layout'>)</span> <span class='hs-varid'>tt</span>
<a name="line-358"></a> <span class='hs-varid'>return</span><span class='hs-varop'>$</span> <span class='hs-varid'>cparen</span> <span class='hs-layout'>(</span><span class='hs-varid'>p</span> <span class='hs-varop'>>=</span> <span class='hs-varid'>app_prec</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>dc</span> <span class='hs-varop'><+></span> <span class='hs-varid'>pprDeeperList</span> <span class='hs-varid'>fsep</span> <span class='hs-varid'>tt_docs</span><span class='hs-layout'>)</span>
<a name="line-359"></a>
<a name="line-360"></a><span class='hs-definition'>ppr_termM</span> <span class='hs-varid'>y</span> <span class='hs-varid'>p</span> <span class='hs-varid'>t</span><span class='hs-keyglyph'>@</span><span class='hs-conid'>NewtypeWrap</span><span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprNewtypeWrap</span> <span class='hs-varid'>y</span> <span class='hs-varid'>p</span> <span class='hs-varid'>t</span>
<a name="line-361"></a><span class='hs-definition'>ppr_termM</span> <span class='hs-varid'>y</span> <span class='hs-varid'>p</span> <span class='hs-conid'>RefWrap</span><span class='hs-layout'>{</span><span class='hs-varid'>wrapped_term</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>t</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-362"></a> <span class='hs-varid'>contents</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>y</span> <span class='hs-varid'>app_prec</span> <span class='hs-varid'>t</span>
<a name="line-363"></a> <span class='hs-varid'>return</span><span class='hs-varop'>$</span> <span class='hs-varid'>cparen</span> <span class='hs-layout'>(</span><span class='hs-varid'>p</span> <span class='hs-varop'>>=</span> <span class='hs-varid'>app_prec</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"GHC.Prim.MutVar#"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>contents</span><span class='hs-layout'>)</span>
<a name="line-364"></a> <span class='hs-comment'>-- The constructor name is wired in here ^^^ for the sake of simplicity.</span>
<a name="line-365"></a> <span class='hs-comment'>-- I don't think mutvars are going to change in a near future.</span>
<a name="line-366"></a> <span class='hs-comment'>-- In any case this is solely a presentation matter: MutVar# is</span>
<a name="line-367"></a> <span class='hs-comment'>-- a datatype with no constructors, implemented by the RTS</span>
<a name="line-368"></a> <span class='hs-comment'>-- (hence there is no way to obtain a datacon and print it).</span>
<a name="line-369"></a><span class='hs-definition'>ppr_termM</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr_termM1</span> <span class='hs-varid'>t</span>
<a name="line-370"></a>
<a name="line-371"></a>
<a name="line-372"></a><a name="ppr_termM1"></a><span class='hs-definition'>ppr_termM1</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>SDoc</span>
<a name="line-373"></a><span class='hs-definition'>ppr_termM1</span> <span class='hs-conid'>Prim</span><span class='hs-layout'>{</span><span class='hs-varid'>value</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>words</span><span class='hs-layout'>,</span> <span class='hs-varid'>ty</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>ty</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span>
<a name="line-374"></a> <span class='hs-varid'>return</span><span class='hs-varop'>$</span> <span class='hs-varid'>text</span><span class='hs-varop'>$</span> <span class='hs-varid'>repPrim</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConAppTyCon</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>words</span>
<a name="line-375"></a><span class='hs-definition'>ppr_termM1</span> <span class='hs-conid'>Suspension</span><span class='hs-layout'>{</span><span class='hs-varid'>ty</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>bound_to</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Nothing</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span>
<a name="line-376"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>char</span> <span class='hs-chr'>'_'</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ifPprDebug</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"::"</span> <span class='hs-varop'><></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-377"></a><span class='hs-definition'>ppr_termM1</span> <span class='hs-conid'>Suspension</span><span class='hs-layout'>{</span><span class='hs-varid'>ty</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>bound_to</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Just</span> <span class='hs-varid'>n</span><span class='hs-layout'>}</span>
<a name="line-378"></a><span class='hs-comment'>-- | Just _ <- splitFunTy_maybe ty = return$ ptext (sLit("<function>")</span>
<a name="line-379"></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-varop'>$</span> <span class='hs-varid'>parens</span><span class='hs-varop'>$</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>n</span> <span class='hs-varop'><></span> <span class='hs-varid'>text</span> <span class='hs-str'>"::"</span> <span class='hs-varop'><></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>ty</span>
<a name="line-380"></a><span class='hs-definition'>ppr_termM1</span> <span class='hs-conid'>Term</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'>"ppr_termM1 - Term"</span>
<a name="line-381"></a><span class='hs-definition'>ppr_termM1</span> <span class='hs-conid'>RefWrap</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'>"ppr_termM1 - RefWrap"</span>
<a name="line-382"></a><span class='hs-definition'>ppr_termM1</span> <span class='hs-conid'>NewtypeWrap</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'>"ppr_termM1 - NewtypeWrap"</span>
<a name="line-383"></a>
<a name="line-384"></a><a name="pprNewtypeWrap"></a><span class='hs-definition'>pprNewtypeWrap</span> <span class='hs-varid'>y</span> <span class='hs-varid'>p</span> <span class='hs-conid'>NewtypeWrap</span><span class='hs-layout'>{</span><span class='hs-varid'>ty</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>wrapped_term</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>t</span><span class='hs-layout'>}</span>
<a name="line-385"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tc</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'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>ty</span>
<a name="line-386"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>ASSERT</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-conid'>True</span>
<a name="line-387"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>new_dc</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tyConSingleDataCon_maybe</span> <span class='hs-varid'>tc</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-388"></a> <span class='hs-varid'>real_term</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>y</span> <span class='hs-varid'>max_prec</span> <span class='hs-varid'>t</span>
<a name="line-389"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>cparen</span> <span class='hs-layout'>(</span><span class='hs-varid'>p</span> <span class='hs-varop'>>=</span> <span class='hs-varid'>app_prec</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>new_dc</span> <span class='hs-varop'><+></span> <span class='hs-varid'>real_term</span><span class='hs-layout'>)</span>
<a name="line-390"></a><span class='hs-definition'>pprNewtypeWrap</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"pprNewtypeWrap"</span>
<a name="line-391"></a>
<a name="line-392"></a><span class='hs-comment'>-------------------------------------------------------</span>
<a name="line-393"></a><span class='hs-comment'>-- Custom Term Pretty Printers</span>
<a name="line-394"></a><span class='hs-comment'>-------------------------------------------------------</span>
<a name="line-395"></a>
<a name="line-396"></a><span class='hs-comment'>-- We can want to customize the representation of a </span>
<a name="line-397"></a><span class='hs-comment'>-- term depending on its type. </span>
<a name="line-398"></a><span class='hs-comment'>-- However, note that custom printers have to work with</span>
<a name="line-399"></a><span class='hs-comment'>-- type representations, instead of directly with types.</span>
<a name="line-400"></a><span class='hs-comment'>-- We cannot use type classes here, unless we employ some </span>
<a name="line-401"></a><span class='hs-comment'>-- typerep trickery (e.g. Weirich's RepLib tricks),</span>
<a name="line-402"></a><span class='hs-comment'>-- which I didn't. Therefore, this code replicates a lot</span>
<a name="line-403"></a><span class='hs-comment'>-- of what type classes provide for free.</span>
<a name="line-404"></a>
<a name="line-405"></a><a name="CustomTermPrinter"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>CustomTermPrinter</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>TermPrinterM</span> <span class='hs-varid'>m</span>
<a name="line-406"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Precedence</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>SDoc</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-407"></a>
<a name="line-408"></a><a name="cPprTerm"></a><span class='hs-comment'>-- | Takes a list of custom printers with a explicit recursion knot and a term, </span>
<a name="line-409"></a><span class='hs-comment'>-- and returns the output of the first succesful printer, or the default printer</span>
<a name="line-410"></a><span class='hs-definition'>cPprTerm</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>CustomTermPrinter</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>SDoc</span>
<a name="line-411"></a><span class='hs-definition'>cPprTerm</span> <span class='hs-varid'>printers_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-num'>0</span> <span class='hs-keyword'>where</span>
<a name="line-412"></a> <span class='hs-varid'>printers</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>printers_</span> <span class='hs-varid'>go</span>
<a name="line-413"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>prec</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-414"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>default_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varop'>`liftM`</span> <span class='hs-varid'>pprTermM</span> <span class='hs-varid'>go</span> <span class='hs-varid'>prec</span> <span class='hs-varid'>t</span>
<a name="line-415"></a> <span class='hs-varid'>mb_customDocs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>pp</span> <span class='hs-varid'>prec</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>pp</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>printers</span><span class='hs-keyglyph'>]</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>default_</span><span class='hs-keyglyph'>]</span>
<a name="line-416"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>doc</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>firstJustM</span> <span class='hs-varid'>mb_customDocs</span>
<a name="line-417"></a> <span class='hs-varid'>return</span><span class='hs-varop'>$</span> <span class='hs-varid'>cparen</span> <span class='hs-layout'>(</span><span class='hs-varid'>prec</span><span class='hs-varop'>></span><span class='hs-varid'>app_prec</span><span class='hs-varop'>+</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-varid'>doc</span>
<a name="line-418"></a>
<a name="line-419"></a> <span class='hs-varid'>firstJustM</span> <span class='hs-layout'>(</span><span class='hs-varid'>mb</span><span class='hs-conop'>:</span><span class='hs-varid'>mbs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mb</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>maybe</span> <span class='hs-layout'>(</span><span class='hs-varid'>firstJustM</span> <span class='hs-varid'>mbs</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-varop'>.</span> <span class='hs-conid'>Just</span><span class='hs-layout'>)</span>
<a name="line-420"></a> <span class='hs-varid'>firstJustM</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span>
<a name="line-421"></a>
<a name="line-422"></a><a name="cPprTermBase"></a><span class='hs-comment'>-- Default set of custom printers. Note that the recursion knot is explicit</span>
<a name="line-423"></a><span class='hs-definition'>cPprTermBase</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>CustomTermPrinter</span> <span class='hs-varid'>m</span>
<a name="line-424"></a><span class='hs-definition'>cPprTermBase</span> <span class='hs-varid'>y</span> <span class='hs-keyglyph'>=</span>
<a name="line-425"></a> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>ifTerm</span> <span class='hs-layout'>(</span><span class='hs-varid'>isTupleTy</span><span class='hs-varop'>.</span><span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-sel'>_p</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>liftM</span> <span class='hs-layout'>(</span><span class='hs-varid'>parens</span> <span class='hs-varop'>.</span> <span class='hs-varid'>hcat</span> <span class='hs-varop'>.</span> <span class='hs-varid'>punctuate</span> <span class='hs-varid'>comma</span><span class='hs-layout'>)</span>
<a name="line-426"></a> <span class='hs-varop'>.</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>y</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-427"></a> <span class='hs-varop'>.</span> <span class='hs-varid'>subTerms</span><span class='hs-layout'>)</span>
<a name="line-428"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ifTerm</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>isTyCon</span> <span class='hs-varid'>listTyCon</span> <span class='hs-layout'>(</span><span class='hs-varid'>ty</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>subTerms</span> <span class='hs-varid'>t</span> <span class='hs-varop'>`lengthIs`</span> <span class='hs-num'>2</span><span class='hs-layout'>)</span>
<a name="line-429"></a> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>p</span> <span class='hs-conid'>Term</span><span class='hs-layout'>{</span><span class='hs-varid'>subTerms</span><span class='hs-keyglyph'>=</span><span class='hs-keyglyph'>[</span><span class='hs-varid'>h</span><span class='hs-layout'>,</span><span class='hs-varid'>t</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>doList</span> <span class='hs-varid'>p</span> <span class='hs-varid'>h</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span>
<a name="line-430"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ifTerm</span> <span class='hs-layout'>(</span><span class='hs-varid'>isTyCon</span> <span class='hs-varid'>intTyCon</span> <span class='hs-varop'>.</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>coerceShow</span><span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>::</span><span class='hs-conid'>Int</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>-></span><span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-431"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ifTerm</span> <span class='hs-layout'>(</span><span class='hs-varid'>isTyCon</span> <span class='hs-varid'>charTyCon</span> <span class='hs-varop'>.</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>coerceShow</span><span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>::</span><span class='hs-conid'>Char</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>-></span><span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-432"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ifTerm</span> <span class='hs-layout'>(</span><span class='hs-varid'>isTyCon</span> <span class='hs-varid'>floatTyCon</span> <span class='hs-varop'>.</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>coerceShow</span><span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>::</span><span class='hs-conid'>Float</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>-></span><span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-433"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ifTerm</span> <span class='hs-layout'>(</span><span class='hs-varid'>isTyCon</span> <span class='hs-varid'>doubleTyCon</span> <span class='hs-varop'>.</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>coerceShow</span><span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>::</span><span class='hs-conid'>Double</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>-></span><span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-434"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ifTerm</span> <span class='hs-layout'>(</span><span class='hs-varid'>isIntegerTy</span> <span class='hs-varop'>.</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>coerceShow</span><span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>::</span><span class='hs-conid'>Integer</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>-></span><span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-435"></a> <span class='hs-keyglyph'>]</span>
<a name="line-436"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>ifTerm</span> <span class='hs-varid'>pred</span> <span class='hs-varid'>f</span> <span class='hs-varid'>prec</span> <span class='hs-varid'>t</span><span class='hs-keyglyph'>@</span><span class='hs-conid'>Term</span><span class='hs-layout'>{</span><span class='hs-layout'>}</span>
<a name="line-437"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>pred</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varop'>`liftM`</span> <span class='hs-varid'>f</span> <span class='hs-varid'>prec</span> <span class='hs-varid'>t</span>
<a name="line-438"></a> <span class='hs-varid'>ifTerm</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span>
<a name="line-439"></a>
<a name="line-440"></a> <span class='hs-varid'>isTupleTy</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fromMaybe</span> <span class='hs-conid'>False</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-441"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tc</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'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>ty</span>
<a name="line-442"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>isBoxedTupleTyCon</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
<a name="line-443"></a>
<a name="line-444"></a> <span class='hs-varid'>isTyCon</span> <span class='hs-varid'>a_tc</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fromMaybe</span> <span class='hs-conid'>False</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-445"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tc</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'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>ty</span>
<a name="line-446"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>a_tc</span> <span class='hs-varop'>==</span> <span class='hs-varid'>tc</span><span class='hs-layout'>)</span>
<a name="line-447"></a>
<a name="line-448"></a> <span class='hs-varid'>isIntegerTy</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fromMaybe</span> <span class='hs-conid'>False</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-449"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tc</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'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>ty</span>
<a name="line-450"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConName</span> <span class='hs-varid'>tc</span> <span class='hs-varop'>==</span> <span class='hs-varid'>integerTyConName</span><span class='hs-layout'>)</span>
<a name="line-451"></a>
<a name="line-452"></a> <span class='hs-varid'>coerceShow</span> <span class='hs-varid'>f</span> <span class='hs-sel'>_p</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varop'>.</span> <span class='hs-varid'>text</span> <span class='hs-varop'>.</span> <span class='hs-varid'>show</span> <span class='hs-varop'>.</span> <span class='hs-varid'>f</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unsafeCoerce</span><span class='hs-cpp'>#</span> <span class='hs-varop'>.</span> <span class='hs-varid'>val</span>
<a name="line-453"></a>
<a name="line-454"></a> <span class='hs-comment'>--Note pprinting of list terms is not lazy</span>
<a name="line-455"></a> <span class='hs-varid'>doList</span> <span class='hs-varid'>p</span> <span class='hs-varid'>h</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-456"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>elems</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>h</span> <span class='hs-conop'>:</span> <span class='hs-varid'>getListTerms</span> <span class='hs-varid'>t</span>
<a name="line-457"></a> <span class='hs-varid'>isConsLast</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span><span class='hs-layout'>(</span><span class='hs-varid'>termType</span><span class='hs-layout'>(</span><span class='hs-varid'>last</span> <span class='hs-varid'>elems</span><span class='hs-layout'>)</span> <span class='hs-varop'>`coreEqType`</span> <span class='hs-varid'>termType</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span>
<a name="line-458"></a> <span class='hs-varid'>print_elems</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>y</span> <span class='hs-varid'>cons_prec</span><span class='hs-layout'>)</span> <span class='hs-varid'>elems</span>
<a name="line-459"></a> <span class='hs-varid'>return</span><span class='hs-varop'>$</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>isConsLast</span>
<a name="line-460"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>cparen</span> <span class='hs-layout'>(</span><span class='hs-varid'>p</span> <span class='hs-varop'>>=</span> <span class='hs-varid'>cons_prec</span><span class='hs-layout'>)</span>
<a name="line-461"></a> <span class='hs-varop'>.</span> <span class='hs-varid'>pprDeeperList</span> <span class='hs-varid'>fsep</span>
<a name="line-462"></a> <span class='hs-varop'>.</span> <span class='hs-varid'>punctuate</span> <span class='hs-layout'>(</span><span class='hs-varid'>space</span><span class='hs-varop'><></span><span class='hs-varid'>colon</span><span class='hs-layout'>)</span>
<a name="line-463"></a> <span class='hs-varop'>$</span> <span class='hs-varid'>print_elems</span>
<a name="line-464"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>brackets</span> <span class='hs-layout'>(</span><span class='hs-varid'>pprDeeperList</span> <span class='hs-varid'>fcat</span><span class='hs-varop'>$</span>
<a name="line-465"></a> <span class='hs-varid'>punctuate</span> <span class='hs-varid'>comma</span> <span class='hs-varid'>print_elems</span><span class='hs-layout'>)</span>
<a name="line-466"></a>
<a name="line-467"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>getListTerms</span> <span class='hs-conid'>Term</span><span class='hs-layout'>{</span><span class='hs-varid'>subTerms</span><span class='hs-keyglyph'>=</span><span class='hs-keyglyph'>[</span><span class='hs-varid'>h</span><span class='hs-layout'>,</span><span class='hs-varid'>t</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>h</span> <span class='hs-conop'>:</span> <span class='hs-varid'>getListTerms</span> <span class='hs-varid'>t</span>
<a name="line-468"></a> <span class='hs-varid'>getListTerms</span> <span class='hs-conid'>Term</span><span class='hs-layout'>{</span><span class='hs-varid'>subTerms</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>[]</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-469"></a> <span class='hs-varid'>getListTerms</span> <span class='hs-varid'>t</span><span class='hs-keyglyph'>@</span><span class='hs-conid'>Suspension</span><span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>t</span><span class='hs-keyglyph'>]</span>
<a name="line-470"></a> <span class='hs-varid'>getListTerms</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"getListTerms"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span>
<a name="line-471"></a>
<a name="line-472"></a>
<a name="line-473"></a><a name="repPrim"></a><span class='hs-definition'>repPrim</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'>Word</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span>
<a name="line-474"></a><span class='hs-definition'>repPrim</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rep</span> <span class='hs-keyword'>where</span>
<a name="line-475"></a> <span class='hs-varid'>rep</span> <span class='hs-varid'>x</span>
<a name="line-476"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>charPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>build</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Char</span><span class='hs-layout'>)</span>
<a name="line-477"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>intPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>build</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span><span class='hs-layout'>)</span>
<a name="line-478"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>wordPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>build</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Word</span><span class='hs-layout'>)</span>
<a name="line-479"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>floatPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>build</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Float</span><span class='hs-layout'>)</span>
<a name="line-480"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>doublePrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>build</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Double</span><span class='hs-layout'>)</span>
<a name="line-481"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>int32PrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>build</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int32</span><span class='hs-layout'>)</span>
<a name="line-482"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>word32PrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>build</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Word32</span><span class='hs-layout'>)</span>
<a name="line-483"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>int64PrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>build</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int64</span><span class='hs-layout'>)</span>
<a name="line-484"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>word64PrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>build</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Word64</span><span class='hs-layout'>)</span>
<a name="line-485"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>addrPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>nullPtr</span> <span class='hs-varop'>`plusPtr`</span> <span class='hs-varid'>build</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-486"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>stablePtrPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<stablePtr>"</span>
<a name="line-487"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>stableNamePrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<stableName>"</span>
<a name="line-488"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>statePrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<statethread>"</span>
<a name="line-489"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>realWorldTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<realworld>"</span>
<a name="line-490"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>threadIdPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<ThreadId>"</span>
<a name="line-491"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>weakPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<Weak>"</span>
<a name="line-492"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>arrayPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<array>"</span>
<a name="line-493"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>byteArrayPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<bytearray>"</span>
<a name="line-494"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>mutableArrayPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<mutableArray>"</span>
<a name="line-495"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>mutableByteArrayPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<mutableByteArray>"</span>
<a name="line-496"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>mutVarPrimTyCon</span><span class='hs-keyglyph'>=</span> <span class='hs-str'>"<mutVar>"</span>
<a name="line-497"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>mVarPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<mVar>"</span>
<a name="line-498"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>t</span> <span class='hs-varop'>==</span> <span class='hs-varid'>tVarPrimTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<tVar>"</span>
<a name="line-499"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showSDoc</span> <span class='hs-layout'>(</span><span class='hs-varid'>char</span> <span class='hs-chr'>'<'</span> <span class='hs-varop'><></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>t</span> <span class='hs-varop'><></span> <span class='hs-varid'>char</span> <span class='hs-chr'>'>'</span><span class='hs-layout'>)</span>
<a name="line-500"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>build</span> <span class='hs-varid'>ww</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unsafePerformIO</span> <span class='hs-varop'>$</span> <span class='hs-varid'>withArray</span> <span class='hs-varid'>ww</span> <span class='hs-layout'>(</span><span class='hs-varid'>peek</span> <span class='hs-varop'>.</span> <span class='hs-varid'>castPtr</span><span class='hs-layout'>)</span>
<a name="line-501"></a><span class='hs-comment'>-- This ^^^ relies on the representation of Haskell heap values being </span>
<a name="line-502"></a><span class='hs-comment'>-- the same as in a C array. </span>
<a name="line-503"></a>
<a name="line-504"></a><span class='hs-comment'>-----------------------------------</span>
<a name="line-505"></a><span class='hs-comment'>-- Type Reconstruction</span>
<a name="line-506"></a><span class='hs-comment'>-----------------------------------</span>
<a name="line-507"></a><span class='hs-comment'>{-
<a name="line-508"></a>Type Reconstruction is type inference done on heap closures.
<a name="line-509"></a>The algorithm walks the heap generating a set of equations, which
<a name="line-510"></a>are solved with syntactic unification.
<a name="line-511"></a>A type reconstruction equation looks like:
<a name="line-512"></a>
<a name="line-513"></a> <datacon reptype> = <actual heap contents>
<a name="line-514"></a>
<a name="line-515"></a>The full equation set is generated by traversing all the subterms, starting
<a name="line-516"></a>from a given term.
<a name="line-517"></a>
<a name="line-518"></a>The only difficult part is that newtypes are only found in the lhs of equations.
<a name="line-519"></a>Right hand sides are missing them. We can either (a) drop them from the lhs, or
<a name="line-520"></a>(b) reconstruct them in the rhs when possible.
<a name="line-521"></a>
<a name="line-522"></a>The function congruenceNewtypes takes a shot at (b)
<a name="line-523"></a>-}</span>
<a name="line-524"></a>
<a name="line-525"></a>
<a name="line-526"></a><a name="RttiType"></a><span class='hs-comment'>-- A (non-mutable) tau type containing</span>
<a name="line-527"></a><a name="RttiType"></a><span class='hs-comment'>-- existentially quantified tyvars.</span>
<a name="line-528"></a><a name="RttiType"></a><span class='hs-comment'>-- (since GHC type language currently does not support</span>
<a name="line-529"></a><a name="RttiType"></a><span class='hs-comment'>-- existentials, we leave these variables unquantified)</span>
<a name="line-530"></a><a name="RttiType"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Type</span>
<a name="line-531"></a>
<a name="line-532"></a><a name="GhciType"></a><span class='hs-comment'>-- An incomplete type as stored in GHCi:</span>
<a name="line-533"></a><a name="GhciType"></a><span class='hs-comment'>-- no polymorphism: no quantifiers & all tyvars are skolem.</span>
<a name="line-534"></a><a name="GhciType"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>GhciType</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Type</span>
<a name="line-535"></a>
<a name="line-536"></a>
<a name="line-537"></a><a name="TR"></a><span class='hs-comment'>-- The Type Reconstruction monad</span>
<a name="line-538"></a><a name="TR"></a><span class='hs-comment'>--------------------------------</span>
<a name="line-539"></a><a name="TR"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>TR</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span>
<a name="line-540"></a>
<a name="line-541"></a><a name="runTR"></a><span class='hs-definition'>runTR</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HscEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span>
<a name="line-542"></a><span class='hs-definition'>runTR</span> <span class='hs-varid'>hsc_env</span> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-543"></a> <span class='hs-varid'>mb_val</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>runTR_maybe</span> <span class='hs-varid'>hsc_env</span> <span class='hs-varid'>thing</span>
<a name="line-544"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>mb_val</span> <span class='hs-keyword'>of</span>
<a name="line-545"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>error</span> <span class='hs-str'>"unable to :print the term"</span>
<a name="line-546"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varid'>x</span>
<a name="line-547"></a>
<a name="line-548"></a><a name="runTR_maybe"></a><span class='hs-definition'>runTR_maybe</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HscEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-549"></a><span class='hs-definition'>runTR_maybe</span> <span class='hs-varid'>hsc_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fmap</span> <span class='hs-varid'>snd</span> <span class='hs-varop'>.</span> <span class='hs-varid'>initTc</span> <span class='hs-varid'>hsc_env</span> <span class='hs-conid'>HsSrcFile</span> <span class='hs-conid'>False</span> <span class='hs-varid'>iNTERACTIVE</span>
<a name="line-550"></a>
<a name="line-551"></a><a name="traceTR"></a><span class='hs-definition'>traceTR</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SDoc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</span> <span class='hs-conid'>()</span>
<a name="line-552"></a><span class='hs-definition'>traceTR</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftTcM</span> <span class='hs-varop'>.</span> <span class='hs-varid'>traceOptTcRn</span> <span class='hs-conid'>Opt_D_dump_rtti</span>
<a name="line-553"></a>
<a name="line-554"></a>
<a name="line-555"></a><a name="recoverTR"></a><span class='hs-comment'>-- Semantically different to recoverM in TcRnMonad </span>
<a name="line-556"></a><span class='hs-comment'>-- recoverM retains the errors in the first action,</span>
<a name="line-557"></a><span class='hs-comment'>-- whereas recoverTc here does not</span>
<a name="line-558"></a><span class='hs-definition'>recoverTR</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TR</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</span> <span class='hs-varid'>a</span>
<a name="line-559"></a><span class='hs-definition'>recoverTR</span> <span class='hs-varid'>recover</span> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-560"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>mb_res</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tryTcErrs</span> <span class='hs-varid'>thing</span>
<a name="line-561"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>mb_res</span> <span class='hs-keyword'>of</span>
<a name="line-562"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>recover</span>
<a name="line-563"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>res</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varid'>res</span>
<a name="line-564"></a>
<a name="line-565"></a><a name="trIO"></a><span class='hs-definition'>trIO</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</span> <span class='hs-varid'>a</span>
<a name="line-566"></a><span class='hs-definition'>trIO</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftTcM</span> <span class='hs-varop'>.</span> <span class='hs-varid'>liftIO</span>
<a name="line-567"></a>
<a name="line-568"></a><a name="liftTcM"></a><span class='hs-definition'>liftTcM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</span> <span class='hs-varid'>a</span>
<a name="line-569"></a><span class='hs-definition'>liftTcM</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>id</span>
<a name="line-570"></a>
<a name="line-571"></a><a name="newVar"></a><span class='hs-definition'>newVar</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Kind</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</span> <span class='hs-conid'>TcType</span>
<a name="line-572"></a><span class='hs-definition'>newVar</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftTcM</span> <span class='hs-varop'>.</span> <span class='hs-varid'>liftM</span> <span class='hs-varid'>mkTyVarTy</span> <span class='hs-varop'>.</span> <span class='hs-varid'>newBoxyTyVar</span>
<a name="line-573"></a>
<a name="line-574"></a><a name="instScheme"></a><span class='hs-comment'>-- | Returns the instantiated type scheme ty', and the substitution sigma </span>
<a name="line-575"></a><span class='hs-comment'>-- such that sigma(ty') = ty </span>
<a name="line-576"></a><span class='hs-definition'>instScheme</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</span> <span class='hs-layout'>(</span><span class='hs-conid'>TcType</span><span class='hs-layout'>,</span> <span class='hs-conid'>TvSubst</span><span class='hs-layout'>)</span>
<a name="line-577"></a><span class='hs-definition'>instScheme</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftTcM</span><span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-578"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tvs</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-keyglyph'><-</span> <span class='hs-varid'>tcInstType</span> <span class='hs-varid'>return</span> <span class='hs-varid'>ty</span>
<a name="line-579"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tvs'</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>ty'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcInstType</span> <span class='hs-layout'>(</span><span class='hs-varid'>mapM</span> <span class='hs-varid'>tcInstTyVar</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span>
<a name="line-580"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>ty'</span><span class='hs-layout'>,</span> <span class='hs-varid'>zipTopTvSubst</span> <span class='hs-varid'>tvs'</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkTyVarTys</span> <span class='hs-varid'>tvs</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-581"></a>
<a name="line-582"></a><a name="addConstraint"></a><span class='hs-comment'>-- Adds a constraint of the form t1 == t2</span>
<a name="line-583"></a><span class='hs-comment'>-- t1 is expected to come from walking the heap</span>
<a name="line-584"></a><span class='hs-comment'>-- t2 is expected to come from a datacon signature</span>
<a name="line-585"></a><span class='hs-comment'>-- Before unification, congruenceNewtypes needs to</span>
<a name="line-586"></a><span class='hs-comment'>-- do its magic.</span>
<a name="line-587"></a><span class='hs-definition'>addConstraint</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</span> <span class='hs-conid'>()</span>
<a name="line-588"></a><span class='hs-definition'>addConstraint</span> <span class='hs-varid'>actual</span> <span class='hs-varid'>expected</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-589"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"add constraint:"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>fsep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>actual</span><span class='hs-layout'>,</span> <span class='hs-varid'>equals</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>expected</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-590"></a> <span class='hs-varid'>recoverTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>traceTR</span> <span class='hs-varop'>$</span> <span class='hs-varid'>fsep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>text</span> <span class='hs-str'>"Failed to unify"</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>actual</span><span class='hs-layout'>,</span>
<a name="line-591"></a> <span class='hs-varid'>text</span> <span class='hs-str'>"with"</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>expected</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-592"></a> <span class='hs-layout'>(</span><span class='hs-varid'>congruenceNewtypes</span> <span class='hs-varid'>actual</span> <span class='hs-varid'>expected</span> <span class='hs-varop'>>>=</span>
<a name="line-593"></a> <span class='hs-layout'>(</span><span class='hs-varid'>getLIE</span> <span class='hs-varop'>.</span> <span class='hs-varid'>uncurry</span> <span class='hs-varid'>boxyUnify</span><span class='hs-layout'>)</span> <span class='hs-varop'>>></span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-594"></a> <span class='hs-comment'>-- TOMDO: what about the coercion?</span>
<a name="line-595"></a> <span class='hs-comment'>-- we should consider family instances</span>
<a name="line-596"></a>
<a name="line-597"></a>
<a name="line-598"></a><a name="cvObtainTerm"></a><span class='hs-comment'>-- Type & Term reconstruction</span>
<a name="line-599"></a><span class='hs-comment'>------------------------------</span>
<a name="line-600"></a><span class='hs-definition'>cvObtainTerm</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HscEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HValue</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>Term</span>
<a name="line-601"></a><span class='hs-definition'>cvObtainTerm</span> <span class='hs-varid'>hsc_env</span> <span class='hs-varid'>max_depth</span> <span class='hs-varid'>force</span> <span class='hs-varid'>old_ty</span> <span class='hs-varid'>hval</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>runTR</span> <span class='hs-varid'>hsc_env</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-602"></a> <span class='hs-comment'>-- we quantify existential tyvars as universal,</span>
<a name="line-603"></a> <span class='hs-comment'>-- as this is needed to be able to manipulate</span>
<a name="line-604"></a> <span class='hs-comment'>-- them properly</span>
<a name="line-605"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>sigma_old_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sigmaType</span> <span class='hs-varid'>old_ty</span>
<a name="line-606"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"Term reconstruction started with initial type "</span> <span class='hs-varop'><></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>old_ty</span><span class='hs-layout'>)</span>
<a name="line-607"></a> <span class='hs-varid'>term</span> <span class='hs-keyglyph'><-</span>
<a name="line-608"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>isMonomorphic</span> <span class='hs-varid'>sigma_old_ty</span>
<a name="line-609"></a> <span class='hs-keyword'>then</span> <span class='hs-keyword'>do</span>
<a name="line-610"></a> <span class='hs-varid'>new_ty</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>go</span> <span class='hs-varid'>max_depth</span> <span class='hs-varid'>sigma_old_ty</span> <span class='hs-varid'>sigma_old_ty</span> <span class='hs-varid'>hval</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>zonkTerm</span>
<a name="line-611"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>fixFunDictionaries</span> <span class='hs-varop'>$</span> <span class='hs-varid'>expandNewtypes</span> <span class='hs-varid'>new_ty</span>
<a name="line-612"></a> <span class='hs-keyword'>else</span> <span class='hs-keyword'>do</span>
<a name="line-613"></a> <span class='hs-layout'>(</span><span class='hs-varid'>old_ty'</span><span class='hs-layout'>,</span> <span class='hs-varid'>rev_subst</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>instScheme</span> <span class='hs-varid'>sigma_old_ty</span>
<a name="line-614"></a> <span class='hs-varid'>my_ty</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newVar</span> <span class='hs-varid'>argTypeKind</span>
<a name="line-615"></a> <span class='hs-varid'>when</span> <span class='hs-layout'>(</span><span class='hs-varid'>check1</span> <span class='hs-varid'>sigma_old_ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"check1 passed"</span><span class='hs-layout'>)</span> <span class='hs-varop'>>></span>
<a name="line-616"></a> <span class='hs-varid'>addConstraint</span> <span class='hs-varid'>my_ty</span> <span class='hs-varid'>old_ty'</span><span class='hs-layout'>)</span>
<a name="line-617"></a> <span class='hs-varid'>term</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>go</span> <span class='hs-varid'>max_depth</span> <span class='hs-varid'>my_ty</span> <span class='hs-varid'>sigma_old_ty</span> <span class='hs-varid'>hval</span>
<a name="line-618"></a> <span class='hs-varid'>zterm</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zonkTerm</span> <span class='hs-varid'>term</span>
<a name="line-619"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>new_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>termType</span> <span class='hs-varid'>zterm</span>
<a name="line-620"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>isMonomorphic</span> <span class='hs-varid'>new_ty</span> <span class='hs-varop'>||</span> <span class='hs-varid'>check2</span> <span class='hs-layout'>(</span><span class='hs-varid'>sigmaType</span> <span class='hs-varid'>new_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>sigma_old_ty</span>
<a name="line-621"></a> <span class='hs-keyword'>then</span> <span class='hs-keyword'>do</span>
<a name="line-622"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"check2 passed"</span><span class='hs-layout'>)</span>
<a name="line-623"></a> <span class='hs-varid'>addConstraint</span> <span class='hs-layout'>(</span><span class='hs-varid'>termType</span> <span class='hs-varid'>term</span><span class='hs-layout'>)</span> <span class='hs-varid'>old_ty'</span>
<a name="line-624"></a> <span class='hs-varid'>zterm'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zonkTerm</span> <span class='hs-varid'>term</span>
<a name="line-625"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>fixFunDictionaries</span> <span class='hs-varop'>.</span> <span class='hs-varid'>expandNewtypes</span> <span class='hs-varop'>.</span> <span class='hs-varid'>mapTermType</span> <span class='hs-layout'>(</span><span class='hs-varid'>substTy</span> <span class='hs-varid'>rev_subst</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>zterm'</span><span class='hs-layout'>)</span>
<a name="line-626"></a> <span class='hs-keyword'>else</span> <span class='hs-keyword'>do</span>
<a name="line-627"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"check2 failed"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>parens</span>
<a name="line-628"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>zterm</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-str'>"::"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>new_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-629"></a> <span class='hs-comment'>-- we have unsound types. Replace constructor types in</span>
<a name="line-630"></a> <span class='hs-comment'>-- subterms with tyvars</span>
<a name="line-631"></a> <span class='hs-varid'>zterm'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapTermTypeM</span>
<a name="line-632"></a> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>case</span> <span class='hs-varid'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>ty</span> <span class='hs-keyword'>of</span>
<a name="line-633"></a> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tc</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-conop'>:</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>tc</span> <span class='hs-varop'>/=</span> <span class='hs-varid'>funTyCon</span>
<a name="line-634"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>newVar</span> <span class='hs-varid'>argTypeKind</span>
<a name="line-635"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-636"></a> <span class='hs-varid'>zterm</span>
<a name="line-637"></a> <span class='hs-varid'>zonkTerm</span> <span class='hs-varid'>zterm'</span>
<a name="line-638"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"Term reconstruction completed."</span> <span class='hs-varop'>$$</span>
<a name="line-639"></a> <span class='hs-varid'>text</span> <span class='hs-str'>"Term obtained: "</span> <span class='hs-varop'><></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>term</span> <span class='hs-varop'>$$</span>
<a name="line-640"></a> <span class='hs-varid'>text</span> <span class='hs-str'>"Type obtained: "</span> <span class='hs-varop'><></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>termType</span> <span class='hs-varid'>term</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-641"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>term</span>
<a name="line-642"></a> <span class='hs-keyword'>where</span>
<a name="line-643"></a> <span class='hs-varid'>go</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</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'>HValue</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>Term</span>
<a name="line-644"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>max_depth</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>seq</span> <span class='hs-varid'>max_depth</span> <span class='hs-conid'>False</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>undefined</span>
<a name="line-645"></a> <span class='hs-varid'>go</span> <span class='hs-num'>0</span> <span class='hs-varid'>my_ty</span> <span class='hs-sel'>_old_ty</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-646"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"Gave up reconstructing a term after"</span> <span class='hs-varop'><></span>
<a name="line-647"></a> <span class='hs-varid'>int</span> <span class='hs-varid'>max_depth</span> <span class='hs-varop'><></span> <span class='hs-varid'>text</span> <span class='hs-str'>" steps"</span><span class='hs-layout'>)</span>
<a name="line-648"></a> <span class='hs-varid'>clos</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>trIO</span> <span class='hs-varop'>$</span> <span class='hs-varid'>getClosureData</span> <span class='hs-varid'>a</span>
<a name="line-649"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Suspension</span> <span class='hs-layout'>(</span><span class='hs-varid'>tipe</span> <span class='hs-varid'>clos</span><span class='hs-layout'>)</span> <span class='hs-varid'>my_ty</span> <span class='hs-varid'>a</span> <span class='hs-conid'>Nothing</span><span class='hs-layout'>)</span>
<a name="line-650"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>max_depth</span> <span class='hs-varid'>my_ty</span> <span class='hs-varid'>old_ty</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-651"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>monomorphic</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span><span class='hs-layout'>(</span><span class='hs-varid'>isTyVarTy</span> <span class='hs-varid'>my_ty</span><span class='hs-layout'>)</span>
<a name="line-652"></a> <span class='hs-comment'>-- This ^^^ is a convention. The ancestor tests for</span>
<a name="line-653"></a> <span class='hs-comment'>-- monomorphism and passes a type instead of a tv</span>
<a name="line-654"></a> <span class='hs-varid'>clos</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>trIO</span> <span class='hs-varop'>$</span> <span class='hs-varid'>getClosureData</span> <span class='hs-varid'>a</span>
<a name="line-655"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>tipe</span> <span class='hs-varid'>clos</span> <span class='hs-keyword'>of</span>
<a name="line-656"></a><span class='hs-comment'>-- Thunks we may want to force</span>
<a name="line-657"></a><span class='hs-comment'>-- NB. this won't attempt to force a BLACKHOLE. Even with :force, we never</span>
<a name="line-658"></a><span class='hs-comment'>-- force blackholes, because it would almost certainly result in deadlock,</span>
<a name="line-659"></a><span class='hs-comment'>-- and showing the '_' is more useful.</span>
<a name="line-660"></a> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isThunk</span> <span class='hs-varid'>t</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>force</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"Forcing a "</span> <span class='hs-varop'><></span> <span class='hs-varid'>text</span> <span class='hs-layout'>(</span><span class='hs-varid'>show</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>>></span>
<a name="line-661"></a> <span class='hs-varid'>seq</span> <span class='hs-varid'>a</span> <span class='hs-layout'>(</span><span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-varid'>pred</span> <span class='hs-varid'>max_depth</span><span class='hs-layout'>)</span> <span class='hs-varid'>my_ty</span> <span class='hs-varid'>old_ty</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-662"></a><span class='hs-comment'>-- We always follow indirections</span>
<a name="line-663"></a> <span class='hs-conid'>Indirection</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"Following an indirection"</span> <span class='hs-varop'><></span> <span class='hs-varid'>parens</span> <span class='hs-layout'>(</span><span class='hs-varid'>int</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-664"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>max_depth</span> <span class='hs-varid'>my_ty</span> <span class='hs-varid'>old_ty</span> <span class='hs-varop'>$!</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptrs</span> <span class='hs-varid'>clos</span> <span class='hs-varop'>!</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-665"></a><span class='hs-comment'>-- We also follow references</span>
<a name="line-666"></a> <span class='hs-conid'>MutVar</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tycon</span><span class='hs-layout'>,</span><span class='hs-keyglyph'>[</span><span class='hs-varid'>world</span><span class='hs-layout'>,</span><span class='hs-varid'>contents_ty</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>old_ty</span>
<a name="line-667"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-668"></a> <span class='hs-comment'>-- Deal with the MutVar# primitive</span>
<a name="line-669"></a> <span class='hs-comment'>-- It does not have a constructor at all, </span>
<a name="line-670"></a> <span class='hs-comment'>-- so we simulate the following one</span>
<a name="line-671"></a> <span class='hs-comment'>-- MutVar# :: contents_ty -> MutVar# s contents_ty</span>
<a name="line-672"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"Following a MutVar"</span><span class='hs-layout'>)</span>
<a name="line-673"></a> <span class='hs-varid'>contents_tv</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newVar</span> <span class='hs-varid'>liftedTypeKind</span>
<a name="line-674"></a> <span class='hs-varid'>contents</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>trIO</span><span class='hs-varop'>$</span> <span class='hs-conid'>IO</span><span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>w</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>readMutVar</span><span class='hs-cpp'>#</span> <span class='hs-layout'>(</span><span class='hs-varid'>unsafeCoerce</span><span class='hs-cpp'>#</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-varid'>w</span>
<a name="line-675"></a> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span><span class='hs-varid'>isUnliftedTypeKind</span> <span class='hs-varop'>$</span> <span class='hs-varid'>typeKind</span> <span class='hs-varid'>my_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-676"></a> <span class='hs-layout'>(</span><span class='hs-varid'>mutvar_ty</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'>instScheme</span> <span class='hs-varop'>$</span> <span class='hs-varid'>sigmaType</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mkFunTy</span>
<a name="line-677"></a> <span class='hs-varid'>contents_ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkTyConApp</span> <span class='hs-varid'>tycon</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>world</span><span class='hs-layout'>,</span><span class='hs-varid'>contents_ty</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-678"></a> <span class='hs-varid'>addConstraint</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkFunTy</span> <span class='hs-varid'>contents_tv</span> <span class='hs-varid'>my_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>mutvar_ty</span>
<a name="line-679"></a> <span class='hs-varid'>x</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-varid'>pred</span> <span class='hs-varid'>max_depth</span><span class='hs-layout'>)</span> <span class='hs-varid'>contents_tv</span> <span class='hs-varid'>contents_ty</span> <span class='hs-varid'>contents</span>
<a name="line-680"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>RefWrap</span> <span class='hs-varid'>my_ty</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-681"></a>
<a name="line-682"></a> <span class='hs-comment'>-- The interesting case</span>
<a name="line-683"></a> <span class='hs-conid'>Constr</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-684"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"entering a constructor "</span> <span class='hs-varop'><></span>
<a name="line-685"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>monomorphic</span>
<a name="line-686"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>parens</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"already monomorphic: "</span> <span class='hs-varop'><></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>my_ty</span><span class='hs-layout'>)</span>
<a name="line-687"></a> <span class='hs-keyword'>else</span> <span class='hs-conid'>Outputable</span><span class='hs-varop'>.</span><span class='hs-varid'>empty</span><span class='hs-layout'>)</span>
<a name="line-688"></a> <span class='hs-conid'>Right</span> <span class='hs-varid'>dcname</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dataConInfoPtrToName</span> <span class='hs-layout'>(</span><span class='hs-varid'>infoPtr</span> <span class='hs-varid'>clos</span><span class='hs-layout'>)</span>
<a name="line-689"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>mb_dc</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tryTcErrs</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcLookupDataCon</span> <span class='hs-varid'>dcname</span><span class='hs-layout'>)</span>
<a name="line-690"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>mb_dc</span> <span class='hs-keyword'>of</span>
<a name="line-691"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-comment'>-- This can happen for private constructors compiled -O0</span>
<a name="line-692"></a> <span class='hs-comment'>-- where the .hi descriptor does not export them</span>
<a name="line-693"></a> <span class='hs-comment'>-- In such case, we return a best approximation:</span>
<a name="line-694"></a> <span class='hs-comment'>-- ignore the unpointed args, and recover the pointeds</span>
<a name="line-695"></a> <span class='hs-comment'>-- This preserves laziness, and should be safe.</span>
<a name="line-696"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>tag</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showSDoc</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>dcname</span><span class='hs-layout'>)</span>
<a name="line-697"></a> <span class='hs-varid'>vars</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>replicateM</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span><span class='hs-varop'>$</span> <span class='hs-varid'>elems</span><span class='hs-varop'>$</span> <span class='hs-varid'>ptrs</span> <span class='hs-varid'>clos</span><span class='hs-layout'>)</span>
<a name="line-698"></a> <span class='hs-layout'>(</span><span class='hs-varid'>newVar</span> <span class='hs-layout'>(</span><span class='hs-varid'>liftedTypeKind</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-699"></a> <span class='hs-varid'>subTerms</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>sequence</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>appArr</span> <span class='hs-layout'>(</span><span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-varid'>pred</span> <span class='hs-varid'>max_depth</span><span class='hs-layout'>)</span> <span class='hs-varid'>tv</span> <span class='hs-varid'>tv</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptrs</span> <span class='hs-varid'>clos</span><span class='hs-layout'>)</span> <span class='hs-varid'>i</span>
<a name="line-700"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>i</span><span class='hs-layout'>,</span> <span class='hs-varid'>tv</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zip</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span><span class='hs-keyglyph'>..</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>vars</span><span class='hs-keyglyph'>]</span>
<a name="line-701"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Term</span> <span class='hs-varid'>my_ty</span> <span class='hs-layout'>(</span><span class='hs-conid'>Left</span> <span class='hs-layout'>(</span><span class='hs-chr'>'<'</span> <span class='hs-conop'>:</span> <span class='hs-varid'>tag</span> <span class='hs-varop'>++</span> <span class='hs-str'>">"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>a</span> <span class='hs-varid'>subTerms</span><span class='hs-layout'>)</span>
<a name="line-702"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>dc</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-703"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>subTtypes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>matchSubTypes</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>old_ty</span>
<a name="line-704"></a> <span class='hs-varid'>subTermTvs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapMif</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-varop'>.</span> <span class='hs-varid'>isMonomorphic</span><span class='hs-layout'>)</span>
<a name="line-705"></a> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>newVar</span> <span class='hs-layout'>(</span><span class='hs-varid'>typeKind</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-706"></a> <span class='hs-varid'>subTtypes</span>
<a name="line-707"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>subTermsP</span><span class='hs-layout'>,</span> <span class='hs-varid'>subTermsNP</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-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>ty</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'>isLifted</span> <span class='hs-varid'>ty</span>
<a name="line-708"></a> <span class='hs-varop'>||</span> <span class='hs-varid'>isRefType</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-709"></a> <span class='hs-layout'>(</span><span class='hs-varid'>zip</span> <span class='hs-varid'>subTtypes</span> <span class='hs-varid'>subTermTvs</span><span class='hs-layout'>)</span>
<a name="line-710"></a> <span class='hs-layout'>(</span><span class='hs-varid'>subTtypesP</span><span class='hs-layout'>,</span> <span class='hs-varid'>subTermTvsP</span> <span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unzip</span> <span class='hs-varid'>subTermsP</span>
<a name="line-711"></a> <span class='hs-layout'>(</span><span class='hs-varid'>subTtypesNP</span><span class='hs-layout'>,</span> <span class='hs-sel'>_subTermTvsNP</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unzip</span> <span class='hs-varid'>subTermsNP</span>
<a name="line-712"></a>
<a name="line-713"></a> <span class='hs-comment'>-- When we already have all the information, avoid solving</span>
<a name="line-714"></a> <span class='hs-comment'>-- unnecessary constraints. Propagation of type information</span>
<a name="line-715"></a> <span class='hs-comment'>-- to subterms is already being done via matching.</span>
<a name="line-716"></a> <span class='hs-varid'>when</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-varid'>monomorphic</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-717"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>myType</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkFunTys</span> <span class='hs-varid'>subTermTvs</span> <span class='hs-varid'>my_ty</span>
<a name="line-718"></a> <span class='hs-layout'>(</span><span class='hs-varid'>signatureType</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'>instScheme</span> <span class='hs-layout'>(</span><span class='hs-varid'>mydataConType</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span>
<a name="line-719"></a> <span class='hs-comment'>-- It is vital for newtype reconstruction that the unification step</span>
<a name="line-720"></a> <span class='hs-comment'>-- is done right here, _before_ the subterms are RTTI reconstructed</span>
<a name="line-721"></a> <span class='hs-varid'>addConstraint</span> <span class='hs-varid'>myType</span> <span class='hs-varid'>signatureType</span>
<a name="line-722"></a> <span class='hs-varid'>subTermsP</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>sequence</span>
<a name="line-723"></a> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>appArr</span> <span class='hs-layout'>(</span><span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-varid'>pred</span> <span class='hs-varid'>max_depth</span><span class='hs-layout'>)</span> <span class='hs-varid'>tv</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptrs</span> <span class='hs-varid'>clos</span><span class='hs-layout'>)</span> <span class='hs-varid'>i</span>
<a name="line-724"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>i</span><span class='hs-layout'>,</span><span class='hs-varid'>tv</span><span class='hs-layout'>,</span><span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zip3</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span><span class='hs-keyglyph'>..</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>subTermTvsP</span> <span class='hs-varid'>subTtypesP</span><span class='hs-keyglyph'>]</span>
<a name="line-725"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>unboxeds</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extractUnboxed</span> <span class='hs-varid'>subTtypesNP</span> <span class='hs-varid'>clos</span>
<a name="line-726"></a> <span class='hs-varid'>subTermsNP</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>uncurry</span> <span class='hs-conid'>Prim</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>zip</span> <span class='hs-varid'>subTtypesNP</span> <span class='hs-varid'>unboxeds</span><span class='hs-layout'>)</span>
<a name="line-727"></a> <span class='hs-varid'>subTerms</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>reOrderTerms</span> <span class='hs-varid'>subTermsP</span> <span class='hs-varid'>subTermsNP</span> <span class='hs-varid'>subTtypes</span>
<a name="line-728"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Term</span> <span class='hs-varid'>my_ty</span> <span class='hs-layout'>(</span><span class='hs-conid'>Right</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span> <span class='hs-varid'>a</span> <span class='hs-varid'>subTerms</span><span class='hs-layout'>)</span>
<a name="line-729"></a><span class='hs-comment'>-- The otherwise case: can be a Thunk,AP,PAP,etc.</span>
<a name="line-730"></a> <span class='hs-varid'>tipe_clos</span> <span class='hs-keyglyph'>-></span>
<a name="line-731"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Suspension</span> <span class='hs-varid'>tipe_clos</span> <span class='hs-varid'>my_ty</span> <span class='hs-varid'>a</span> <span class='hs-conid'>Nothing</span><span class='hs-layout'>)</span>
<a name="line-732"></a>
<a name="line-733"></a> <span class='hs-varid'>matchSubTypes</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>ty</span>
<a name="line-734"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>ty'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>repType</span> <span class='hs-varid'>ty</span> <span class='hs-comment'>-- look through newtypes</span>
<a name="line-735"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tc</span><span class='hs-layout'>,</span><span class='hs-varid'>ty_args</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>ty'</span>
<a name="line-736"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>dc</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>tyConDataCons</span> <span class='hs-varid'>tc</span>
<a name="line-737"></a> <span class='hs-comment'>-- It is necessary to check that dc is actually a constructor for tycon tc,</span>
<a name="line-738"></a> <span class='hs-comment'>-- because it may be the case that tc is a recursive newtype and tcSplitTyConApp</span>
<a name="line-739"></a> <span class='hs-comment'>-- has not removed it. In that case, we happily give up and don't match</span>
<a name="line-740"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>myDataConInstArgTys</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>ty_args</span>
<a name="line-741"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConRepArgTys</span> <span class='hs-varid'>dc</span>
<a name="line-742"></a>
<a name="line-743"></a> <span class='hs-comment'>-- put together pointed and nonpointed subterms in the</span>
<a name="line-744"></a> <span class='hs-comment'>-- correct order.</span>
<a name="line-745"></a> <span class='hs-varid'>reOrderTerms</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-746"></a> <span class='hs-varid'>reOrderTerms</span> <span class='hs-varid'>pointed</span> <span class='hs-varid'>unpointed</span> <span class='hs-layout'>(</span><span class='hs-varid'>ty</span><span class='hs-conop'>:</span><span class='hs-varid'>tys</span><span class='hs-layout'>)</span>
<a name="line-747"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isLifted</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>||</span> <span class='hs-varid'>isRefType</span> <span class='hs-varid'>ty</span>
<a name="line-748"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT2</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'>pointed</span><span class='hs-layout'>)</span>
<a name="line-749"></a> <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'>"reOrderTerms"</span><span class='hs-layout'>)</span> <span class='hs-varop'>$$</span>
<a name="line-750"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>pointed</span> <span class='hs-varop'>$$</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>unpointed</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-751"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>t</span><span class='hs-conop'>:</span><span class='hs-varid'>tt</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pointed</span> <span class='hs-keyword'>in</span> <span class='hs-varid'>t</span> <span class='hs-conop'>:</span> <span class='hs-varid'>reOrderTerms</span> <span class='hs-varid'>tt</span> <span class='hs-varid'>unpointed</span> <span class='hs-varid'>tys</span>
<a name="line-752"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT2</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'>unpointed</span><span class='hs-layout'>)</span>
<a name="line-753"></a> <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'>"reOrderTerms"</span><span class='hs-layout'>)</span> <span class='hs-varop'>$$</span>
<a name="line-754"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>pointed</span> <span class='hs-varop'>$$</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>unpointed</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-755"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>t</span><span class='hs-conop'>:</span><span class='hs-varid'>tt</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unpointed</span> <span class='hs-keyword'>in</span> <span class='hs-varid'>t</span> <span class='hs-conop'>:</span> <span class='hs-varid'>reOrderTerms</span> <span class='hs-varid'>pointed</span> <span class='hs-varid'>tt</span> <span class='hs-varid'>tys</span>
<a name="line-756"></a>
<a name="line-757"></a> <span class='hs-comment'>-- insert NewtypeWraps around newtypes</span>
<a name="line-758"></a> <span class='hs-varid'>expandNewtypes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldTerm</span> <span class='hs-varid'>idTermFold</span> <span class='hs-layout'>{</span> <span class='hs-varid'>fTerm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>worker</span> <span class='hs-layout'>}</span> <span class='hs-keyword'>where</span>
<a name="line-759"></a> <span class='hs-varid'>worker</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>tt</span>
<a name="line-760"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tc</span><span class='hs-layout'>,</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>ty</span>
<a name="line-761"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>isNewTyCon</span> <span class='hs-varid'>tc</span>
<a name="line-762"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>wrapped_type</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newTyConInstRhs</span> <span class='hs-varid'>tc</span> <span class='hs-varid'>args</span>
<a name="line-763"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>dc'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tyConSingleDataCon_maybe</span> <span class='hs-varid'>tc</span>
<a name="line-764"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>t'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>worker</span> <span class='hs-varid'>wrapped_type</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>tt</span>
<a name="line-765"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>NewtypeWrap</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-conid'>Right</span> <span class='hs-varid'>dc'</span><span class='hs-layout'>)</span> <span class='hs-varid'>t'</span>
<a name="line-766"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Term</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>tt</span>
<a name="line-767"></a>
<a name="line-768"></a>
<a name="line-769"></a> <span class='hs-comment'>-- Avoid returning types where predicates have been expanded to dictionaries.</span>
<a name="line-770"></a> <span class='hs-varid'>fixFunDictionaries</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldTerm</span> <span class='hs-varid'>idTermFold</span> <span class='hs-layout'>{</span><span class='hs-varid'>fSuspension</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>worker</span><span class='hs-layout'>}</span> <span class='hs-keyword'>where</span>
<a name="line-771"></a> <span class='hs-varid'>worker</span> <span class='hs-varid'>ct</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isFunTy</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Suspension</span> <span class='hs-varid'>ct</span> <span class='hs-layout'>(</span><span class='hs-varid'>dictsView</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>n</span>
<a name="line-772"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Suspension</span> <span class='hs-varid'>ct</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>hval</span> <span class='hs-varid'>n</span>
<a name="line-773"></a>
<a name="line-774"></a>
<a name="line-775"></a><a name="cvReconstructType"></a><span class='hs-comment'>-- Fast, breadth-first Type reconstruction</span>
<a name="line-776"></a><span class='hs-comment'>------------------------------------------</span>
<a name="line-777"></a><span class='hs-definition'>cvReconstructType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HscEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>GhciType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HValue</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span>
<a name="line-778"></a><span class='hs-definition'>cvReconstructType</span> <span class='hs-varid'>hsc_env</span> <span class='hs-varid'>max_depth</span> <span class='hs-varid'>old_ty</span> <span class='hs-varid'>hval</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>runTR_maybe</span> <span class='hs-varid'>hsc_env</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-779"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"RTTI started with initial type "</span> <span class='hs-varop'><></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>old_ty</span><span class='hs-layout'>)</span>
<a name="line-780"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>sigma_old_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sigmaType</span> <span class='hs-varid'>old_ty</span>
<a name="line-781"></a> <span class='hs-varid'>new_ty</span> <span class='hs-keyglyph'><-</span>
<a name="line-782"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>isMonomorphic</span> <span class='hs-varid'>sigma_old_ty</span>
<a name="line-783"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-varid'>old_ty</span>
<a name="line-784"></a> <span class='hs-keyword'>else</span> <span class='hs-keyword'>do</span>
<a name="line-785"></a> <span class='hs-layout'>(</span><span class='hs-varid'>old_ty'</span><span class='hs-layout'>,</span> <span class='hs-varid'>rev_subst</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>instScheme</span> <span class='hs-varid'>sigma_old_ty</span>
<a name="line-786"></a> <span class='hs-varid'>my_ty</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newVar</span> <span class='hs-varid'>argTypeKind</span>
<a name="line-787"></a> <span class='hs-varid'>when</span> <span class='hs-layout'>(</span><span class='hs-varid'>check1</span> <span class='hs-varid'>sigma_old_ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"check1 passed"</span><span class='hs-layout'>)</span> <span class='hs-varop'>>></span>
<a name="line-788"></a> <span class='hs-varid'>addConstraint</span> <span class='hs-varid'>my_ty</span> <span class='hs-varid'>old_ty'</span><span class='hs-layout'>)</span>
<a name="line-789"></a> <span class='hs-varid'>search</span> <span class='hs-layout'>(</span><span class='hs-varid'>isMonomorphic</span> <span class='hs-varop'>`fmap`</span> <span class='hs-varid'>zonkTcType</span> <span class='hs-varid'>my_ty</span><span class='hs-layout'>)</span>
<a name="line-790"></a> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>ty</span><span class='hs-layout'>,</span><span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>go</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-791"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>singleton</span> <span class='hs-layout'>(</span><span class='hs-varid'>my_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>hval</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-792"></a> <span class='hs-varid'>max_depth</span>
<a name="line-793"></a> <span class='hs-varid'>new_ty</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zonkTcType</span> <span class='hs-varid'>my_ty</span>
<a name="line-794"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>isMonomorphic</span> <span class='hs-varid'>new_ty</span> <span class='hs-varop'>||</span> <span class='hs-varid'>check2</span> <span class='hs-layout'>(</span><span class='hs-varid'>sigmaType</span> <span class='hs-varid'>new_ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>sigma_old_ty</span>
<a name="line-795"></a> <span class='hs-keyword'>then</span> <span class='hs-keyword'>do</span>
<a name="line-796"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"check2 passed"</span><span class='hs-layout'>)</span>
<a name="line-797"></a> <span class='hs-varid'>addConstraint</span> <span class='hs-varid'>my_ty</span> <span class='hs-varid'>old_ty'</span>
<a name="line-798"></a> <span class='hs-varid'>new_ty'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zonkTcType</span> <span class='hs-varid'>my_ty</span>
<a name="line-799"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>substTy</span> <span class='hs-varid'>rev_subst</span> <span class='hs-varid'>new_ty'</span><span class='hs-layout'>)</span>
<a name="line-800"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"check2 failed"</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'>new_ty</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>>></span>
<a name="line-801"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>old_ty</span>
<a name="line-802"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"RTTI completed. Type obtained:"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>new_ty</span><span class='hs-layout'>)</span>
<a name="line-803"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>new_ty</span>
<a name="line-804"></a> <span class='hs-keyword'>where</span>
<a name="line-805"></a><span class='hs-comment'>-- search :: m Bool -> ([a] -> [a] -> [a]) -> [a] -> m ()</span>
<a name="line-806"></a> <span class='hs-varid'>search</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-num'>0</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"Failed to reconstruct a type after "</span> <span class='hs-varop'><></span>
<a name="line-807"></a> <span class='hs-varid'>int</span> <span class='hs-varid'>max_depth</span> <span class='hs-varop'><></span> <span class='hs-varid'>text</span> <span class='hs-str'>" steps"</span><span class='hs-layout'>)</span>
<a name="line-808"></a> <span class='hs-varid'>search</span> <span class='hs-varid'>stop</span> <span class='hs-varid'>expand</span> <span class='hs-varid'>l</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span>
<a name="line-809"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>viewl</span> <span class='hs-varid'>l</span> <span class='hs-keyword'>of</span>
<a name="line-810"></a> <span class='hs-conid'>EmptyL</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-811"></a> <span class='hs-varid'>x</span> <span class='hs-conop'>:<</span> <span class='hs-varid'>xx</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unlessM</span> <span class='hs-varid'>stop</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-812"></a> <span class='hs-varid'>new</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>expand</span> <span class='hs-varid'>x</span>
<a name="line-813"></a> <span class='hs-varid'>search</span> <span class='hs-varid'>stop</span> <span class='hs-varid'>expand</span> <span class='hs-layout'>(</span><span class='hs-varid'>xx</span> <span class='hs-varop'>`mappend`</span> <span class='hs-conid'>Seq</span><span class='hs-varop'>.</span><span class='hs-varid'>fromList</span> <span class='hs-varid'>new</span><span class='hs-layout'>)</span> <span class='hs-varop'>$!</span> <span class='hs-layout'>(</span><span class='hs-varid'>pred</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>
<a name="line-814"></a>
<a name="line-815"></a> <span class='hs-comment'>-- returns unification tasks,since we are going to want a breadth-first search</span>
<a name="line-816"></a> <span class='hs-varid'>go</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HValue</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</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-conid'>HValue</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-817"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>my_ty</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-818"></a> <span class='hs-varid'>clos</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>trIO</span> <span class='hs-varop'>$</span> <span class='hs-varid'>getClosureData</span> <span class='hs-varid'>a</span>
<a name="line-819"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>tipe</span> <span class='hs-varid'>clos</span> <span class='hs-keyword'>of</span>
<a name="line-820"></a> <span class='hs-conid'>Indirection</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>go</span> <span class='hs-varid'>my_ty</span> <span class='hs-varop'>$!</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptrs</span> <span class='hs-varid'>clos</span> <span class='hs-varop'>!</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-821"></a> <span class='hs-conid'>MutVar</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-822"></a> <span class='hs-varid'>contents</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>trIO</span><span class='hs-varop'>$</span> <span class='hs-conid'>IO</span><span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>w</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>readMutVar</span><span class='hs-cpp'>#</span> <span class='hs-layout'>(</span><span class='hs-varid'>unsafeCoerce</span><span class='hs-cpp'>#</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-varid'>w</span>
<a name="line-823"></a> <span class='hs-varid'>tv'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newVar</span> <span class='hs-varid'>liftedTypeKind</span>
<a name="line-824"></a> <span class='hs-varid'>world</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newVar</span> <span class='hs-varid'>liftedTypeKind</span>
<a name="line-825"></a> <span class='hs-varid'>addConstraint</span> <span class='hs-varid'>my_ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkTyConApp</span> <span class='hs-varid'>mutVarPrimTyCon</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>world</span><span class='hs-layout'>,</span><span class='hs-varid'>tv'</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-826"></a> <span class='hs-varid'>return</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>tv'</span><span class='hs-layout'>,</span> <span class='hs-varid'>contents</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-827"></a> <span class='hs-conid'>Constr</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-828"></a> <span class='hs-conid'>Right</span> <span class='hs-varid'>dcname</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dataConInfoPtrToName</span> <span class='hs-layout'>(</span><span class='hs-varid'>infoPtr</span> <span class='hs-varid'>clos</span><span class='hs-layout'>)</span>
<a name="line-829"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>mb_dc</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tryTcErrs</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcLookupDataCon</span> <span class='hs-varid'>dcname</span><span class='hs-layout'>)</span>
<a name="line-830"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>mb_dc</span> <span class='hs-keyword'>of</span>
<a name="line-831"></a> <span class='hs-conid'>Nothing</span><span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-832"></a> <span class='hs-comment'>-- TODO: Check this case</span>
<a name="line-833"></a> <span class='hs-varid'>forM</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span><span class='hs-keyglyph'>..</span><span class='hs-varid'>length</span> <span class='hs-layout'>(</span><span class='hs-varid'>elems</span> <span class='hs-varop'>$</span> <span class='hs-varid'>ptrs</span> <span class='hs-varid'>clos</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>i</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-834"></a> <span class='hs-varid'>tv</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newVar</span> <span class='hs-varid'>liftedTypeKind</span>
<a name="line-835"></a> <span class='hs-varid'>return</span><span class='hs-varop'>$</span> <span class='hs-varid'>appArr</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>e</span><span class='hs-keyglyph'>-></span><span class='hs-layout'>(</span><span class='hs-varid'>tv</span><span class='hs-layout'>,</span><span class='hs-varid'>e</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptrs</span> <span class='hs-varid'>clos</span><span class='hs-layout'>)</span> <span class='hs-varid'>i</span>
<a name="line-836"></a>
<a name="line-837"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>dc</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-838"></a> <span class='hs-varid'>subTtypes</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapMif</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-varop'>.</span> <span class='hs-varid'>isMonomorphic</span><span class='hs-layout'>)</span>
<a name="line-839"></a> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>newVar</span> <span class='hs-layout'>(</span><span class='hs-varid'>typeKind</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-840"></a> <span class='hs-layout'>(</span><span class='hs-varid'>dataConRepArgTys</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span>
<a name="line-841"></a>
<a name="line-842"></a> <span class='hs-comment'>-- It is vital for newtype reconstruction that the unification step</span>
<a name="line-843"></a> <span class='hs-comment'>-- is done right here, _before_ the subterms are RTTI reconstructed</span>
<a name="line-844"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>myType</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkFunTys</span> <span class='hs-varid'>subTtypes</span> <span class='hs-varid'>my_ty</span>
<a name="line-845"></a> <span class='hs-layout'>(</span><span class='hs-varid'>signatureType</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'>instScheme</span><span class='hs-layout'>(</span><span class='hs-varid'>mydataConType</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span>
<a name="line-846"></a> <span class='hs-varid'>addConstraint</span> <span class='hs-varid'>myType</span> <span class='hs-varid'>signatureType</span>
<a name="line-847"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>appArr</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>e</span><span class='hs-keyglyph'>-></span><span class='hs-layout'>(</span><span class='hs-varid'>t</span><span class='hs-layout'>,</span><span class='hs-varid'>e</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptrs</span> <span class='hs-varid'>clos</span><span class='hs-layout'>)</span> <span class='hs-varid'>i</span>
<a name="line-848"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>i</span><span class='hs-layout'>,</span><span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zip</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span><span class='hs-keyglyph'>..</span><span class='hs-keyglyph'>]</span> <span class='hs-layout'>(</span><span class='hs-varid'>filter</span> <span class='hs-layout'>(</span><span class='hs-varid'>isLifted</span> <span class='hs-varop'>|.|</span> <span class='hs-varid'>isRefType</span><span class='hs-layout'>)</span> <span class='hs-varid'>subTtypes</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-849"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>[]</span>
<a name="line-850"></a>
<a name="line-851"></a><a name="improveRTTIType"></a><span class='hs-comment'>-- Compute the difference between a base type and the type found by RTTI</span>
<a name="line-852"></a><span class='hs-comment'>-- improveType <base_type> <rtti_type></span>
<a name="line-853"></a><span class='hs-comment'>-- The types can contain skolem type variables, which need to be treated as normal vars.</span>
<a name="line-854"></a><span class='hs-comment'>-- In particular, we want them to unify with things.</span>
<a name="line-855"></a><span class='hs-definition'>improveRTTIType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HscEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>TvSubst</span><span class='hs-layout'>)</span>
<a name="line-856"></a><span class='hs-definition'>improveRTTIType</span> <span class='hs-varid'>hsc_env</span> <span class='hs-sel'>_ty</span> <span class='hs-varid'>rtti_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>runTR_maybe</span> <span class='hs-varid'>hsc_env</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-857"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"improveRttiType"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>fsep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ppr</span> <span class='hs-sel'>_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>rtti_ty</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-858"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ty_tvs</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-keyglyph'><-</span> <span class='hs-varid'>tcInstType</span> <span class='hs-varid'>return</span> <span class='hs-varid'>ty</span>
<a name="line-859"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ty_tvs'</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>ty'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcInstType</span> <span class='hs-layout'>(</span><span class='hs-varid'>mapM</span> <span class='hs-varid'>tcInstTyVar</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span>
<a name="line-860"></a> <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'>rtti_ty'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcInstType</span> <span class='hs-layout'>(</span><span class='hs-varid'>mapM</span> <span class='hs-varid'>tcInstTyVar</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>sigmaType</span> <span class='hs-varid'>rtti_ty</span><span class='hs-layout'>)</span>
<a name="line-861"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getLIE</span><span class='hs-layout'>(</span><span class='hs-varid'>boxyUnify</span> <span class='hs-varid'>rtti_ty'</span> <span class='hs-varid'>ty'</span><span class='hs-layout'>)</span>
<a name="line-862"></a> <span class='hs-varid'>tvs1_contents</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zonkTcTyVars</span> <span class='hs-varid'>ty_tvs'</span>
<a name="line-863"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>subst</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>uncurry</span> <span class='hs-varid'>zipTopTvSubst</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unzip</span><span class='hs-layout'>)</span>
<a name="line-864"></a> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>tv</span><span class='hs-layout'>,</span><span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>tv</span><span class='hs-layout'>,</span><span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zip</span> <span class='hs-varid'>ty_tvs</span> <span class='hs-varid'>tvs1_contents</span>
<a name="line-865"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>getTyVar_maybe</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>/=</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>tv</span>
<a name="line-866"></a> <span class='hs-comment'>--, not(isTyVarTy ty)</span>
<a name="line-867"></a> <span class='hs-keyglyph'>]</span>
<a name="line-868"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>subst</span>
<a name="line-869"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sigmaType</span> <span class='hs-sel'>_ty</span>
<a name="line-870"></a>
<a name="line-871"></a><a name="myDataConInstArgTys"></a><span class='hs-definition'>myDataConInstArgTys</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span>
<a name="line-872"></a><span class='hs-definition'>myDataConInstArgTys</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>args</span>
<a name="line-873"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>null</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConExTyVars</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>null</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConEqTheta</span> <span class='hs-varid'>dc</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConInstArgTys</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>args</span>
<a name="line-874"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConRepArgTys</span> <span class='hs-varid'>dc</span>
<a name="line-875"></a>
<a name="line-876"></a><a name="mydataConType"></a><span class='hs-definition'>mydataConType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DataCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span>
<a name="line-877"></a><span class='hs-comment'>-- ^ Custom version of DataCon.dataConUserType where we</span>
<a name="line-878"></a><span class='hs-comment'>-- - remove the equality constraints</span>
<a name="line-879"></a><span class='hs-comment'>-- - use the representation types for arguments, including dictionaries</span>
<a name="line-880"></a><span class='hs-comment'>-- - keep the original result type</span>
<a name="line-881"></a><span class='hs-definition'>mydataConType</span> <span class='hs-varid'>dc</span>
<a name="line-882"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkForAllTys</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>univ_tvs</span> <span class='hs-varop'>`minusList`</span> <span class='hs-varid'>map</span> <span class='hs-varid'>fst</span> <span class='hs-varid'>eq_spec</span><span class='hs-layout'>)</span> <span class='hs-varop'>++</span> <span class='hs-varid'>ex_tvs</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-883"></a> <span class='hs-varid'>mkFunTys</span> <span class='hs-varid'>arg_tys</span> <span class='hs-varop'>$</span>
<a name="line-884"></a> <span class='hs-varid'>res_ty</span>
<a name="line-885"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>univ_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConUnivTyVars</span> <span class='hs-varid'>dc</span>
<a name="line-886"></a> <span class='hs-varid'>ex_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConExTyVars</span> <span class='hs-varid'>dc</span>
<a name="line-887"></a> <span class='hs-varid'>eq_spec</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConEqSpec</span> <span class='hs-varid'>dc</span>
<a name="line-888"></a> <span class='hs-varid'>arg_tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-keyword'>case</span> <span class='hs-varid'>a</span> <span class='hs-keyword'>of</span>
<a name="line-889"></a> <span class='hs-conid'>PredTy</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>predTypeRep</span> <span class='hs-varid'>p</span>
<a name="line-890"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span>
<a name="line-891"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>dataConRepArgTys</span> <span class='hs-varid'>dc</span><span class='hs-keyglyph'>]</span>
<a name="line-892"></a> <span class='hs-varid'>res_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConOrigResTy</span> <span class='hs-varid'>dc</span>
<a name="line-893"></a>
<a name="line-894"></a><a name="isRefType"></a><span class='hs-definition'>isRefType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-895"></a><span class='hs-definition'>isRefType</span> <span class='hs-varid'>ty</span>
<a name="line-896"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tc</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'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>ty'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isRefTyCon</span> <span class='hs-varid'>tc</span>
<a name="line-897"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-898"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>ty'</span><span class='hs-keyglyph'>=</span> <span class='hs-varid'>repType</span> <span class='hs-varid'>ty</span>
<a name="line-899"></a>
<a name="line-900"></a><a name="isRefTyCon"></a><span class='hs-definition'>isRefTyCon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-901"></a><span class='hs-definition'>isRefTyCon</span> <span class='hs-varid'>tc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tc</span> <span class='hs-varop'>`elem`</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>mutVarPrimTyCon</span><span class='hs-layout'>,</span> <span class='hs-varid'>mVarPrimTyCon</span><span class='hs-layout'>,</span> <span class='hs-varid'>tVarPrimTyCon</span><span class='hs-keyglyph'>]</span>
<a name="line-902"></a>
<a name="line-903"></a><span class='hs-comment'>-- Soundness checks</span>
<a name="line-904"></a><span class='hs-comment'>--------------------</span>
<a name="line-905"></a><span class='hs-comment'>{-
<a name="line-906"></a>This is not formalized anywhere, so hold to your seats!
<a name="line-907"></a>RTTI in the presence of newtypes can be a tricky and unsound business.
<a name="line-908"></a>
<a name="line-909"></a>Example:
<a name="line-910"></a>~~~~~~~~~
<a name="line-911"></a>Suppose we are doing RTTI for a partially evaluated
<a name="line-912"></a>closure t, the real type of which is t :: MkT Int, for
<a name="line-913"></a>
<a name="line-914"></a> newtype MkT a = MkT [Maybe a]
<a name="line-915"></a>
<a name="line-916"></a>The table below shows the results of RTTI and the improvement
<a name="line-917"></a>calculated for different combinations of evaluatedness and :type t.
<a name="line-918"></a>Regard the two first columns as input and the next two as output.
<a name="line-919"></a>
<a name="line-920"></a> # | t | :type t | rtti(t) | improv. | result
<a name="line-921"></a> ------------------------------------------------------------
<a name="line-922"></a> 1 | _ | t b | a | none | OK
<a name="line-923"></a> 2 | _ | MkT b | a | none | OK
<a name="line-924"></a> 3 | _ | t Int | a | none | OK
<a name="line-925"></a>
<a name="line-926"></a> If t is not evaluated at *all*, we are safe.
<a name="line-927"></a>
<a name="line-928"></a> 4 | (_ : _) | t b | [a] | t = [] | UNSOUND
<a name="line-929"></a> 5 | (_ : _) | MkT b | MkT a | none | OK (compensating for the missing newtype)
<a name="line-930"></a> 6 | (_ : _) | t Int | [Int] | t = [] | UNSOUND
<a name="line-931"></a>
<a name="line-932"></a> If a is a minimal whnf, we run into trouble. Note that
<a name="line-933"></a> row 5 above does newtype enrichment on the ty_rtty parameter.
<a name="line-934"></a>
<a name="line-935"></a> 7 | (Just _:_)| t b |[Maybe a] | t = [], | UNSOUND
<a name="line-936"></a> | | | b = Maybe a|
<a name="line-937"></a>
<a name="line-938"></a> 8 | (Just _:_)| MkT b | MkT a | none | OK
<a name="line-939"></a> 9 | (Just _:_)| t Int | FAIL | none | OK
<a name="line-940"></a>
<a name="line-941"></a> And if t is any more evaluated than whnf, we are still in trouble.
<a name="line-942"></a> Because constraints are solved in top-down order, when we reach the
<a name="line-943"></a> Maybe subterm what we got is already unsound. This explains why the
<a name="line-944"></a> row 9 fails to complete.
<a name="line-945"></a>
<a name="line-946"></a> 10 | (Just _:_)| t Int | [Maybe a] | FAIL | OK
<a name="line-947"></a> 11 | (Just 1:_)| t Int | [Maybe Int] | FAIL | OK
<a name="line-948"></a>
<a name="line-949"></a> We can undo the failure in row 9 by leaving out the constraint
<a name="line-950"></a> coming from the type signature of t (i.e., the 2nd column).
<a name="line-951"></a> Note that this type information is still used
<a name="line-952"></a> to calculate the improvement. But we fail
<a name="line-953"></a> when trying to calculate the improvement, as there is no unifier for
<a name="line-954"></a> t Int = [Maybe a] or t Int = [Maybe Int].
<a name="line-955"></a>
<a name="line-956"></a>
<a name="line-957"></a> Another set of examples with t :: [MkT (Maybe Int)] \equiv [[Maybe (Maybe Int)]]
<a name="line-958"></a>
<a name="line-959"></a> # | t | :type t | rtti(t) | improvement | result
<a name="line-960"></a> ---------------------------------------------------------------------
<a name="line-961"></a> 1 |(Just _:_) | [t (Maybe a)] | [[Maybe b]] | t = [] |
<a name="line-962"></a> | | | | b = Maybe a |
<a name="line-963"></a>
<a name="line-964"></a>The checks:
<a name="line-965"></a>~~~~~~~~~~~
<a name="line-966"></a>Consider a function obtainType that takes a value and a type and produces
<a name="line-967"></a>the Term representation and a substitution (the improvement).
<a name="line-968"></a>Assume an auxiliar rtti' function which does the actual job if recovering
<a name="line-969"></a>the type, but which may produce a false type.
<a name="line-970"></a>
<a name="line-971"></a>In pseudocode:
<a name="line-972"></a>
<a name="line-973"></a> rtti' :: a -> IO Type -- Does not use the static type information
<a name="line-974"></a>
<a name="line-975"></a> obtainType :: a -> Type -> IO (Maybe (Term, Improvement))
<a name="line-976"></a> obtainType v old_ty = do
<a name="line-977"></a> rtti_ty <- rtti' v
<a name="line-978"></a> if monomorphic rtti_ty || (check rtti_ty old_ty)
<a name="line-979"></a> then ...
<a name="line-980"></a> else return Nothing
<a name="line-981"></a> where check rtti_ty old_ty = check1 rtti_ty &&
<a name="line-982"></a> check2 rtti_ty old_ty
<a name="line-983"></a>
<a name="line-984"></a> check1 :: Type -> Bool
<a name="line-985"></a> check2 :: Type -> Type -> Bool
<a name="line-986"></a>
<a name="line-987"></a>Now, if rtti' returns a monomorphic type, we are safe.
<a name="line-988"></a>If that is not the case, then we consider two conditions.
<a name="line-989"></a>
<a name="line-990"></a>
<a name="line-991"></a>1. To prevent the class of unsoundness displayed by
<a name="line-992"></a> rows 4 and 7 in the example: no higher kind tyvars
<a name="line-993"></a> accepted.
<a name="line-994"></a>
<a name="line-995"></a> check1 (t a) = NO
<a name="line-996"></a> check1 (t Int) = NO
<a name="line-997"></a> check1 ([] a) = YES
<a name="line-998"></a>
<a name="line-999"></a>2. To prevent the class of unsoundness shown by row 6,
<a name="line-1000"></a> the rtti type should be structurally more
<a name="line-1001"></a> defined than the old type we are comparing it to.
<a name="line-1002"></a> check2 :: NewType -> OldType -> Bool
<a name="line-1003"></a> check2 a _ = True
<a name="line-1004"></a> check2 [a] a = True
<a name="line-1005"></a> check2 [a] (t Int) = False
<a name="line-1006"></a> check2 [a] (t a) = False -- By check1 we never reach this equation
<a name="line-1007"></a> check2 [Int] a = True
<a name="line-1008"></a> check2 [Int] (t Int) = True
<a name="line-1009"></a> check2 [Maybe a] (t Int) = False
<a name="line-1010"></a> check2 [Maybe Int] (t Int) = True
<a name="line-1011"></a> check2 (Maybe [a]) (m [Int]) = False
<a name="line-1012"></a> check2 (Maybe [Int]) (m [Int]) = True
<a name="line-1013"></a>
<a name="line-1014"></a>-}</span>
<a name="line-1015"></a>
<a name="line-1016"></a><a name="check1"></a><span class='hs-definition'>check1</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-1017"></a><span class='hs-definition'>check1</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>tvs</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-keyglyph'><-</span> <span class='hs-varid'>tcSplitSigmaTy</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-varop'>$</span> <span class='hs-varid'>any</span> <span class='hs-varid'>isHigherKind</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>tyVarKind</span> <span class='hs-varid'>tvs</span><span class='hs-layout'>)</span>
<a name="line-1018"></a> <span class='hs-keyword'>where</span>
<a name="line-1019"></a> <span class='hs-varid'>isHigherKind</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-varop'>.</span> <span class='hs-varid'>null</span> <span class='hs-varop'>.</span> <span class='hs-varid'>fst</span> <span class='hs-varop'>.</span> <span class='hs-varid'>splitKindFunTys</span>
<a name="line-1020"></a>
<a name="line-1021"></a><a name="check2"></a><span class='hs-definition'>check2</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'>Bool</span>
<a name="line-1022"></a><span class='hs-definition'>check2</span> <span class='hs-varid'>sigma_rtti_ty</span> <span class='hs-varid'>sigma_old_ty</span>
<a name="line-1023"></a> <span class='hs-keyglyph'>|</span> <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'>rttis</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>rtti_ty</span>
<a name="line-1024"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-conid'>()</span> <span class='hs-keyword'>of</span>
<a name="line-1025"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>|</span> <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'>olds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>old_ty</span>
<a name="line-1026"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>and</span><span class='hs-varop'>$</span> <span class='hs-varid'>zipWith</span> <span class='hs-varid'>check2</span> <span class='hs-varid'>rttis</span> <span class='hs-varid'>olds</span>
<a name="line-1027"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>splitAppTy_maybe</span> <span class='hs-varid'>old_ty</span>
<a name="line-1028"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>isMonomorphicOnNonPhantomArgs</span> <span class='hs-varid'>rtti_ty</span>
<a name="line-1029"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>True</span>
<a name="line-1030"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-1031"></a> <span class='hs-keyword'>where</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'>rtti_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcSplitSigmaTy</span> <span class='hs-varid'>sigma_rtti_ty</span>
<a name="line-1032"></a> <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'>old_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcSplitSigmaTy</span> <span class='hs-varid'>sigma_old_ty</span>
<a name="line-1033"></a>
<a name="line-1034"></a>
<a name="line-1035"></a><a name="congruenceNewtypes"></a><span class='hs-comment'>-- Dealing with newtypes</span>
<a name="line-1036"></a><span class='hs-comment'>--------------------------</span>
<a name="line-1037"></a><span class='hs-comment'>{-
<a name="line-1038"></a> congruenceNewtypes does a parallel fold over two Type values,
<a name="line-1039"></a> compensating for missing newtypes on both sides.
<a name="line-1040"></a> This is necessary because newtypes are not present
<a name="line-1041"></a> in runtime, but sometimes there is evidence available.
<a name="line-1042"></a> Evidence can come from DataCon signatures or
<a name="line-1043"></a> from compile-time type inference.
<a name="line-1044"></a> What we are doing here is an approximation
<a name="line-1045"></a> of unification modulo a set of equations derived
<a name="line-1046"></a> from newtype definitions. These equations should be the
<a name="line-1047"></a> same as the equality coercions generated for newtypes
<a name="line-1048"></a> in System Fc. The idea is to perform a sort of rewriting,
<a name="line-1049"></a> taking those equations as rules, before launching unification.
<a name="line-1050"></a>
<a name="line-1051"></a> The caller must ensure the following.
<a name="line-1052"></a> The 1st type (lhs) comes from the heap structure of ptrs,nptrs.
<a name="line-1053"></a> The 2nd type (rhs) comes from a DataCon type signature.
<a name="line-1054"></a> Rewriting (i.e. adding/removing a newtype wrapper) can happen
<a name="line-1055"></a> in both types, but in the rhs it is restricted to the result type.
<a name="line-1056"></a>
<a name="line-1057"></a> Note that it is very tricky to make this 'rewriting'
<a name="line-1058"></a> work with the unification implemented by TcM, where
<a name="line-1059"></a> substitutions are operationally inlined. The order in which
<a name="line-1060"></a> constraints are unified is vital as we cannot modify
<a name="line-1061"></a> anything that has been touched by a previous unification step.
<a name="line-1062"></a>Therefore, congruenceNewtypes is sound only if the types
<a name="line-1063"></a>recovered by the RTTI mechanism are unified Top-Down.
<a name="line-1064"></a>-}</span>
<a name="line-1065"></a><span class='hs-definition'>congruenceNewtypes</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</span> <span class='hs-layout'>(</span><span class='hs-conid'>TcType</span><span class='hs-layout'>,</span><span class='hs-conid'>TcType</span><span class='hs-layout'>)</span>
<a name="line-1066"></a><span class='hs-definition'>congruenceNewtypes</span> <span class='hs-varid'>lhs</span> <span class='hs-varid'>rhs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-varid'>lhs</span> <span class='hs-varid'>rhs</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>rhs'</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>lhs</span><span class='hs-layout'>,</span><span class='hs-varid'>rhs'</span><span class='hs-layout'>)</span>
<a name="line-1067"></a> <span class='hs-keyword'>where</span>
<a name="line-1068"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>l</span> <span class='hs-varid'>r</span>
<a name="line-1069"></a> <span class='hs-comment'>-- TyVar lhs inductive case</span>
<a name="line-1070"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>tv</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getTyVar_maybe</span> <span class='hs-varid'>l</span>
<a name="line-1071"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>recoverTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-1072"></a> <span class='hs-conid'>Indirect</span> <span class='hs-varid'>ty_v</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>readMetaTyVar</span> <span class='hs-varid'>tv</span>
<a name="line-1073"></a> <span class='hs-varid'>traceTR</span> <span class='hs-varop'>$</span> <span class='hs-varid'>fsep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>text</span> <span class='hs-str'>"(congruence) Following indirect tyvar:"</span><span class='hs-layout'>,</span>
<a name="line-1074"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tv</span><span class='hs-layout'>,</span> <span class='hs-varid'>equals</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>ty_v</span><span class='hs-keyglyph'>]</span>
<a name="line-1075"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>ty_v</span> <span class='hs-varid'>r</span>
<a name="line-1076"></a><span class='hs-comment'>-- FunTy inductive case</span>
<a name="line-1077"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>l1</span><span class='hs-layout'>,</span><span class='hs-varid'>l2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>splitFunTy_maybe</span> <span class='hs-varid'>l</span>
<a name="line-1078"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>r1</span><span class='hs-layout'>,</span><span class='hs-varid'>r2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>splitFunTy_maybe</span> <span class='hs-varid'>r</span>
<a name="line-1079"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>r2'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>go</span> <span class='hs-varid'>l2</span> <span class='hs-varid'>r2</span>
<a name="line-1080"></a> <span class='hs-varid'>r1'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>go</span> <span class='hs-varid'>l1</span> <span class='hs-varid'>r1</span>
<a name="line-1081"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkFunTy</span> <span class='hs-varid'>r1'</span> <span class='hs-varid'>r2'</span><span class='hs-layout'>)</span>
<a name="line-1082"></a><span class='hs-comment'>-- TyconApp Inductive case; this is the interesting bit.</span>
<a name="line-1083"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tycon_l</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'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>lhs</span>
<a name="line-1084"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tycon_r</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'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>rhs</span>
<a name="line-1085"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>tycon_l</span> <span class='hs-varop'>/=</span> <span class='hs-varid'>tycon_r</span>
<a name="line-1086"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>upgrade</span> <span class='hs-varid'>tycon_l</span> <span class='hs-varid'>r</span>
<a name="line-1087"></a>
<a name="line-1088"></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-varid'>r</span>
<a name="line-1089"></a>
<a name="line-1090"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>upgrade</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TR</span> <span class='hs-conid'>Type</span>
<a name="line-1091"></a> <span class='hs-varid'>upgrade</span> <span class='hs-varid'>new_tycon</span> <span class='hs-varid'>ty</span>
<a name="line-1092"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isNewTyCon</span> <span class='hs-varid'>new_tycon</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-1093"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"(Upgrade) Not matching newtype evidence: "</span> <span class='hs-varop'><></span>
<a name="line-1094"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>new_tycon</span> <span class='hs-varop'><></span> <span class='hs-varid'>text</span> <span class='hs-str'>" for "</span> <span class='hs-varop'><></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-1095"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>ty</span>
<a name="line-1096"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-1097"></a> <span class='hs-varid'>traceTR</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"(Upgrade) upgraded "</span> <span class='hs-varop'><></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>ty</span> <span class='hs-varop'><></span>
<a name="line-1098"></a> <span class='hs-varid'>text</span> <span class='hs-str'>" in presence of newtype evidence "</span> <span class='hs-varop'><></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>new_tycon</span><span class='hs-layout'>)</span>
<a name="line-1099"></a> <span class='hs-varid'>vars</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>newVar</span> <span class='hs-varop'>.</span> <span class='hs-varid'>tyVarKind</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyConTyVars</span> <span class='hs-varid'>new_tycon</span><span class='hs-layout'>)</span>
<a name="line-1100"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>ty'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTyConApp</span> <span class='hs-varid'>new_tycon</span> <span class='hs-varid'>vars</span>
<a name="line-1101"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>liftTcM</span> <span class='hs-layout'>(</span><span class='hs-varid'>boxyUnify</span> <span class='hs-varid'>ty</span> <span class='hs-layout'>(</span><span class='hs-varid'>repType</span> <span class='hs-varid'>ty'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-1102"></a> <span class='hs-comment'>-- assumes that reptype doesn't ^^^^ touch tyconApp args </span>
<a name="line-1103"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>ty'</span>
<a name="line-1104"></a>
<a name="line-1105"></a>
<a name="line-1106"></a><a name="zonkTerm"></a><span class='hs-definition'>zonkTerm</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Term</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>Term</span>
<a name="line-1107"></a><span class='hs-definition'>zonkTerm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldTermM</span> <span class='hs-conid'>TermFoldM</span><span class='hs-layout'>{</span>
<a name="line-1108"></a> <span class='hs-varid'>fTermM</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>v</span> <span class='hs-varid'>tt</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>zonkTcType</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty'</span> <span class='hs-keyglyph'>-></span>
<a name="line-1109"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Term</span> <span class='hs-varid'>ty'</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>v</span> <span class='hs-varid'>tt</span><span class='hs-layout'>)</span>
<a name="line-1110"></a> <span class='hs-layout'>,</span><span class='hs-varid'>fSuspensionM</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ct</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>v</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>zonkTcType</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-keyglyph'>-></span>
<a name="line-1111"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Suspension</span> <span class='hs-varid'>ct</span> <span class='hs-varid'>ty</span> <span class='hs-varid'>v</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span>
<a name="line-1112"></a> <span class='hs-layout'>,</span><span class='hs-varid'>fNewtypeWrapM</span><span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>zonkTcType</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty'</span> <span class='hs-keyglyph'>-></span>
<a name="line-1113"></a> <span class='hs-varid'>return</span><span class='hs-varop'>$</span> <span class='hs-conid'>NewtypeWrap</span> <span class='hs-varid'>ty'</span> <span class='hs-varid'>dc</span> <span class='hs-varid'>t</span>
<a name="line-1114"></a> <span class='hs-layout'>,</span><span class='hs-varid'>fRefWrapM</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>ty</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span>
<a name="line-1115"></a> <span class='hs-varid'>return</span> <span class='hs-conid'>RefWrap</span> <span class='hs-varop'>`ap`</span> <span class='hs-varid'>zonkTcType</span> <span class='hs-varid'>ty</span> <span class='hs-varop'>`ap`</span> <span class='hs-varid'>return</span> <span class='hs-varid'>t</span>
<a name="line-1116"></a> <span class='hs-layout'>,</span><span class='hs-varid'>fPrimM</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span><span class='hs-varop'>.</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-conid'>Prim</span>
<a name="line-1117"></a> <span class='hs-layout'>}</span>
<a name="line-1118"></a>
<a name="line-1119"></a><a name="dictsView"></a><span class='hs-comment'>--------------------------------------------------------------------------------</span>
<a name="line-1120"></a><span class='hs-comment'>-- Restore Class predicates out of a representation type</span>
<a name="line-1121"></a><span class='hs-definition'>dictsView</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span>
<a name="line-1122"></a><span class='hs-comment'>-- dictsView ty = ty</span>
<a name="line-1123"></a><span class='hs-definition'>dictsView</span> <span class='hs-layout'>(</span><span class='hs-conid'>FunTy</span> <span class='hs-layout'>(</span><span class='hs-conid'>TyConApp</span> <span class='hs-varid'>tc_dict</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-1124"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tyConClass_maybe</span> <span class='hs-varid'>tc_dict</span>
<a name="line-1125"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>FunTy</span> <span class='hs-layout'>(</span><span class='hs-conid'>PredTy</span> <span class='hs-layout'>(</span><span class='hs-conid'>ClassP</span> <span class='hs-varid'>c</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>dictsView</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-1126"></a><span class='hs-definition'>dictsView</span> <span class='hs-varid'>ty</span>
<a name="line-1127"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tc_fun</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyConApp</span> <span class='hs-varid'>tc_dict</span> <span class='hs-varid'>args</span><span class='hs-layout'>,</span> <span class='hs-varid'>ty2</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>ty</span>
<a name="line-1128"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tyConClass_maybe</span> <span class='hs-varid'>tc_dict</span>
<a name="line-1129"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTyConApp</span> <span class='hs-varid'>tc_fun</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>PredTy</span> <span class='hs-layout'>(</span><span class='hs-conid'>ClassP</span> <span class='hs-varid'>c</span> <span class='hs-varid'>args</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>dictsView</span> <span class='hs-varid'>ty2</span><span class='hs-keyglyph'>]</span>
<a name="line-1130"></a><span class='hs-definition'>dictsView</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ty</span>
<a name="line-1131"></a>
<a name="line-1132"></a>
<a name="line-1133"></a><a name="isMonomorphic"></a><span class='hs-comment'>-- Use only for RTTI types</span>
<a name="line-1134"></a><span class='hs-definition'>isMonomorphic</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-1135"></a><span class='hs-definition'>isMonomorphic</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>noExistentials</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>noUniversals</span>
<a name="line-1136"></a> <span class='hs-keyword'>where</span> <span class='hs-layout'>(</span><span class='hs-varid'>tvs</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>ty'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcSplitSigmaTy</span> <span class='hs-varid'>ty</span>
<a name="line-1137"></a> <span class='hs-varid'>noExistentials</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isEmptyVarSet</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyVarsOfType</span> <span class='hs-varid'>ty'</span><span class='hs-layout'>)</span>
<a name="line-1138"></a> <span class='hs-varid'>noUniversals</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>null</span> <span class='hs-varid'>tvs</span>
<a name="line-1139"></a>
<a name="line-1140"></a><a name="isMonomorphicOnNonPhantomArgs"></a><span class='hs-comment'>-- Use only for RTTI types</span>
<a name="line-1141"></a><span class='hs-definition'>isMonomorphicOnNonPhantomArgs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RttiType</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-1142"></a><span class='hs-definition'>isMonomorphicOnNonPhantomArgs</span> <span class='hs-varid'>ty</span>
<a name="line-1143"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tc</span><span class='hs-layout'>,</span> <span class='hs-varid'>all_args</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcSplitTyConApp_maybe</span> <span class='hs-layout'>(</span><span class='hs-varid'>repType</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-1144"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>phantom_vars</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tyConPhantomTyVars</span> <span class='hs-varid'>tc</span>
<a name="line-1145"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>concrete_args</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>arg</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyv</span><span class='hs-layout'>,</span><span class='hs-varid'>arg</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tyConTyVars</span> <span class='hs-varid'>tc</span> <span class='hs-varop'>`zip`</span> <span class='hs-varid'>all_args</span>
<a name="line-1146"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>tyv</span> <span class='hs-varop'>`notElem`</span> <span class='hs-varid'>phantom_vars</span><span class='hs-keyglyph'>]</span>
<a name="line-1147"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>all</span> <span class='hs-varid'>isMonomorphicOnNonPhantomArgs</span> <span class='hs-varid'>concrete_args</span>
<a name="line-1148"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>ty1</span><span class='hs-layout'>,</span> <span class='hs-varid'>ty2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>splitFunTy_maybe</span> <span class='hs-varid'>ty</span>
<a name="line-1149"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>all</span> <span class='hs-varid'>isMonomorphicOnNonPhantomArgs</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ty1</span><span class='hs-layout'>,</span><span class='hs-varid'>ty2</span><span class='hs-keyglyph'>]</span>
<a name="line-1150"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isMonomorphic</span> <span class='hs-varid'>ty</span>
<a name="line-1151"></a>
<a name="line-1152"></a><a name="tyConPhantomTyVars"></a><span class='hs-definition'>tyConPhantomTyVars</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'>TyVar</span><span class='hs-keyglyph'>]</span>
<a name="line-1153"></a><span class='hs-definition'>tyConPhantomTyVars</span> <span class='hs-varid'>tc</span>
<a name="line-1154"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isAlgTyCon</span> <span class='hs-varid'>tc</span>
<a name="line-1155"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>dcs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tyConDataCons_maybe</span> <span class='hs-varid'>tc</span>
<a name="line-1156"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>dc_vars</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>concatMap</span> <span class='hs-varid'>dataConUnivTyVars</span> <span class='hs-varid'>dcs</span>
<a name="line-1157"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tyConTyVars</span> <span class='hs-varid'>tc</span> <span class='hs-varop'>\\</span> <span class='hs-varid'>dc_vars</span>
<a name="line-1158"></a><span class='hs-definition'>tyConPhantomTyVars</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-1159"></a>
<a name="line-1160"></a><a name="sigmaType"></a><span class='hs-comment'>-- Is this defined elsewhere?</span>
<a name="line-1161"></a><span class='hs-comment'>-- Generalize the type: find all free tyvars and wrap in the appropiate ForAll.</span>
<a name="line-1162"></a><span class='hs-definition'>sigmaType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span>
<a name="line-1163"></a><span class='hs-definition'>sigmaType</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkSigmaTy</span> <span class='hs-layout'>(</span><span class='hs-varid'>varSetElems</span><span class='hs-varop'>$</span> <span class='hs-varid'>tyVarsOfType</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>ty</span>
<a name="line-1164"></a>
<a name="line-1165"></a>
<a name="line-1166"></a><a name="mapMif"></a><span class='hs-definition'>mapMif</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span>
<a name="line-1167"></a><span class='hs-definition'>mapMif</span> <span class='hs-varid'>pred</span> <span class='hs-varid'>f</span> <span class='hs-varid'>xx</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sequence</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mapMif_</span> <span class='hs-varid'>pred</span> <span class='hs-varid'>f</span> <span class='hs-varid'>xx</span>
<a name="line-1168"></a> <span class='hs-keyword'>where</span>
<a name="line-1169"></a> <span class='hs-varid'>mapMif_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-1170"></a> <span class='hs-varid'>mapMif_</span> <span class='hs-varid'>pred</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-conop'>:</span><span class='hs-varid'>xx</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>pred</span> <span class='hs-varid'>x</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>f</span> <span class='hs-varid'>x</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>mapMif_</span> <span class='hs-varid'>pred</span> <span class='hs-varid'>f</span> <span class='hs-varid'>xx</span>
<a name="line-1171"></a>
<a name="line-1172"></a><a name="unlessM"></a><span class='hs-definition'>unlessM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>m</span> <span class='hs-conid'>Bool</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>()</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-conid'>()</span>
<a name="line-1173"></a><span class='hs-definition'>unlessM</span> <span class='hs-varid'>condM</span> <span class='hs-varid'>acc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>condM</span> <span class='hs-varop'>>>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>c</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unless</span> <span class='hs-varid'>c</span> <span class='hs-varid'>acc</span>
<a name="line-1174"></a>
<a name="line-1175"></a>
<a name="line-1176"></a><a name="appArr"></a><span class='hs-comment'>-- Strict application of f at index i</span>
<a name="line-1177"></a><span class='hs-definition'>appArr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Ix</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>e</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Array</span> <span class='hs-varid'>i</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span>
<a name="line-1178"></a><span class='hs-definition'>appArr</span> <span class='hs-varid'>f</span> <span class='hs-varid'>a</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Array</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>ptrs</span><span class='hs-cpp'>#</span><span class='hs-layout'>)</span> <span class='hs-varid'>i</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>I</span><span class='hs-cpp'>#</span> <span class='hs-varid'>i</span><span class='hs-cpp'>#</span><span class='hs-layout'>)</span>
<a name="line-1179"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT2</span> <span class='hs-layout'>(</span><span class='hs-varid'>i</span> <span class='hs-varop'><</span> <span class='hs-varid'>length</span><span class='hs-layout'>(</span><span class='hs-varid'>elems</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppr</span><span class='hs-layout'>(</span><span class='hs-varid'>length</span><span class='hs-varop'>$</span> <span class='hs-varid'>elems</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-1180"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>indexArray</span><span class='hs-cpp'>#</span> <span class='hs-varid'>ptrs</span><span class='hs-cpp'>#</span> <span class='hs-varid'>i</span><span class='hs-cpp'>#</span> <span class='hs-keyword'>of</span>
<a name="line-1181"></a> <span class='hs-layout'>(</span><span class='hs-cpp'>#</span> <span class='hs-varid'>e</span> <span class='hs-cpp'>#</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>f</span> <span class='hs-varid'>e</span>
<a name="line-1182"></a>
<a name="line-1183"></a><a name="amap'"></a><span class='hs-definition'>amap'</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Array</span> <span class='hs-conid'>Int</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>b</span><span class='hs-keyglyph'>]</span>
<a name="line-1184"></a><span class='hs-definition'>amap'</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-conid'>Array</span> <span class='hs-varid'>i0</span> <span class='hs-varid'>i</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>arr</span><span class='hs-cpp'>#</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>g</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span> <span class='hs-keyglyph'>..</span> <span class='hs-varid'>i</span> <span class='hs-comment'>-</span> <span class='hs-varid'>i0</span><span class='hs-keyglyph'>]</span>
<a name="line-1185"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>g</span> <span class='hs-layout'>(</span><span class='hs-conid'>I</span><span class='hs-cpp'>#</span> <span class='hs-varid'>i</span><span class='hs-cpp'>#</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>indexArray</span><span class='hs-cpp'>#</span> <span class='hs-varid'>arr</span><span class='hs-cpp'>#</span> <span class='hs-varid'>i</span><span class='hs-cpp'>#</span> <span class='hs-keyword'>of</span>
<a name="line-1186"></a> <span class='hs-layout'>(</span><span class='hs-cpp'>#</span> <span class='hs-varid'>e</span> <span class='hs-cpp'>#</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>f</span> <span class='hs-varid'>e</span>
<a name="line-1187"></a>
<a name="line-1188"></a>
<a name="line-1189"></a><a name="isLifted"></a><span class='hs-definition'>isLifted</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-1190"></a><span class='hs-definition'>isLifted</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-varop'>.</span> <span class='hs-varid'>isUnLiftedType</span>
<a name="line-1191"></a>
<a name="line-1192"></a><a name="extractUnboxed"></a><span class='hs-definition'>extractUnboxed</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Closure</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Word</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span>
<a name="line-1193"></a><span class='hs-definition'>extractUnboxed</span> <span class='hs-varid'>tt</span> <span class='hs-varid'>clos</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-varid'>tt</span> <span class='hs-layout'>(</span><span class='hs-varid'>nonPtrs</span> <span class='hs-varid'>clos</span><span class='hs-layout'>)</span>
<a name="line-1194"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>sizeofType</span> <span class='hs-varid'>t</span>
<a name="line-1195"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tycon</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcSplitTyConApp_maybe</span> <span class='hs-varid'>t</span>
<a name="line-1196"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT</span> <span class='hs-layout'>(</span><span class='hs-varid'>isPrimTyCon</span> <span class='hs-varid'>tycon</span><span class='hs-layout'>)</span> <span class='hs-varid'>sizeofTyCon</span> <span class='hs-varid'>tycon</span>
<a name="line-1197"></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'>"Expected a TcTyCon"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span>
<a name="line-1198"></a> <span class='hs-varid'>go</span> <span class='hs-conid'>[]</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-1199"></a> <span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-varid'>t</span><span class='hs-conop'>:</span><span class='hs-varid'>tt</span><span class='hs-layout'>)</span> <span class='hs-varid'>xx</span>
<a name="line-1200"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span> <span class='hs-varid'>rest</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>splitAt</span> <span class='hs-layout'>(</span><span class='hs-varid'>sizeofType</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-varid'>xx</span>
<a name="line-1201"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span> <span class='hs-conop'>:</span> <span class='hs-varid'>go</span> <span class='hs-varid'>tt</span> <span class='hs-varid'>rest</span>
<a name="line-1202"></a>
<a name="line-1203"></a><a name="sizeofTyCon"></a><span class='hs-definition'>sizeofTyCon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyCon</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-comment'>-- in *words*</span>
<a name="line-1204"></a><span class='hs-definition'>sizeofTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>primRepSizeW</span> <span class='hs-varop'>.</span> <span class='hs-varid'>tyConPrimRep</span>
<a name="line-1205"></a>
<a name="line-1206"></a>
<a name="line-1207"></a><a name="|.|"></a><span class='hs-layout'>(</span><span class='hs-varop'>|.|</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-1208"></a><span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varop'>|.|</span> <span class='hs-varid'>g</span><span class='hs-layout'>)</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>f</span> <span class='hs-varid'>x</span> <span class='hs-varop'>||</span> <span class='hs-varid'>g</span> <span class='hs-varid'>x</span>
</pre></body>
</html>
