<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html> <head> <!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ --> <title>typecheck/TcEnv.lhs</title> <link type='text/css' rel='stylesheet' href='hscolour.css' /> </head> <body> % % (c) The University of Glasgow 2006 % \begin{code} <pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>TcEnv</span><span class='hs-layout'>(</span> <a name="line-2"></a> <span class='hs-conid'>TyThing</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>TcTyThing</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>,</span> <a name="line-3"></a> <a name="line-4"></a> <span class='hs-comment'>-- Instance environment, and InstInfo type</span> <a name="line-5"></a> <span class='hs-conid'>InstInfo</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'>iDFunId</span><span class='hs-layout'>,</span> <span class='hs-varid'>pprInstInfo</span><span class='hs-layout'>,</span> <span class='hs-varid'>pprInstInfoDetails</span><span class='hs-layout'>,</span> <a name="line-6"></a> <span class='hs-varid'>simpleInstInfoClsTy</span><span class='hs-layout'>,</span> <span class='hs-varid'>simpleInstInfoTy</span><span class='hs-layout'>,</span> <span class='hs-varid'>simpleInstInfoTyCon</span><span class='hs-layout'>,</span> <a name="line-7"></a> <span class='hs-conid'>InstBindings</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <a name="line-8"></a> <a name="line-9"></a> <span class='hs-comment'>-- Global environment</span> <a name="line-10"></a> <span class='hs-varid'>tcExtendGlobalEnv</span><span class='hs-layout'>,</span> <span class='hs-varid'>setGlobalTypeEnv</span><span class='hs-layout'>,</span> <a name="line-11"></a> <span class='hs-varid'>tcExtendGlobalValEnv</span><span class='hs-layout'>,</span> <a name="line-12"></a> <span class='hs-varid'>tcLookupLocatedGlobal</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcLookupGlobal</span><span class='hs-layout'>,</span> <a name="line-13"></a> <span class='hs-varid'>tcLookupField</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcLookupTyCon</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcLookupClass</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcLookupDataCon</span><span class='hs-layout'>,</span> <a name="line-14"></a> <span class='hs-varid'>tcLookupLocatedGlobalId</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcLookupLocatedTyCon</span><span class='hs-layout'>,</span> <a name="line-15"></a> <span class='hs-varid'>tcLookupLocatedClass</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcLookupFamInst</span><span class='hs-layout'>,</span> <a name="line-16"></a> <a name="line-17"></a> <span class='hs-comment'>-- Local environment</span> <a name="line-18"></a> <span class='hs-varid'>tcExtendKindEnv</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcExtendKindEnvTvs</span><span class='hs-layout'>,</span> <a name="line-19"></a> <span class='hs-varid'>tcExtendTyVarEnv</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcExtendTyVarEnv2</span><span class='hs-layout'>,</span> <a name="line-20"></a> <span class='hs-varid'>tcExtendGhciEnv</span><span class='hs-layout'>,</span> <a name="line-21"></a> <span class='hs-varid'>tcExtendIdEnv</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcExtendIdEnv1</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcExtendIdEnv2</span><span class='hs-layout'>,</span> <a name="line-22"></a> <span class='hs-varid'>tcLookup</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcLookupLocated</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcLookupLocalIds</span><span class='hs-layout'>,</span> <a name="line-23"></a> <span class='hs-varid'>tcLookupId</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcLookupTyVar</span><span class='hs-layout'>,</span> <span class='hs-varid'>getScopedTyVarBinds</span><span class='hs-layout'>,</span> <a name="line-24"></a> <span class='hs-varid'>lclEnvElts</span><span class='hs-layout'>,</span> <span class='hs-varid'>getInLocalScope</span><span class='hs-layout'>,</span> <span class='hs-varid'>findGlobals</span><span class='hs-layout'>,</span> <a name="line-25"></a> <span class='hs-varid'>wrongThingErr</span><span class='hs-layout'>,</span> <span class='hs-varid'>pprBinders</span><span class='hs-layout'>,</span> <a name="line-26"></a> <a name="line-27"></a> <span class='hs-varid'>tcExtendRecEnv</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- For knot-tying</span> <a name="line-28"></a> <a name="line-29"></a> <span class='hs-comment'>-- Rules</span> <a name="line-30"></a> <span class='hs-varid'>tcExtendRules</span><span class='hs-layout'>,</span> <a name="line-31"></a> <a name="line-32"></a> <span class='hs-comment'>-- Global type variables</span> <a name="line-33"></a> <span class='hs-varid'>tcGetGlobalTyVars</span><span class='hs-layout'>,</span> <a name="line-34"></a> <a name="line-35"></a> <span class='hs-comment'>-- Template Haskell stuff</span> <a name="line-36"></a> <span class='hs-varid'>checkWellStaged</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcMetaTy</span><span class='hs-layout'>,</span> <span class='hs-varid'>thLevel</span><span class='hs-layout'>,</span> <a name="line-37"></a> <span class='hs-varid'>topIdLvl</span><span class='hs-layout'>,</span> <span class='hs-varid'>thTopLevelId</span><span class='hs-layout'>,</span> <span class='hs-varid'>thRnBrack</span><span class='hs-layout'>,</span> <span class='hs-varid'>isBrackStage</span><span class='hs-layout'>,</span> <a name="line-38"></a> <a name="line-39"></a> <span class='hs-comment'>-- New Ids</span> <a name="line-40"></a> <span class='hs-varid'>newLocalName</span><span class='hs-layout'>,</span> <span class='hs-varid'>newDFunName</span><span class='hs-layout'>,</span> <span class='hs-varid'>newFamInstTyConName</span><span class='hs-layout'>,</span> <a name="line-41"></a> <span class='hs-varid'>mkStableIdFromString</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkStableIdFromName</span> <a name="line-42"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span> <a name="line-43"></a> <a name="line-44"></a><span class='hs-cpp'>#include "HsVersions.h"</span> <a name="line-45"></a> <a name="line-46"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HsSyn</span> <a name="line-47"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcIface</span> <a name="line-48"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>IfaceEnv</span> <a name="line-49"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcRnMonad</span> <a name="line-50"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcMType</span> <a name="line-51"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcType</span> <a name="line-52"></a><span class='hs-comment'>-- import TcSuspension</span> <a name="line-53"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Type</span> <a name="line-54"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Id</span> <a name="line-55"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Coercion</span> <a name="line-56"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Var</span> <a name="line-57"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarSet</span> <a name="line-58"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarEnv</span> <a name="line-59"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>RdrName</span> <a name="line-60"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>InstEnv</span> <a name="line-61"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FamInstEnv</span> <a name="line-62"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DataCon</span> <a name="line-63"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TyCon</span> <a name="line-64"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TypeRep</span> <a name="line-65"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Class</span> <a name="line-66"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span> <a name="line-67"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>NameEnv</span> <a name="line-68"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HscTypes</span> <a name="line-69"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>SrcLoc</span> <a name="line-70"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span> <a name="line-71"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Unique</span> <a name="line-72"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastString</span> </pre>\end{code} %************************************************************************ %* * %* tcLookupGlobal * %* * %************************************************************************ Using the Located versions (eg. tcLookupLocatedGlobal) is preferred, unless you know that the SrcSpan in the monad is already set to the span of the Name. \begin{code} <pre><a name="line-1"></a><a name="tcLookupLocatedGlobal"></a><span class='hs-definition'>tcLookupLocatedGlobal</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Located</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TyThing</span> <a name="line-2"></a><span class='hs-comment'>-- c.f. IfaceEnvEnv.tcIfaceGlobal</span> <a name="line-3"></a><span class='hs-definition'>tcLookupLocatedGlobal</span> <span class='hs-varid'>name</span> <a name="line-4"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addLocM</span> <span class='hs-varid'>tcLookupGlobal</span> <span class='hs-varid'>name</span> <a name="line-5"></a> <a name="line-6"></a><a name="tcLookupGlobal"></a><span class='hs-definition'>tcLookupGlobal</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TyThing</span> <a name="line-7"></a><span class='hs-comment'>-- The Name is almost always an ExternalName, but not always</span> <a name="line-8"></a><span class='hs-comment'>-- In GHCi, we may make command-line bindings (ghci> let x = True)</span> <a name="line-9"></a><span class='hs-comment'>-- that bind a GlobalId, but with an InternalName</span> <a name="line-10"></a><span class='hs-definition'>tcLookupGlobal</span> <span class='hs-varid'>name</span> <a name="line-11"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getGblEnv</span> <a name="line-12"></a> <a name="line-13"></a> <span class='hs-comment'>-- Try local envt</span> <a name="line-14"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupNameEnv</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcg_type_env</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-varid'>name</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <a name="line-15"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varid'>thing</span> <span class='hs-layout'>;</span> <a name="line-16"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <a name="line-17"></a> <a name="line-18"></a> <span class='hs-comment'>-- Try global envt</span> <a name="line-19"></a> <span class='hs-layout'>{</span> <span class='hs-varid'>hsc_env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getTopEnv</span> <a name="line-20"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>mb_thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>liftIO</span> <span class='hs-layout'>(</span><span class='hs-varid'>lookupTypeHscEnv</span> <span class='hs-varid'>hsc_env</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span> <a name="line-21"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>mb_thing</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <a name="line-22"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varid'>thing</span> <span class='hs-layout'>;</span> <a name="line-23"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <a name="line-24"></a> <a name="line-25"></a> <span class='hs-comment'>-- Should it have been in the local envt?</span> <a name="line-26"></a> <span class='hs-layout'>{</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>nameModule_maybe</span> <span class='hs-varid'>name</span> <span class='hs-keyword'>of</span> <a name="line-27"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>notFound</span> <span class='hs-varid'>name</span> <span class='hs-varid'>env</span> <span class='hs-comment'>-- Internal names can happen in GHCi</span> <a name="line-28"></a> <a name="line-29"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>mod</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>mod</span> <span class='hs-varop'>==</span> <span class='hs-varid'>tcg_mod</span> <span class='hs-varid'>env</span> <span class='hs-comment'>-- Names from this module </span> <a name="line-30"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>notFound</span> <span class='hs-varid'>name</span> <span class='hs-varid'>env</span> <span class='hs-comment'>-- should be in tcg_type_env</span> <a name="line-31"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <a name="line-32"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>tcImportDecl</span> <span class='hs-varid'>name</span> <span class='hs-comment'>-- Go find it in an interface</span> <a name="line-33"></a> <span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span> <a name="line-34"></a> <a name="line-35"></a><a name="tcLookupField"></a><span class='hs-definition'>tcLookupField</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>Id</span> <span class='hs-comment'>-- Returns the selector Id</span> <a name="line-36"></a><span class='hs-definition'>tcLookupField</span> <span class='hs-varid'>name</span> <a name="line-37"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcLookupId</span> <span class='hs-varid'>name</span> <span class='hs-comment'>-- Note [Record field lookup]</span> <a name="line-38"></a> <a name="line-39"></a><span class='hs-comment'>{- Note [Record field lookup] <a name="line-40"></a> ~~~~~~~~~~~~~~~~~~~~~~~~~~ <a name="line-41"></a>You might think we should have tcLookupGlobal here, since record fields <a name="line-42"></a>are always top level. But consider <a name="line-43"></a> f = e { f = True } <a name="line-44"></a>Then the renamer (which does not keep track of what is a record selector <a name="line-45"></a>and what is not) will rename the definition thus <a name="line-46"></a> f_7 = e { f_7 = True } <a name="line-47"></a>Now the type checker will find f_7 in the *local* type environment, not <a name="line-48"></a>the global (imported) one. It's wrong, of course, but we want to report a tidy <a name="line-49"></a>error, not in TcEnv.notFound. -}</span> <a name="line-50"></a> <a name="line-51"></a><a name="tcLookupDataCon"></a><span class='hs-definition'>tcLookupDataCon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>DataCon</span> <a name="line-52"></a><span class='hs-definition'>tcLookupDataCon</span> <span class='hs-varid'>name</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-53"></a> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupGlobal</span> <span class='hs-varid'>name</span> <a name="line-54"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>thing</span> <span class='hs-keyword'>of</span> <a name="line-55"></a> <span class='hs-conid'>ADataCon</span> <span class='hs-varid'>con</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varid'>con</span> <a name="line-56"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>wrongThingErr</span> <span class='hs-str'>"data constructor"</span> <span class='hs-layout'>(</span><span class='hs-conid'>AGlobal</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-varid'>name</span> <a name="line-57"></a> <a name="line-58"></a><a name="tcLookupClass"></a><span class='hs-definition'>tcLookupClass</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>Class</span> <a name="line-59"></a><span class='hs-definition'>tcLookupClass</span> <span class='hs-varid'>name</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-60"></a> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupGlobal</span> <span class='hs-varid'>name</span> <a name="line-61"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>thing</span> <span class='hs-keyword'>of</span> <a name="line-62"></a> <span class='hs-conid'>AClass</span> <span class='hs-varid'>cls</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varid'>cls</span> <a name="line-63"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>wrongThingErr</span> <span class='hs-str'>"class"</span> <span class='hs-layout'>(</span><span class='hs-conid'>AGlobal</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-varid'>name</span> <a name="line-64"></a> <a name="line-65"></a><a name="tcLookupTyCon"></a><span class='hs-definition'>tcLookupTyCon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TyCon</span> <a name="line-66"></a><span class='hs-definition'>tcLookupTyCon</span> <span class='hs-varid'>name</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-67"></a> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupGlobal</span> <span class='hs-varid'>name</span> <a name="line-68"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>thing</span> <span class='hs-keyword'>of</span> <a name="line-69"></a> <span class='hs-conid'>ATyCon</span> <span class='hs-varid'>tc</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varid'>tc</span> <a name="line-70"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>wrongThingErr</span> <span class='hs-str'>"type constructor"</span> <span class='hs-layout'>(</span><span class='hs-conid'>AGlobal</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> <span class='hs-varid'>name</span> <a name="line-71"></a> <a name="line-72"></a><a name="tcLookupLocatedGlobalId"></a><span class='hs-definition'>tcLookupLocatedGlobalId</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Located</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>Id</span> <a name="line-73"></a><span class='hs-definition'>tcLookupLocatedGlobalId</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addLocM</span> <span class='hs-varid'>tcLookupId</span> <a name="line-74"></a> <a name="line-75"></a><a name="tcLookupLocatedClass"></a><span class='hs-definition'>tcLookupLocatedClass</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Located</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>Class</span> <a name="line-76"></a><span class='hs-definition'>tcLookupLocatedClass</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addLocM</span> <span class='hs-varid'>tcLookupClass</span> <a name="line-77"></a> <a name="line-78"></a><a name="tcLookupLocatedTyCon"></a><span class='hs-definition'>tcLookupLocatedTyCon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Located</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TyCon</span> <a name="line-79"></a><span class='hs-definition'>tcLookupLocatedTyCon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addLocM</span> <span class='hs-varid'>tcLookupTyCon</span> <a name="line-80"></a> <a name="line-81"></a><a name="tcLookupFamInst"></a><span class='hs-comment'>-- Look up the instance tycon of a family instance.</span> <a name="line-82"></a><span class='hs-comment'>--</span> <a name="line-83"></a><span class='hs-comment'>-- The match may be ambiguous (as we know that overlapping instances have</span> <a name="line-84"></a><span class='hs-comment'>-- identical right-hand sides under overlapping substitutions - see</span> <a name="line-85"></a><span class='hs-comment'>-- 'FamInstEnv.lookupFamInstEnvConflicts'). However, the type arguments used</span> <a name="line-86"></a><span class='hs-comment'>-- for matching must be equal to or be more specific than those of the family</span> <a name="line-87"></a><span class='hs-comment'>-- instance declaration. We pick one of the matches in case of ambiguity; as</span> <a name="line-88"></a><span class='hs-comment'>-- the right-hand sides are identical under the match substitution, the choice</span> <a name="line-89"></a><span class='hs-comment'>-- does not matter.</span> <a name="line-90"></a><span class='hs-comment'>--</span> <a name="line-91"></a><span class='hs-comment'>-- Return the instance tycon and its type instance. For example, if we have</span> <a name="line-92"></a><span class='hs-comment'>--</span> <a name="line-93"></a><span class='hs-comment'>-- tcLookupFamInst 'T' '[Int]' yields (':R42T', 'Int')</span> <a name="line-94"></a><span class='hs-comment'>--</span> <a name="line-95"></a><span class='hs-comment'>-- then we have a coercion (ie, type instance of family instance coercion)</span> <a name="line-96"></a><span class='hs-comment'>--</span> <a name="line-97"></a><span class='hs-comment'>-- :Co:R42T Int :: T [Int] ~ :R42T Int</span> <a name="line-98"></a><span class='hs-comment'>--</span> <a name="line-99"></a><span class='hs-comment'>-- which implies that :R42T was declared as 'data instance T [a]'.</span> <a name="line-100"></a><span class='hs-comment'>--</span> <a name="line-101"></a><span class='hs-definition'>tcLookupFamInst</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'>Type</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span><span class='hs-conid'>TyCon</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <a name="line-102"></a><span class='hs-definition'>tcLookupFamInst</span> <span class='hs-varid'>tycon</span> <span class='hs-varid'>tys</span> <a name="line-103"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isOpenTyCon</span> <span class='hs-varid'>tycon</span><span class='hs-layout'>)</span> <a name="line-104"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span> <a name="line-105"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <a name="line-106"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getGblEnv</span> <a name="line-107"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>eps</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEps</span> <a name="line-108"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>instEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>eps_fam_inst_env</span> <span class='hs-varid'>eps</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcg_fam_inst_env</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <a name="line-109"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupFamInstEnv</span> <span class='hs-varid'>instEnv</span> <span class='hs-varid'>tycon</span> <span class='hs-varid'>tys</span> <span class='hs-keyword'>of</span> <a name="line-110"></a> <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-111"></a> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>fam_inst</span><span class='hs-layout'>,</span> <span class='hs-varid'>rep_tys</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <a name="line-112"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>famInstTyCon</span> <span class='hs-varid'>fam_inst</span><span class='hs-layout'>,</span> <span class='hs-varid'>rep_tys</span><span class='hs-layout'>)</span> <a name="line-113"></a> <span class='hs-layout'>}</span> </pre>\end{code} \begin{code} <pre><a name="line-1"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>MonadThings</span> <span class='hs-layout'>(</span><span class='hs-conid'>IOEnv</span> <span class='hs-layout'>(</span><span class='hs-conid'>Env</span> <span class='hs-conid'>TcGblEnv</span> <span class='hs-conid'>TcLclEnv</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span> <a name="line-2"></a> <span class='hs-varid'>lookupThing</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcLookupGlobal</span> </pre>\end{code} %************************************************************************ %* * Extending the global environment %* * %************************************************************************ \begin{code} <pre><a name="line-1"></a><a name="setGlobalTypeEnv"></a><span class='hs-definition'>setGlobalTypeEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcGblEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TypeEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TcGblEnv</span> <a name="line-2"></a><span class='hs-comment'>-- Use this to update the global type env </span> <a name="line-3"></a><span class='hs-comment'>-- It updates both * the normal tcg_type_env field</span> <a name="line-4"></a><span class='hs-comment'>-- * the tcg_type_env_var field seen by interface files</span> <a name="line-5"></a><span class='hs-definition'>setGlobalTypeEnv</span> <span class='hs-varid'>tcg_env</span> <span class='hs-varid'>new_type_env</span> <a name="line-6"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- Sync the type-envt variable seen by interface files</span> <a name="line-7"></a> <span class='hs-varid'>writeMutVar</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcg_type_env_var</span> <span class='hs-varid'>tcg_env</span><span class='hs-layout'>)</span> <span class='hs-varid'>new_type_env</span> <a name="line-8"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcg_env</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcg_type_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>new_type_env</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span> <a name="line-9"></a> <a name="line-10"></a><a name="tcExtendGlobalEnv"></a><span class='hs-definition'>tcExtendGlobalEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyThing</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>r</span> <a name="line-11"></a> <span class='hs-comment'>-- Given a mixture of Ids, TyCons, Classes, all from the</span> <a name="line-12"></a> <span class='hs-comment'>-- module being compiled, extend the global environment</span> <a name="line-13"></a><span class='hs-definition'>tcExtendGlobalEnv</span> <span class='hs-varid'>things</span> <span class='hs-varid'>thing_inside</span> <a name="line-14"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcg_env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getGblEnv</span> <a name="line-15"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>ge'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendTypeEnvList</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcg_type_env</span> <span class='hs-varid'>tcg_env</span><span class='hs-layout'>)</span> <span class='hs-varid'>things</span> <a name="line-16"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tcg_env'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>setGlobalTypeEnv</span> <span class='hs-varid'>tcg_env</span> <span class='hs-varid'>ge'</span> <a name="line-17"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setGblEnv</span> <span class='hs-varid'>tcg_env'</span> <span class='hs-varid'>thing_inside</span> <span class='hs-layout'>}</span> <a name="line-18"></a> <a name="line-19"></a><a name="tcExtendGlobalValEnv"></a><span class='hs-definition'>tcExtendGlobalValEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</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-20"></a> <span class='hs-comment'>-- Same deal as tcExtendGlobalEnv, but for Ids</span> <a name="line-21"></a><span class='hs-definition'>tcExtendGlobalValEnv</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>thing_inside</span> <a name="line-22"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcExtendGlobalEnv</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>AnId</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ids</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>thing_inside</span> <a name="line-23"></a> <a name="line-24"></a><a name="tcExtendRecEnv"></a><span class='hs-definition'>tcExtendRecEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Name</span><span class='hs-layout'>,</span><span class='hs-conid'>TyThing</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>r</span> <a name="line-25"></a><span class='hs-comment'>-- Extend the global environments for the type/class knot tying game</span> <a name="line-26"></a><span class='hs-comment'>-- Just like tcExtendGlobalEnv, except the argument is a list of pairs</span> <a name="line-27"></a><span class='hs-definition'>tcExtendRecEnv</span> <span class='hs-varid'>gbl_stuff</span> <span class='hs-varid'>thing_inside</span> <a name="line-28"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcg_env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getGblEnv</span> <a name="line-29"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>ge'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendNameEnvList</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcg_type_env</span> <span class='hs-varid'>tcg_env</span><span class='hs-layout'>)</span> <span class='hs-varid'>gbl_stuff</span> <a name="line-30"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tcg_env'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>setGlobalTypeEnv</span> <span class='hs-varid'>tcg_env</span> <span class='hs-varid'>ge'</span> <a name="line-31"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setGblEnv</span> <span class='hs-varid'>tcg_env'</span> <span class='hs-varid'>thing_inside</span> <span class='hs-layout'>}</span> </pre>\end{code} %************************************************************************ %* * \subsection{The local environment} %* * %************************************************************************ \begin{code} <pre><a name="line-1"></a><a name="tcLookupLocated"></a><span class='hs-definition'>tcLookupLocated</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Located</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TcTyThing</span> <a name="line-2"></a><span class='hs-definition'>tcLookupLocated</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addLocM</span> <span class='hs-varid'>tcLookup</span> <a name="line-3"></a> <a name="line-4"></a><a name="tcLookup"></a><span class='hs-definition'>tcLookup</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TcTyThing</span> <a name="line-5"></a><span class='hs-definition'>tcLookup</span> <span class='hs-varid'>name</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-6"></a> <span class='hs-varid'>local_env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getLclEnv</span> <a name="line-7"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupNameEnv</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcl_env</span> <span class='hs-varid'>local_env</span><span class='hs-layout'>)</span> <span class='hs-varid'>name</span> <span class='hs-keyword'>of</span> <a name="line-8"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varid'>thing</span> <a name="line-9"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AGlobal</span> <span class='hs-varop'><$></span> <span class='hs-varid'>tcLookupGlobal</span> <span class='hs-varid'>name</span> <a name="line-10"></a> <a name="line-11"></a><a name="tcLookupTyVar"></a><span class='hs-definition'>tcLookupTyVar</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TcTyVar</span> <a name="line-12"></a><span class='hs-definition'>tcLookupTyVar</span> <span class='hs-varid'>name</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-13"></a> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookup</span> <span class='hs-varid'>name</span> <a name="line-14"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>thing</span> <span class='hs-keyword'>of</span> <a name="line-15"></a> <span class='hs-conid'>ATyVar</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcGetTyVar</span> <span class='hs-str'>"tcLookupTyVar"</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <a name="line-16"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcLookupTyVar"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span> <a name="line-17"></a> <a name="line-18"></a><a name="tcLookupId"></a><span class='hs-definition'>tcLookupId</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>Id</span> <a name="line-19"></a><span class='hs-comment'>-- Used when we aren't interested in the binding level, nor refinement. </span> <a name="line-20"></a><span class='hs-comment'>-- The "no refinement" part means that we return the un-refined Id regardless</span> <a name="line-21"></a><span class='hs-comment'>-- </span> <a name="line-22"></a><span class='hs-comment'>-- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)</span> <a name="line-23"></a><span class='hs-definition'>tcLookupId</span> <span class='hs-varid'>name</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-24"></a> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookup</span> <span class='hs-varid'>name</span> <a name="line-25"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>thing</span> <span class='hs-keyword'>of</span> <a name="line-26"></a> <span class='hs-conid'>ATcId</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tct_id</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>id</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varid'>id</span> <a name="line-27"></a> <span class='hs-conid'>AGlobal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AnId</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varid'>id</span> <a name="line-28"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcLookupId"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span> <a name="line-29"></a> <a name="line-30"></a><a name="tcLookupLocalIds"></a><span class='hs-definition'>tcLookupLocalIds</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TcId</span><span class='hs-keyglyph'>]</span> <a name="line-31"></a><span class='hs-comment'>-- We expect the variables to all be bound, and all at</span> <a name="line-32"></a><span class='hs-comment'>-- the same level as the lookup. Only used in one place...</span> <a name="line-33"></a><span class='hs-definition'>tcLookupLocalIds</span> <span class='hs-varid'>ns</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-34"></a> <span class='hs-varid'>env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getLclEnv</span> <a name="line-35"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>lookup</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcl_env</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>thLevel</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcl_th_ctxt</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>ns</span><span class='hs-layout'>)</span> <a name="line-36"></a> <span class='hs-keyword'>where</span> <a name="line-37"></a> <span class='hs-varid'>lookup</span> <span class='hs-varid'>lenv</span> <span class='hs-varid'>lvl</span> <span class='hs-varid'>name</span> <a name="line-38"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupNameEnv</span> <span class='hs-varid'>lenv</span> <span class='hs-varid'>name</span> <span class='hs-keyword'>of</span> <a name="line-39"></a> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-conid'>ATcId</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tct_id</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>id</span><span class='hs-layout'>,</span> <span class='hs-varid'>tct_level</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lvl1</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <a name="line-40"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span> <span class='hs-varid'>lvl</span> <span class='hs-varop'>==</span> <span class='hs-varid'>lvl1</span> <span class='hs-layout'>)</span> <span class='hs-varid'>id</span> <a name="line-41"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcLookupLocalIds"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span> <a name="line-42"></a> <a name="line-43"></a><a name="lclEnvElts"></a><span class='hs-definition'>lclEnvElts</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcLclEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TcTyThing</span><span class='hs-keyglyph'>]</span> <a name="line-44"></a><span class='hs-definition'>lclEnvElts</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nameEnvElts</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcl_env</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <a name="line-45"></a> <a name="line-46"></a><a name="getInLocalScope"></a><span class='hs-definition'>getInLocalScope</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <a name="line-47"></a> <span class='hs-comment'>-- Ids only</span> <a name="line-48"></a><span class='hs-definition'>getInLocalScope</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-49"></a> <span class='hs-varid'>env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getLclEnv</span> <a name="line-50"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>lcl_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcl_env</span> <span class='hs-varid'>env</span> <a name="line-51"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varop'>`elemNameEnv`</span> <span class='hs-varid'>lcl_env</span><span class='hs-layout'>)</span> </pre>\end{code} \begin{code} <pre><a name="line-1"></a><a name="tcExtendKindEnv"></a><span class='hs-definition'>tcExtendKindEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Name</span><span class='hs-layout'>,</span> <span class='hs-conid'>TcKind</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>r</span> <a name="line-2"></a><span class='hs-definition'>tcExtendKindEnv</span> <span class='hs-varid'>things</span> <span class='hs-varid'>thing_inside</span> <a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>updLclEnv</span> <span class='hs-varid'>upd</span> <span class='hs-varid'>thing_inside</span> <a name="line-4"></a> <span class='hs-keyword'>where</span> <a name="line-5"></a> <span class='hs-varid'>upd</span> <span class='hs-varid'>lcl_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lcl_env</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcl_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extend</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcl_env</span> <span class='hs-varid'>lcl_env</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span> <a name="line-6"></a> <span class='hs-varid'>extend</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendNameEnvList</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-layout'>,</span> <span class='hs-conid'>AThing</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-layout'>,</span><span class='hs-varid'>k</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>things</span><span class='hs-keyglyph'>]</span> <a name="line-7"></a> <a name="line-8"></a><a name="tcExtendKindEnvTvs"></a><span class='hs-definition'>tcExtendKindEnvTvs</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LHsTyVarBndr</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>r</span> <a name="line-9"></a><span class='hs-definition'>tcExtendKindEnvTvs</span> <span class='hs-varid'>bndrs</span> <span class='hs-varid'>thing_inside</span> <a name="line-10"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>updLclEnv</span> <span class='hs-varid'>upd</span> <span class='hs-varid'>thing_inside</span> <a name="line-11"></a> <span class='hs-keyword'>where</span> <a name="line-12"></a> <span class='hs-varid'>upd</span> <span class='hs-varid'>lcl_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lcl_env</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcl_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extend</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcl_env</span> <span class='hs-varid'>lcl_env</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span> <a name="line-13"></a> <span class='hs-varid'>extend</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendNameEnvList</span> <span class='hs-varid'>env</span> <span class='hs-varid'>pairs</span> <a name="line-14"></a> <span class='hs-varid'>pairs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-layout'>,</span> <span class='hs-conid'>AThing</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>KindedTyVar</span> <span class='hs-varid'>n</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>bndrs</span><span class='hs-keyglyph'>]</span> <a name="line-15"></a> <a name="line-16"></a><a name="tcExtendTyVarEnv"></a><span class='hs-definition'>tcExtendTyVarEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyVar</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>r</span> <a name="line-17"></a><span class='hs-definition'>tcExtendTyVarEnv</span> <span class='hs-varid'>tvs</span> <span class='hs-varid'>thing_inside</span> <a name="line-18"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcExtendTyVarEnv2</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>tyVarName</span> <span class='hs-varid'>tv</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkTyVarTy</span> <span class='hs-varid'>tv</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>tv</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tvs</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>thing_inside</span> <a name="line-19"></a> <a name="line-20"></a><a name="tcExtendTyVarEnv2"></a><span class='hs-definition'>tcExtendTyVarEnv2</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Name</span><span class='hs-layout'>,</span><span class='hs-conid'>TcType</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>r</span> <a name="line-21"></a><span class='hs-definition'>tcExtendTyVarEnv2</span> <span class='hs-varid'>binds</span> <span class='hs-varid'>thing_inside</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-22"></a> <span class='hs-varid'>env</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>TcLclEnv</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcl_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>le</span><span class='hs-layout'>,</span> <a name="line-23"></a> <span class='hs-varid'>tcl_tyvars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>gtvs</span><span class='hs-layout'>,</span> <a name="line-24"></a> <span class='hs-varid'>tcl_rdr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rdr_env</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getLclEnv</span> <a name="line-25"></a> <span class='hs-keyword'>let</span> <a name="line-26"></a> <span class='hs-varid'>rdr_env'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendLocalRdrEnvList</span> <span class='hs-varid'>rdr_env</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>fst</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span> <a name="line-27"></a> <span class='hs-varid'>new_tv_set</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcTyVarsOfTypes</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>snd</span> <span class='hs-varid'>binds</span><span class='hs-layout'>)</span> <a name="line-28"></a> <span class='hs-varid'>le'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendNameEnvList</span> <span class='hs-varid'>le</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>name</span><span class='hs-layout'>,</span> <span class='hs-conid'>ATyVar</span> <span class='hs-varid'>name</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'>name</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'>binds</span><span class='hs-keyglyph'>]</span> <a name="line-29"></a> <a name="line-30"></a> <span class='hs-comment'>-- It's important to add the in-scope tyvars to the global tyvar set</span> <a name="line-31"></a> <span class='hs-comment'>-- as well. Consider</span> <a name="line-32"></a> <span class='hs-comment'>-- f (_::r) = let g y = y::r in ...</span> <a name="line-33"></a> <span class='hs-comment'>-- Here, g mustn't be generalised. This is also important during</span> <a name="line-34"></a> <span class='hs-comment'>-- class and instance decls, when we mustn't generalise the class tyvars</span> <a name="line-35"></a> <span class='hs-comment'>-- when typechecking the methods.</span> <a name="line-36"></a> <span class='hs-varid'>gtvs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tc_extend_gtvs</span> <span class='hs-varid'>gtvs</span> <span class='hs-varid'>new_tv_set</span> <a name="line-37"></a> <span class='hs-varid'>setLclEnv</span> <span class='hs-layout'>(</span><span class='hs-varid'>env</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcl_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>le'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcl_tyvars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>gtvs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcl_rdr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rdr_env'</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-varid'>thing_inside</span> <a name="line-38"></a> <a name="line-39"></a><a name="getScopedTyVarBinds"></a><span class='hs-definition'>getScopedTyVarBinds</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcM</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Name</span><span class='hs-layout'>,</span> <span class='hs-conid'>TcType</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <a name="line-40"></a><span class='hs-definition'>getScopedTyVarBinds</span> <a name="line-41"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>lcl_env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getLclEnv</span> <a name="line-42"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>name</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-conid'>ATyVar</span> <span class='hs-varid'>name</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>nameEnvElts</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcl_env</span> <span class='hs-varid'>lcl_env</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-layout'>}</span> </pre>\end{code} \begin{code} <pre><a name="line-1"></a><a name="tcExtendIdEnv"></a><span class='hs-definition'>tcExtendIdEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TcId</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span> <a name="line-2"></a><span class='hs-definition'>tcExtendIdEnv</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>thing_inside</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcExtendIdEnv2</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>idName</span> <span class='hs-varid'>id</span><span class='hs-layout'>,</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ids</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>thing_inside</span> <a name="line-3"></a> <a name="line-4"></a><a name="tcExtendIdEnv1"></a><span class='hs-definition'>tcExtendIdEnv1</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcId</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'>TcM</span> <span class='hs-varid'>a</span> <a name="line-5"></a><span class='hs-definition'>tcExtendIdEnv1</span> <span class='hs-varid'>name</span> <span class='hs-varid'>id</span> <span class='hs-varid'>thing_inside</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcExtendIdEnv2</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>name</span><span class='hs-layout'>,</span><span class='hs-varid'>id</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>thing_inside</span> <a name="line-6"></a> <a name="line-7"></a><a name="tcExtendIdEnv2"></a><span class='hs-definition'>tcExtendIdEnv2</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Name</span><span class='hs-layout'>,</span><span class='hs-conid'>TcId</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span> <a name="line-8"></a><span class='hs-comment'>-- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)</span> <a name="line-9"></a><span class='hs-definition'>tcExtendIdEnv2</span> <span class='hs-varid'>names_w_ids</span> <span class='hs-varid'>thing_inside</span> <a name="line-10"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getLclEnv</span> <a name="line-11"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tc_extend_local_id_env</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-varid'>thLevel</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcl_th_ctxt</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>names_w_ids</span> <span class='hs-varid'>thing_inside</span> <span class='hs-layout'>}</span> <a name="line-12"></a> <a name="line-13"></a><a name="tcExtendGhciEnv"></a><span class='hs-definition'>tcExtendGhciEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TcId</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span> <a name="line-14"></a><span class='hs-comment'>-- Used to bind Ids for GHCi identifiers bound earlier in the user interaction</span> <a name="line-15"></a><span class='hs-comment'>-- Note especially that we bind them at TH level 'impLevel'. That's because it's</span> <a name="line-16"></a><span class='hs-comment'>-- OK to use a variable bound earlier in the interaction in a splice, becuase</span> <a name="line-17"></a><span class='hs-comment'>-- GHCi has already compiled it to bytecode</span> <a name="line-18"></a><span class='hs-definition'>tcExtendGhciEnv</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>thing_inside</span> <a name="line-19"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getLclEnv</span> <a name="line-20"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>tc_extend_local_id_env</span> <span class='hs-varid'>env</span> <span class='hs-varid'>impLevel</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>idName</span> <span class='hs-varid'>id</span><span class='hs-layout'>,</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ids</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>thing_inside</span> <span class='hs-layout'>}</span> <a name="line-21"></a> <a name="line-22"></a><a name="tc_extend_local_id_env"></a><span class='hs-definition'>tc_extend_local_id_env</span> <span class='hs-comment'>-- This is the guy who does the work</span> <a name="line-23"></a> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcLclEnv</span> <a name="line-24"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ThLevel</span> <a name="line-25"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Name</span><span class='hs-layout'>,</span><span class='hs-conid'>TcId</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <a name="line-26"></a> <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'>TcM</span> <span class='hs-varid'>a</span> <a name="line-27"></a><span class='hs-comment'>-- Invariant: the TcIds are fully zonked. Reasons:</span> <a name="line-28"></a><span class='hs-comment'>-- (a) The kinds of the forall'd type variables are defaulted</span> <a name="line-29"></a><span class='hs-comment'>-- (see Kind.defaultKind, done in zonkQuantifiedTyVar)</span> <a name="line-30"></a><span class='hs-comment'>-- (b) There are no via-Indirect occurrences of the bound variables</span> <a name="line-31"></a><span class='hs-comment'>-- in the types, because instantiation does not look through such things</span> <a name="line-32"></a><span class='hs-comment'>-- (c) The call to tyVarsOfTypes is ok without looking through refs</span> <a name="line-33"></a> <a name="line-34"></a><span class='hs-definition'>tc_extend_local_id_env</span> <span class='hs-varid'>env</span> <span class='hs-varid'>th_lvl</span> <span class='hs-varid'>names_w_ids</span> <span class='hs-varid'>thing_inside</span> <a name="line-35"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>traceTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"env2"</span><span class='hs-layout'>)</span> <a name="line-36"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>traceTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"env3"</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>extra_env</span><span class='hs-layout'>)</span> <a name="line-37"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>gtvs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tc_extend_gtvs</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcl_tyvars</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-varid'>extra_global_tyvars</span> <a name="line-38"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>env'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>env</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcl_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>le'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcl_tyvars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>gtvs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcl_rdr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rdr_env'</span><span class='hs-layout'>}</span> <a name="line-39"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setLclEnv</span> <span class='hs-varid'>env'</span> <span class='hs-varid'>thing_inside</span> <span class='hs-layout'>}</span> <a name="line-40"></a> <span class='hs-keyword'>where</span> <a name="line-41"></a> <span class='hs-varid'>extra_global_tyvars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcTyVarsOfTypes</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>idType</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>id</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>names_w_ids</span><span class='hs-keyglyph'>]</span> <a name="line-42"></a> <span class='hs-varid'>extra_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-varid'>name</span><span class='hs-layout'>,</span> <span class='hs-conid'>ATcId</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tct_id</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>id</span><span class='hs-layout'>,</span> <a name="line-43"></a> <span class='hs-varid'>tct_level</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>th_lvl</span><span class='hs-layout'>,</span> <a name="line-44"></a> <span class='hs-varid'>tct_type</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>id_ty</span><span class='hs-layout'>,</span> <a name="line-45"></a> <span class='hs-varid'>tct_co</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>isRefineableTy</span> <span class='hs-varid'>id_ty</span> <span class='hs-keyword'>of</span> <a name="line-46"></a> <span class='hs-layout'>(</span><span class='hs-conid'>True</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Unrefineable</span> <a name="line-47"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-conid'>True</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Rigid</span> <span class='hs-varid'>idHsWrapper</span> <a name="line-48"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Wobbly</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <a name="line-49"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>name</span><span class='hs-layout'>,</span><span class='hs-varid'>id</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>names_w_ids</span><span class='hs-layout'>,</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>id_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>idType</span> <span class='hs-varid'>id</span><span class='hs-keyglyph'>]</span> <a name="line-50"></a> <span class='hs-varid'>le'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendNameEnvList</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcl_env</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-varid'>extra_env</span> <a name="line-51"></a> <span class='hs-varid'>rdr_env'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendLocalRdrEnvList</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcl_rdr</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>name</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>name</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'>names_w_ids</span><span class='hs-keyglyph'>]</span> </pre>\end{code} \begin{code} <pre><a name="line-1"></a><span class='hs-comment'>-----------------------</span> <a name="line-2"></a><span class='hs-comment'>-- findGlobals looks at the value environment and finds values</span> <a name="line-3"></a><span class='hs-comment'>-- whose types mention the offending type variable. It has to be </span> <a name="line-4"></a><span class='hs-comment'>-- careful to zonk the Id's type first, so it has to be in the monad.</span> <a name="line-5"></a><span class='hs-comment'>-- We must be careful to pass it a zonked type variable, too.</span> <a name="line-6"></a> <a name="line-7"></a><a name="findGlobals"></a><span class='hs-definition'>findGlobals</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcTyVarSet</span> <a name="line-8"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TidyEnv</span> <a name="line-9"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>TidyEnv</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>SDoc</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <a name="line-10"></a> <a name="line-11"></a><span class='hs-definition'>findGlobals</span> <span class='hs-varid'>tvs</span> <span class='hs-varid'>tidy_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-12"></a> <span class='hs-varid'>lcl_env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getLclEnv</span> <a name="line-13"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>tidy_env</span> <span class='hs-conid'>[]</span> <span class='hs-layout'>(</span><span class='hs-varid'>lclEnvElts</span> <span class='hs-varid'>lcl_env</span><span class='hs-layout'>)</span> <a name="line-14"></a> <span class='hs-keyword'>where</span> <a name="line-15"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>tidy_env</span> <span class='hs-varid'>acc</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tidy_env</span><span class='hs-layout'>,</span> <span class='hs-varid'>acc</span><span class='hs-layout'>)</span> <a name="line-16"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>tidy_env</span> <span class='hs-varid'>acc</span> <span class='hs-layout'>(</span><span class='hs-varid'>thing</span> <span class='hs-conop'>:</span> <span class='hs-varid'>things</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-17"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tidy_env1</span><span class='hs-layout'>,</span> <span class='hs-varid'>maybe_doc</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>find_thing</span> <span class='hs-varid'>ignore_it</span> <span class='hs-varid'>tidy_env</span> <span class='hs-varid'>thing</span> <a name="line-18"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>maybe_doc</span> <span class='hs-keyword'>of</span> <a name="line-19"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>go</span> <span class='hs-varid'>tidy_env1</span> <span class='hs-layout'>(</span><span class='hs-varid'>d</span><span class='hs-conop'>:</span><span class='hs-varid'>acc</span><span class='hs-layout'>)</span> <span class='hs-varid'>things</span> <a name="line-20"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>go</span> <span class='hs-varid'>tidy_env1</span> <span class='hs-varid'>acc</span> <span class='hs-varid'>things</span> <a name="line-21"></a> <a name="line-22"></a> <span class='hs-varid'>ignore_it</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs</span> <span class='hs-varop'>`disjointVarSet`</span> <span class='hs-varid'>tyVarsOfType</span> <span class='hs-varid'>ty</span> <a name="line-23"></a> <a name="line-24"></a><a name="find_thing"></a><span class='hs-comment'>-----------------------</span> <a name="line-25"></a><span class='hs-definition'>find_thing</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>TcType</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-conid'>TidyEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcTyThing</span> <a name="line-26"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>TidyEnv</span><span class='hs-layout'>,</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>SDoc</span><span class='hs-layout'>)</span> <a name="line-27"></a><span class='hs-definition'>find_thing</span> <span class='hs-varid'>ignore_it</span> <span class='hs-varid'>tidy_env</span> <span class='hs-layout'>(</span><span class='hs-conid'>ATcId</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tct_id</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>id</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-28"></a> <span class='hs-varid'>id_ty</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zonkTcType</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span> <a name="line-29"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>ignore_it</span> <span class='hs-varid'>id_ty</span> <span class='hs-keyword'>then</span> <a name="line-30"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tidy_env</span><span class='hs-layout'>,</span> <span class='hs-conid'>Nothing</span><span class='hs-layout'>)</span> <a name="line-31"></a> <span class='hs-keyword'>else</span> <span class='hs-keyword'>let</span> <a name="line-32"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tidy_env'</span><span class='hs-layout'>,</span> <span class='hs-varid'>tidy_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tidyOpenType</span> <span class='hs-varid'>tidy_env</span> <span class='hs-varid'>id_ty</span> <a name="line-33"></a> <span class='hs-varid'>msg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>id</span> <span class='hs-varop'><+></span> <span class='hs-varid'>dcolon</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tidy_ty</span><span class='hs-layout'>,</span> <a name="line-34"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>parens</span> <span class='hs-layout'>(</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"bound at"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <a name="line-35"></a> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>getSrcLoc</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <a name="line-36"></a> <span class='hs-keyword'>in</span> <a name="line-37"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tidy_env'</span><span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>msg</span><span class='hs-layout'>)</span> <a name="line-38"></a> <a name="line-39"></a><span class='hs-definition'>find_thing</span> <span class='hs-varid'>ignore_it</span> <span class='hs-varid'>tidy_env</span> <span class='hs-layout'>(</span><span class='hs-conid'>ATyVar</span> <span class='hs-varid'>tv</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-40"></a> <span class='hs-varid'>tv_ty</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zonkTcType</span> <span class='hs-varid'>ty</span> <a name="line-41"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>ignore_it</span> <span class='hs-varid'>tv_ty</span> <span class='hs-keyword'>then</span> <a name="line-42"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tidy_env</span><span class='hs-layout'>,</span> <span class='hs-conid'>Nothing</span><span class='hs-layout'>)</span> <a name="line-43"></a> <span class='hs-keyword'>else</span> <span class='hs-keyword'>let</span> <a name="line-44"></a> <span class='hs-comment'>-- The name tv is scoped, so we don't need to tidy it</span> <a name="line-45"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tidy_env1</span><span class='hs-layout'>,</span> <span class='hs-varid'>tidy_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tidyOpenType</span> <span class='hs-varid'>tidy_env</span> <span class='hs-varid'>tv_ty</span> <a name="line-46"></a> <span class='hs-varid'>msg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Scoped type variable"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>tv</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>eq_stuff</span><span class='hs-layout'>,</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-varid'>bound_at</span><span class='hs-keyglyph'>]</span> <a name="line-47"></a> <a name="line-48"></a> <span class='hs-varid'>eq_stuff</span> <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-conid'>Type</span><span class='hs-varop'>.</span><span class='hs-varid'>getTyVar_maybe</span> <span class='hs-varid'>tv_ty</span><span class='hs-layout'>,</span> <a name="line-49"></a> <span class='hs-varid'>getOccName</span> <span class='hs-varid'>tv</span> <span class='hs-varop'>==</span> <span class='hs-varid'>getOccName</span> <span class='hs-varid'>tv'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>empty</span> <a name="line-50"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>equals</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tidy_ty</span> <a name="line-51"></a> <span class='hs-comment'>-- It's ok to use Type.getTyVar_maybe because ty is zonked by now</span> <a name="line-52"></a> <span class='hs-varid'>bound_at</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parens</span> <span class='hs-varop'>$</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"bound at:"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>getSrcLoc</span> <span class='hs-varid'>tv</span><span class='hs-layout'>)</span> <a name="line-53"></a> <span class='hs-keyword'>in</span> <a name="line-54"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>tidy_env1</span><span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>msg</span><span class='hs-layout'>)</span> <a name="line-55"></a> <a name="line-56"></a><span class='hs-definition'>find_thing</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>thing</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"find_thing"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>thing</span><span class='hs-layout'>)</span> </pre>\end{code} %************************************************************************ %* * \subsection{The global tyvars} %* * %************************************************************************ \begin{code} <pre><a name="line-1"></a><a name="tc_extend_gtvs"></a><span class='hs-definition'>tc_extend_gtvs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IORef</span> <span class='hs-conid'>VarSet</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VarSet</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>IORef</span> <span class='hs-conid'>VarSet</span><span class='hs-layout'>)</span> <a name="line-2"></a><span class='hs-definition'>tc_extend_gtvs</span> <span class='hs-varid'>gtvs</span> <span class='hs-varid'>extra_global_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-3"></a> <span class='hs-varid'>global_tvs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>readMutVar</span> <span class='hs-varid'>gtvs</span> <a name="line-4"></a> <span class='hs-varid'>newMutVar</span> <span class='hs-layout'>(</span><span class='hs-varid'>global_tvs</span> <span class='hs-varop'>`unionVarSet`</span> <span class='hs-varid'>extra_global_tvs</span><span class='hs-layout'>)</span> </pre>\end{code} @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment. To improve subsequent calls to the same function it writes the zonked set back into the environment. \begin{code} <pre><a name="line-1"></a><a name="tcGetGlobalTyVars"></a><span class='hs-definition'>tcGetGlobalTyVars</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TcTyVarSet</span> <a name="line-2"></a><span class='hs-definition'>tcGetGlobalTyVars</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-3"></a> <span class='hs-layout'>(</span><span class='hs-conid'>TcLclEnv</span> <span class='hs-layout'>{</span><span class='hs-varid'>tcl_tyvars</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>gtv_var</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getLclEnv</span> <a name="line-4"></a> <span class='hs-varid'>gbl_tvs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>readMutVar</span> <span class='hs-varid'>gtv_var</span> <a name="line-5"></a> <span class='hs-varid'>gbl_tvs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>zonkTcTyVarsAndFV</span> <span class='hs-layout'>(</span><span class='hs-varid'>varSetElems</span> <span class='hs-varid'>gbl_tvs</span><span class='hs-layout'>)</span> <a name="line-6"></a> <span class='hs-varid'>writeMutVar</span> <span class='hs-varid'>gtv_var</span> <span class='hs-varid'>gbl_tvs'</span> <a name="line-7"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>gbl_tvs'</span> </pre>\end{code} %************************************************************************ %* * \subsection{Rules} %* * %************************************************************************ \begin{code} <pre><a name="line-1"></a><a name="tcExtendRules"></a><span class='hs-definition'>tcExtendRules</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LRuleDecl</span> <span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span> <a name="line-2"></a> <span class='hs-comment'>-- Just pop the new rules into the EPS and envt resp</span> <a name="line-3"></a> <span class='hs-comment'>-- All the rules come from an interface file, not soruce</span> <a name="line-4"></a> <span class='hs-comment'>-- Nevertheless, some may be for this module, if we read</span> <a name="line-5"></a> <span class='hs-comment'>-- its interface instead of its source code</span> <a name="line-6"></a><span class='hs-definition'>tcExtendRules</span> <span class='hs-varid'>lcl_rules</span> <span class='hs-varid'>thing_inside</span> <a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getGblEnv</span> <a name="line-8"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <a name="line-9"></a> <span class='hs-varid'>env'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>env</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcg_rules</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lcl_rules</span> <span class='hs-varop'>++</span> <span class='hs-varid'>tcg_rules</span> <span class='hs-varid'>env</span> <span class='hs-layout'>}</span> <a name="line-10"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setGblEnv</span> <span class='hs-varid'>env'</span> <span class='hs-varid'>thing_inside</span> <span class='hs-layout'>}</span> </pre>\end{code} %************************************************************************ %* * Meta level %* * %************************************************************************ \begin{code} <pre><a name="line-1"></a><a name="checkWellStaged"></a><span class='hs-definition'>checkWellStaged</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SDoc</span> <span class='hs-comment'>-- What the stage check is for</span> <a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ThLevel</span> <span class='hs-comment'>-- Binding level (increases inside brackets)</span> <a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ThLevel</span> <span class='hs-comment'>-- Use stage</span> <a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span> <span class='hs-comment'>-- Fail if badly staged, adding an error</span> <a name="line-5"></a><span class='hs-definition'>checkWellStaged</span> <span class='hs-varid'>pp_thing</span> <span class='hs-varid'>bind_lvl</span> <span class='hs-varid'>use_lvl</span> <a name="line-6"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>use_lvl</span> <span class='hs-varop'>>=</span> <span class='hs-varid'>bind_lvl</span> <span class='hs-comment'>-- OK! Used later than bound</span> <a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span> <span class='hs-comment'>-- E.g. \x -> [| $(f x) |]</span> <a name="line-8"></a> <a name="line-9"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>bind_lvl</span> <span class='hs-varop'>==</span> <span class='hs-varid'>outerLevel</span> <span class='hs-comment'>-- GHC restriction on top level splices</span> <a name="line-10"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>failWithTc</span> <span class='hs-varop'>$</span> <a name="line-11"></a> <span class='hs-varid'>sep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"GHC stage restriction:"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>pp_thing</span><span class='hs-layout'>,</span> <a name="line-12"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"is used in a top-level splice or annotation,"</span><span class='hs-layout'>)</span> <a name="line-13"></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'>"and must be imported, not defined locally"</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <a name="line-14"></a> <a name="line-15"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- Badly staged</span> <a name="line-16"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>failWithTc</span> <span class='hs-varop'>$</span> <span class='hs-comment'>-- E.g. \x -> $(f x)</span> <a name="line-17"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"Stage error:"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>pp_thing</span> <span class='hs-varop'><+></span> <a name="line-18"></a> <span class='hs-varid'>hsep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"is bound at stage"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>bind_lvl</span><span class='hs-layout'>,</span> <a name="line-19"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"but used at stage"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>use_lvl</span><span class='hs-keyglyph'>]</span> <a name="line-20"></a> <a name="line-21"></a><a name="topIdLvl"></a><span class='hs-definition'>topIdLvl</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ThLevel</span> <a name="line-22"></a><span class='hs-comment'>-- Globals may either be imported, or may be from an earlier "chunk" </span> <a name="line-23"></a><span class='hs-comment'>-- (separated by declaration splices) of this module. The former</span> <a name="line-24"></a><span class='hs-comment'>-- *can* be used inside a top-level splice, but the latter cannot.</span> <a name="line-25"></a><span class='hs-comment'>-- Hence we give the former impLevel, but the latter topLevel</span> <a name="line-26"></a><span class='hs-comment'>-- E.g. this is bad:</span> <a name="line-27"></a><span class='hs-comment'>-- x = [| foo |]</span> <a name="line-28"></a><span class='hs-comment'>-- $( f x )</span> <a name="line-29"></a><span class='hs-comment'>-- By the time we are prcessing the $(f x), the binding for "x" </span> <a name="line-30"></a><span class='hs-comment'>-- will be in the global env, not the local one.</span> <a name="line-31"></a><span class='hs-definition'>topIdLvl</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isLocalId</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>outerLevel</span> <a name="line-32"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>impLevel</span> <a name="line-33"></a> <a name="line-34"></a><a name="tcMetaTy"></a><span class='hs-definition'>tcMetaTy</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>Type</span> <a name="line-35"></a><span class='hs-comment'>-- Given the name of a Template Haskell data type, </span> <a name="line-36"></a><span class='hs-comment'>-- return the type</span> <a name="line-37"></a><span class='hs-comment'>-- E.g. given the name "Expr" return the type "Expr"</span> <a name="line-38"></a><span class='hs-definition'>tcMetaTy</span> <span class='hs-varid'>tc_name</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-39"></a> <span class='hs-varid'>t</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcLookupTyCon</span> <span class='hs-varid'>tc_name</span> <a name="line-40"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkTyConApp</span> <span class='hs-varid'>t</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <a name="line-41"></a> <a name="line-42"></a><a name="thRnBrack"></a><span class='hs-definition'>thRnBrack</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ThStage</span> <a name="line-43"></a><span class='hs-comment'>-- Used *only* to indicate that we are inside a TH bracket during renaming</span> <a name="line-44"></a><span class='hs-comment'>-- Tested by TcEnv.isBrackStage</span> <a name="line-45"></a><span class='hs-comment'>-- See Note [Top-level Names in Template Haskell decl quotes]</span> <a name="line-46"></a><span class='hs-definition'>thRnBrack</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Brack</span> <span class='hs-layout'>(</span><span class='hs-varid'>panic</span> <span class='hs-str'>"thRnBrack1"</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>panic</span> <span class='hs-str'>"thRnBrack2"</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>panic</span> <span class='hs-str'>"thRnBrack3"</span><span class='hs-layout'>)</span> <a name="line-47"></a> <a name="line-48"></a><a name="isBrackStage"></a><span class='hs-definition'>isBrackStage</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ThStage</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span> <a name="line-49"></a><span class='hs-definition'>isBrackStage</span> <span class='hs-layout'>(</span><span class='hs-conid'>Brack</span> <span class='hs-layout'>{</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-50"></a><span class='hs-definition'>isBrackStage</span> <span class='hs-sel'>_other</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> <a name="line-51"></a> <a name="line-52"></a><a name="thTopLevelId"></a><span class='hs-definition'>thTopLevelId</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span> <a name="line-53"></a><span class='hs-comment'>-- See Note [What is a top-level Id?] in TcSplice</span> <a name="line-54"></a><span class='hs-definition'>thTopLevelId</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isGlobalId</span> <span class='hs-varid'>id</span> <span class='hs-varop'>||</span> <span class='hs-varid'>isExternalName</span> <span class='hs-layout'>(</span><span class='hs-varid'>idName</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span> </pre>\end{code} %************************************************************************ %* * \subsection{The InstInfo type} %* * %************************************************************************ The InstInfo type summarises the information in an instance declaration instance c => k (t tvs) where b It is used just for *local* instance decls (not ones from interface files). But local instance decls includes - derived ones - generic ones as well as explicit user written ones. \begin{code} <pre><a name="line-1"></a><a name="InstInfo"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>InstInfo</span> <span class='hs-varid'>a</span> <a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>InstInfo</span> <span class='hs-layout'>{</span> <a name="line-3"></a> <span class='hs-varid'>iSpec</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Instance</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Includes the dfun id. Its forall'd type </span> <a name="line-4"></a> <span class='hs-varid'>iBinds</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>InstBindings</span> <span class='hs-varid'>a</span> <span class='hs-comment'>-- variables scope over the stuff in InstBindings!</span> <a name="line-5"></a> <span class='hs-layout'>}</span> <a name="line-6"></a> <a name="line-7"></a><a name="iDFunId"></a><span class='hs-definition'>iDFunId</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>InstInfo</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>DFunId</span> <a name="line-8"></a><span class='hs-definition'>iDFunId</span> <span class='hs-varid'>info</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>instanceDFunId</span> <span class='hs-layout'>(</span><span class='hs-varid'>iSpec</span> <span class='hs-varid'>info</span><span class='hs-layout'>)</span> <a name="line-9"></a> <a name="line-10"></a><a name="InstBindings"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>InstBindings</span> <span class='hs-varid'>a</span> <a name="line-11"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>VanillaInst</span> <span class='hs-comment'>-- The normal case</span> <a name="line-12"></a> <span class='hs-layout'>(</span><span class='hs-conid'>LHsBinds</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Bindings for the instance methods</span> <a name="line-13"></a> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LSig</span> <span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- User pragmas recorded for generating </span> <a name="line-14"></a> <span class='hs-comment'>-- specialised instances</span> <a name="line-15"></a> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- True <=> This code came from a standalone deriving clause</span> <a name="line-16"></a> <a name="line-17"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>NewTypeDerived</span> <span class='hs-comment'>-- Used for deriving instances of newtypes, where the</span> <a name="line-18"></a> <span class='hs-comment'>-- witness dictionary is identical to the argument </span> <a name="line-19"></a> <span class='hs-comment'>-- dictionary. Hence no bindings, no pragmas.</span> <a name="line-20"></a> <a name="line-21"></a> <span class='hs-conid'>CoercionI</span> <span class='hs-comment'>-- The coercion maps from newtype to the representation type</span> <a name="line-22"></a> <span class='hs-comment'>-- (mentioning type variables bound by the forall'd iSpec variables)</span> <a name="line-23"></a> <span class='hs-comment'>-- E.g. newtype instance N [a] = N1 (Tree a)</span> <a name="line-24"></a> <span class='hs-comment'>-- co : N [a] ~ Tree a</span> <a name="line-25"></a> <a name="line-26"></a> <span class='hs-conid'>TyCon</span> <span class='hs-comment'>-- The TyCon is the newtype N. If it's indexed, then it's the </span> <a name="line-27"></a> <span class='hs-comment'>-- representation TyCon, so that tyConDataCons returns [N1], </span> <a name="line-28"></a> <span class='hs-comment'>-- the "data constructor".</span> <a name="line-29"></a> <span class='hs-comment'>-- See Note [Newtype deriving and unused constructors]</span> <a name="line-30"></a> <span class='hs-comment'>-- in TcDeriv</span> <a name="line-31"></a> <a name="line-32"></a><a name="pprInstInfo"></a><span class='hs-definition'>pprInstInfo</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>InstInfo</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span> <a name="line-33"></a><span class='hs-definition'>pprInstInfo</span> <span class='hs-varid'>info</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"InstInfo:"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-layout'>(</span><span class='hs-varid'>iDFunId</span> <span class='hs-varid'>info</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <a name="line-34"></a> <a name="line-35"></a><a name="pprInstInfoDetails"></a><span class='hs-definition'>pprInstInfoDetails</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OutputableBndr</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>InstInfo</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span> <a name="line-36"></a><span class='hs-definition'>pprInstInfoDetails</span> <span class='hs-varid'>info</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprInstInfo</span> <span class='hs-varid'>info</span> <span class='hs-varop'>$$</span> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>details</span> <span class='hs-layout'>(</span><span class='hs-varid'>iBinds</span> <span class='hs-varid'>info</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <a name="line-37"></a> <span class='hs-keyword'>where</span> <a name="line-38"></a> <span class='hs-varid'>details</span> <span class='hs-layout'>(</span><span class='hs-conid'>VanillaInst</span> <span class='hs-varid'>b</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprLHsBinds</span> <span class='hs-varid'>b</span> <a name="line-39"></a> <span class='hs-varid'>details</span> <span class='hs-layout'>(</span><span class='hs-conid'>NewTypeDerived</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-str'>"Derived from the representation type"</span> <a name="line-40"></a> <a name="line-41"></a><a name="simpleInstInfoClsTy"></a><span class='hs-definition'>simpleInstInfoClsTy</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>InstInfo</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Class</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span> <a name="line-42"></a><span class='hs-definition'>simpleInstInfoClsTy</span> <span class='hs-varid'>info</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>instanceHead</span> <span class='hs-layout'>(</span><span class='hs-varid'>iSpec</span> <span class='hs-varid'>info</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span> <a name="line-43"></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'>cls</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ty</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>cls</span><span class='hs-layout'>,</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <a name="line-44"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>panic</span> <span class='hs-str'>"simpleInstInfoClsTy"</span> <a name="line-45"></a> <a name="line-46"></a><a name="simpleInstInfoTy"></a><span class='hs-definition'>simpleInstInfoTy</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>InstInfo</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <a name="line-47"></a><span class='hs-definition'>simpleInstInfoTy</span> <span class='hs-varid'>info</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>snd</span> <span class='hs-layout'>(</span><span class='hs-varid'>simpleInstInfoClsTy</span> <span class='hs-varid'>info</span><span class='hs-layout'>)</span> <a name="line-48"></a> <a name="line-49"></a><a name="simpleInstInfoTyCon"></a><span class='hs-definition'>simpleInstInfoTyCon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>InstInfo</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TyCon</span> <a name="line-50"></a> <span class='hs-comment'>-- Gets the type constructor for a simple instance declaration,</span> <a name="line-51"></a> <span class='hs-comment'>-- i.e. one of the form instance (...) => C (T a b c) where ...</span> <a name="line-52"></a><span class='hs-definition'>simpleInstInfoTyCon</span> <span class='hs-varid'>inst</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcTyConAppTyCon</span> <span class='hs-layout'>(</span><span class='hs-varid'>simpleInstInfoTy</span> <span class='hs-varid'>inst</span><span class='hs-layout'>)</span> </pre>\end{code} Make a name for the dict fun for an instance decl. It's an *external* name, like otber top-level names, and hence must be made with newGlobalBinder. \begin{code} <pre><a name="line-1"></a><a name="newDFunName"></a><span class='hs-definition'>newDFunName</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Class</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'>SrcSpan</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>Name</span> <a name="line-2"></a><span class='hs-definition'>newDFunName</span> <span class='hs-varid'>clas</span> <span class='hs-varid'>tys</span> <span class='hs-varid'>loc</span> <a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>is_boot</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcIsHsBoot</span> <a name="line-4"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>mod</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getModule</span> <a name="line-5"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>info_string</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occNameString</span> <span class='hs-layout'>(</span><span class='hs-varid'>getOccName</span> <span class='hs-varid'>clas</span><span class='hs-layout'>)</span> <span class='hs-varop'>++</span> <a name="line-6"></a> <span class='hs-varid'>concatMap</span> <span class='hs-layout'>(</span><span class='hs-varid'>occNameString</span><span class='hs-varop'>.</span><span class='hs-varid'>getDFunTyKey</span><span class='hs-layout'>)</span> <span class='hs-varid'>tys</span> <a name="line-7"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>dfun_occ</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>chooseUniqueOccTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkDFunOcc</span> <span class='hs-varid'>info_string</span> <span class='hs-varid'>is_boot</span><span class='hs-layout'>)</span> <a name="line-8"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>newGlobalBinder</span> <span class='hs-varid'>mod</span> <span class='hs-varid'>dfun_occ</span> <span class='hs-varid'>loc</span> <span class='hs-layout'>}</span> </pre>\end{code} Make a name for the representation tycon of a family instance. It's an *external* name, like otber top-level names, and hence must be made with newGlobalBinder. \begin{code} <pre><a name="line-1"></a><a name="newFamInstTyConName"></a><span class='hs-definition'>newFamInstTyConName</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</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'>SrcSpan</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>Name</span> <a name="line-2"></a><span class='hs-definition'>newFamInstTyConName</span> <span class='hs-varid'>tc_name</span> <span class='hs-varid'>tys</span> <span class='hs-varid'>loc</span> <a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>mod</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getModule</span> <a name="line-4"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>info_string</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>occNameString</span> <span class='hs-layout'>(</span><span class='hs-varid'>getOccName</span> <span class='hs-varid'>tc_name</span><span class='hs-layout'>)</span> <span class='hs-varop'>++</span> <a name="line-5"></a> <span class='hs-varid'>concatMap</span> <span class='hs-layout'>(</span><span class='hs-varid'>occNameString</span><span class='hs-varop'>.</span><span class='hs-varid'>getDFunTyKey</span><span class='hs-layout'>)</span> <span class='hs-varid'>tys</span> <a name="line-6"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>occ</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>chooseUniqueOccTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkInstTyTcOcc</span> <span class='hs-varid'>info_string</span><span class='hs-layout'>)</span> <a name="line-7"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>newGlobalBinder</span> <span class='hs-varid'>mod</span> <span class='hs-varid'>occ</span> <span class='hs-varid'>loc</span> <span class='hs-layout'>}</span> </pre>\end{code} Stable names used for foreign exports and annotations. For stable names, the name must be unique (see #1533). If the same thing has several stable Ids based on it, the top-level bindings generated must not have the same name. Hence we create an External name (doesn't change), and we append a Unique to the string right here. \begin{code} <pre><a name="line-1"></a><a name="mkStableIdFromString"></a><span class='hs-definition'>mkStableIdFromString</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SrcSpan</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>OccName</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>OccName</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TcId</span> <a name="line-2"></a><span class='hs-definition'>mkStableIdFromString</span> <span class='hs-varid'>str</span> <span class='hs-varid'>sig_ty</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>occ_wrapper</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <a name="line-3"></a> <span class='hs-varid'>uniq</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newUnique</span> <a name="line-4"></a> <span class='hs-varid'>mod</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getModule</span> <a name="line-5"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>uniq_str</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showSDoc</span> <span class='hs-layout'>(</span><span class='hs-varid'>pprUnique</span> <span class='hs-varid'>uniq</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <a name="line-6"></a> <span class='hs-varid'>occ</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVarOcc</span> <span class='hs-layout'>(</span><span class='hs-varid'>str</span> <span class='hs-varop'>++</span> <span class='hs-chr'>'_'</span> <span class='hs-conop'>:</span> <span class='hs-varid'>uniq_str</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OccName</span> <a name="line-7"></a> <span class='hs-varid'>gnm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkExternalName</span> <span class='hs-varid'>uniq</span> <span class='hs-varid'>mod</span> <span class='hs-layout'>(</span><span class='hs-varid'>occ_wrapper</span> <span class='hs-varid'>occ</span><span class='hs-layout'>)</span> <span class='hs-varid'>loc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <a name="line-8"></a> <span class='hs-varid'>id</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkExportedLocalId</span> <span class='hs-varid'>gnm</span> <span class='hs-varid'>sig_ty</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span> <a name="line-9"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>id</span> <a name="line-10"></a> <a name="line-11"></a><a name="mkStableIdFromName"></a><span class='hs-definition'>mkStableIdFromName</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SrcSpan</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>OccName</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>OccName</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TcId</span> <a name="line-12"></a><span class='hs-definition'>mkStableIdFromName</span> <span class='hs-varid'>nm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkStableIdFromString</span> <span class='hs-layout'>(</span><span class='hs-varid'>getOccString</span> <span class='hs-varid'>nm</span><span class='hs-layout'>)</span> </pre>\end{code} %************************************************************************ %* * \subsection{Errors} %* * %************************************************************************ \begin{code} <pre><a name="line-1"></a><a name="pprBinders"></a><span class='hs-definition'>pprBinders</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span> <a name="line-2"></a><span class='hs-comment'>-- Used in error messages</span> <a name="line-3"></a><span class='hs-comment'>-- Use quotes for a single one; they look a bit "busy" for several</span> <a name="line-4"></a><span class='hs-definition'>pprBinders</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>bndr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>)</span> <a name="line-5"></a><span class='hs-definition'>pprBinders</span> <span class='hs-varid'>bndrs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprWithCommas</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>bndrs</span> <a name="line-6"></a> <a name="line-7"></a><a name="notFound"></a><span class='hs-definition'>notFound</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcGblEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>TyThing</span> <a name="line-8"></a><span class='hs-definition'>notFound</span> <span class='hs-varid'>name</span> <span class='hs-varid'>env</span> <a name="line-9"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>failWithTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>vcat</span><span class='hs-keyglyph'>[</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"GHC internal error:"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <a name="line-10"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"is not in scope during type checking, but it passed the renamer"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <a name="line-11"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"tcg_type_env of environment:"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcg_type_env</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <a name="line-12"></a> <span class='hs-layout'>)</span> <a name="line-13"></a> <a name="line-14"></a><a name="wrongThingErr"></a><span class='hs-definition'>wrongThingErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcTyThing</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span> <a name="line-15"></a><span class='hs-definition'>wrongThingErr</span> <span class='hs-varid'>expected</span> <span class='hs-varid'>thing</span> <span class='hs-varid'>name</span> <a name="line-16"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>failWithTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>pprTcTyThingCategory</span> <span class='hs-varid'>thing</span> <span class='hs-varop'><+></span> <span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <a name="line-17"></a> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"used as a"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>text</span> <span class='hs-varid'>expected</span><span class='hs-layout'>)</span> </pre>\end{code} </body> </html>