<?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>simplCore/CoreMonad.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The AQUA Project, Glasgow University, 1993-1998
%
\section[CoreMonad]{The core pipeline monad}
\begin{code}
<pre><a name="line-1"></a><span class='hs-comment'>{-# LANGUAGE UndecidableInstances #-}</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>CoreMonad</span> <span class='hs-layout'>(</span>
<a name="line-4"></a> <span class='hs-comment'>-- * The monad</span>
<a name="line-5"></a> <span class='hs-conid'>CoreM</span><span class='hs-layout'>,</span> <span class='hs-varid'>runCoreM</span><span class='hs-layout'>,</span>
<a name="line-6"></a>
<a name="line-7"></a> <span class='hs-comment'>-- ** Reading from the monad</span>
<a name="line-8"></a> <span class='hs-varid'>getHscEnv</span><span class='hs-layout'>,</span> <span class='hs-varid'>getAnnEnv</span><span class='hs-layout'>,</span> <span class='hs-varid'>getRuleBase</span><span class='hs-layout'>,</span> <span class='hs-varid'>getModule</span><span class='hs-layout'>,</span>
<a name="line-9"></a> <span class='hs-varid'>getDynFlags</span><span class='hs-layout'>,</span> <span class='hs-varid'>getOrigNameCache</span><span class='hs-layout'>,</span>
<a name="line-10"></a>
<a name="line-11"></a> <span class='hs-comment'>-- ** Writing to the monad</span>
<a name="line-12"></a> <span class='hs-varid'>addSimplCount</span><span class='hs-layout'>,</span>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-comment'>-- ** Lifting into the monad</span>
<a name="line-15"></a> <span class='hs-varid'>liftIO</span><span class='hs-layout'>,</span> <span class='hs-varid'>liftIOWithCount</span><span class='hs-layout'>,</span>
<a name="line-16"></a> <span class='hs-varid'>liftIO1</span><span class='hs-layout'>,</span> <span class='hs-varid'>liftIO2</span><span class='hs-layout'>,</span> <span class='hs-varid'>liftIO3</span><span class='hs-layout'>,</span> <span class='hs-varid'>liftIO4</span><span class='hs-layout'>,</span>
<a name="line-17"></a>
<a name="line-18"></a> <span class='hs-comment'>-- ** Dealing with annotations</span>
<a name="line-19"></a> <span class='hs-varid'>findAnnotations</span><span class='hs-layout'>,</span> <span class='hs-varid'>addAnnotation</span><span class='hs-layout'>,</span>
<a name="line-20"></a>
<a name="line-21"></a> <span class='hs-comment'>-- ** Screen output</span>
<a name="line-22"></a> <span class='hs-varid'>putMsg</span><span class='hs-layout'>,</span> <span class='hs-varid'>putMsgS</span><span class='hs-layout'>,</span> <span class='hs-varid'>errorMsg</span><span class='hs-layout'>,</span> <span class='hs-varid'>errorMsgS</span><span class='hs-layout'>,</span>
<a name="line-23"></a> <span class='hs-varid'>fatalErrorMsg</span><span class='hs-layout'>,</span> <span class='hs-varid'>fatalErrorMsgS</span><span class='hs-layout'>,</span>
<a name="line-24"></a> <span class='hs-varid'>debugTraceMsg</span><span class='hs-layout'>,</span> <span class='hs-varid'>debugTraceMsgS</span><span class='hs-layout'>,</span>
<a name="line-25"></a> <span class='hs-varid'>dumpIfSet_dyn</span><span class='hs-layout'>,</span>
<a name="line-26"></a>
<a name="line-27"></a><span class='hs-cpp'>#ifdef GHCI</span>
<a name="line-28"></a> <span class='hs-comment'>-- * Getting 'Name's</span>
<a name="line-29"></a> <span class='hs-varid'>thNameToGhcName</span>
<a name="line-30"></a><span class='hs-cpp'>#endif</span>
<a name="line-31"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-32"></a>
<a name="line-33"></a><span class='hs-cpp'>#ifdef GHCI</span>
<a name="line-34"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span><span class='hs-layout'>(</span> <span class='hs-conid'>Name</span> <span class='hs-layout'>)</span>
<a name="line-35"></a><span class='hs-cpp'>#endif</span>
<a name="line-36"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>PrelNames</span> <span class='hs-layout'>(</span> <span class='hs-varid'>iNTERACTIVE</span> <span class='hs-layout'>)</span>
<a name="line-37"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HscTypes</span>
<a name="line-38"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Module</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Module</span> <span class='hs-layout'>)</span>
<a name="line-39"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DynFlags</span> <span class='hs-layout'>(</span> <span class='hs-conid'>DynFlags</span><span class='hs-layout'>,</span> <span class='hs-conid'>DynFlag</span> <span class='hs-layout'>)</span>
<a name="line-40"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>SimplMonad</span> <span class='hs-layout'>(</span> <span class='hs-conid'>SimplCount</span><span class='hs-layout'>,</span> <span class='hs-varid'>plusSimplCount</span><span class='hs-layout'>,</span> <span class='hs-varid'>zeroSimplCount</span> <span class='hs-layout'>)</span>
<a name="line-41"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Rules</span> <span class='hs-layout'>(</span> <span class='hs-conid'>RuleBase</span> <span class='hs-layout'>)</span>
<a name="line-42"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Annotations</span>
<a name="line-43"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Serialized</span>
<a name="line-44"></a>
<a name="line-45"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>IOEnv</span> <span class='hs-varid'>hiding</span> <span class='hs-layout'>(</span> <span class='hs-varid'>liftIO</span><span class='hs-layout'>,</span> <span class='hs-varid'>failM</span><span class='hs-layout'>,</span> <span class='hs-varid'>failWithM</span> <span class='hs-layout'>)</span>
<a name="line-46"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>IOEnv</span> <span class='hs-layout'>(</span> <span class='hs-varid'>liftIO</span> <span class='hs-layout'>)</span>
<a name="line-47"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcEnv</span> <span class='hs-layout'>(</span> <span class='hs-varid'>tcLookupGlobal</span> <span class='hs-layout'>)</span>
<a name="line-48"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcRnMonad</span> <span class='hs-layout'>(</span> <span class='hs-conid'>TcM</span><span class='hs-layout'>,</span> <span class='hs-varid'>initTc</span> <span class='hs-layout'>)</span>
<a name="line-49"></a>
<a name="line-50"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-51"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>ErrUtils</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>Err</span>
<a name="line-52"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Maybes</span>
<a name="line-53"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>UniqSupply</span>
<a name="line-54"></a>
<a name="line-55"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Dynamic</span>
<a name="line-56"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>IORef</span>
<a name="line-57"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Word</span>
<a name="line-58"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>
<a name="line-59"></a>
<a name="line-60"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Prelude</span> <span class='hs-varid'>hiding</span> <span class='hs-layout'>(</span> <span class='hs-varid'>read</span> <span class='hs-layout'>)</span>
<a name="line-61"></a>
<a name="line-62"></a><span class='hs-cpp'>#ifdef GHCI</span>
<a name="line-63"></a><span class='hs-keyword'>import</span> <span class='hs-comment'>{-# SOURCE #-}</span> <span class='hs-conid'>TcSplice</span> <span class='hs-layout'>(</span> <span class='hs-varid'>lookupThName_maybe</span> <span class='hs-layout'>)</span>
<a name="line-64"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Language</span><span class='hs-varop'>.</span><span class='hs-conid'>Haskell</span><span class='hs-varop'>.</span><span class='hs-conid'>TH</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>TH</span>
<a name="line-65"></a><span class='hs-cpp'>#endif</span>
</pre>\end{code}
\subsection{Monad and carried data structure definitions}
\begin{code}
<pre><a name="line-1"></a><a name="CoreState"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>CoreState</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreState</span> <span class='hs-layout'>{</span>
<a name="line-2"></a> <span class='hs-varid'>cs_uniq_supply</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>UniqSupply</span><span class='hs-layout'>,</span>
<a name="line-3"></a> <span class='hs-varid'>cs_ann_env</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>AnnEnv</span>
<a name="line-4"></a><span class='hs-layout'>}</span>
<a name="line-5"></a>
<a name="line-6"></a><a name="CoreReader"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>CoreReader</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreReader</span> <span class='hs-layout'>{</span>
<a name="line-7"></a> <span class='hs-varid'>cr_hsc_env</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HscEnv</span><span class='hs-layout'>,</span>
<a name="line-8"></a> <span class='hs-varid'>cr_rule_base</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RuleBase</span><span class='hs-layout'>,</span>
<a name="line-9"></a> <span class='hs-varid'>cr_module</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Module</span>
<a name="line-10"></a><span class='hs-layout'>}</span>
<a name="line-11"></a>
<a name="line-12"></a><a name="CoreWriter"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>CoreWriter</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreWriter</span> <span class='hs-layout'>{</span>
<a name="line-13"></a> <span class='hs-varid'>cw_simpl_count</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplCount</span>
<a name="line-14"></a><span class='hs-layout'>}</span>
<a name="line-15"></a>
<a name="line-16"></a><a name="emptyWriter"></a><span class='hs-definition'>emptyWriter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DynFlags</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreWriter</span>
<a name="line-17"></a><span class='hs-definition'>emptyWriter</span> <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreWriter</span> <span class='hs-layout'>{</span>
<a name="line-18"></a> <span class='hs-varid'>cw_simpl_count</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>zeroSimplCount</span> <span class='hs-varid'>dflags</span>
<a name="line-19"></a> <span class='hs-layout'>}</span>
<a name="line-20"></a>
<a name="line-21"></a><a name="plusWriter"></a><span class='hs-definition'>plusWriter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreWriter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreWriter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreWriter</span>
<a name="line-22"></a><span class='hs-definition'>plusWriter</span> <span class='hs-varid'>w1</span> <span class='hs-varid'>w2</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreWriter</span> <span class='hs-layout'>{</span>
<a name="line-23"></a> <span class='hs-varid'>cw_simpl_count</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>cw_simpl_count</span> <span class='hs-varid'>w1</span><span class='hs-layout'>)</span> <span class='hs-varop'>`plusSimplCount`</span> <span class='hs-layout'>(</span><span class='hs-varid'>cw_simpl_count</span> <span class='hs-varid'>w2</span><span class='hs-layout'>)</span>
<a name="line-24"></a> <span class='hs-layout'>}</span>
<a name="line-25"></a>
<a name="line-26"></a><a name="CoreIOEnv"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>CoreIOEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>IOEnv</span> <span class='hs-conid'>CoreReader</span>
<a name="line-27"></a>
<a name="line-28"></a><a name="CoreM"></a><span class='hs-comment'>-- | The monad used by Core-to-Core passes to access common state, register simplification</span>
<a name="line-29"></a><a name="CoreM"></a><span class='hs-comment'>-- statistics and so on</span>
<a name="line-30"></a><a name="CoreM"></a><span class='hs-keyword'>newtype</span> <span class='hs-conid'>CoreM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreM</span> <span class='hs-layout'>{</span> <span class='hs-varid'>unCoreM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreState</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreIOEnv</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreState</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreWriter</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-31"></a>
<a name="line-32"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Functor</span> <span class='hs-conid'>CoreM</span> <span class='hs-keyword'>where</span>
<a name="line-33"></a> <span class='hs-varid'>fmap</span> <span class='hs-varid'>f</span> <span class='hs-varid'>ma</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-34"></a> <span class='hs-varid'>a</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ma</span>
<a name="line-35"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-36"></a>
<a name="line-37"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Monad</span> <span class='hs-conid'>CoreM</span> <span class='hs-keyword'>where</span>
<a name="line-38"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>nop</span> <span class='hs-varid'>s</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-39"></a> <span class='hs-varid'>mx</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreM</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-40"></a> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span> <span class='hs-varid'>s'</span><span class='hs-layout'>,</span> <span class='hs-varid'>w1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>unCoreM</span> <span class='hs-varid'>mx</span> <span class='hs-varid'>s</span>
<a name="line-41"></a> <span class='hs-layout'>(</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span> <span class='hs-varid'>s''</span><span class='hs-layout'>,</span> <span class='hs-varid'>w2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>unCoreM</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-varid'>s'</span>
<a name="line-42"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span> <span class='hs-varid'>s''</span><span class='hs-layout'>,</span> <span class='hs-varid'>w1</span> <span class='hs-varop'>`plusWriter`</span> <span class='hs-varid'>w2</span><span class='hs-layout'>)</span>
<a name="line-43"></a>
<a name="line-44"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Applicative</span> <span class='hs-conid'>CoreM</span> <span class='hs-keyword'>where</span>
<a name="line-45"></a> <span class='hs-varid'>pure</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span>
<a name="line-46"></a> <span class='hs-layout'>(</span><span class='hs-varop'><*></span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ap</span>
<a name="line-47"></a>
<a name="line-48"></a><span class='hs-comment'>-- For use if the user has imported Control.Monad.Error from MTL</span>
<a name="line-49"></a><span class='hs-comment'>-- Requires UndecidableInstances</span>
<a name="line-50"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>MonadPlus</span> <span class='hs-conid'>IO</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>MonadPlus</span> <span class='hs-conid'>CoreM</span> <span class='hs-keyword'>where</span>
<a name="line-51"></a> <span class='hs-varid'>mzero</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreM</span> <span class='hs-layout'>(</span><span class='hs-varid'>const</span> <span class='hs-varid'>mzero</span><span class='hs-layout'>)</span>
<a name="line-52"></a> <span class='hs-varid'>m</span> <span class='hs-varop'>`mplus`</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>rs</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unCoreM</span> <span class='hs-varid'>m</span> <span class='hs-varid'>rs</span> <span class='hs-varop'>`mplus`</span> <span class='hs-varid'>unCoreM</span> <span class='hs-varid'>n</span> <span class='hs-varid'>rs</span><span class='hs-layout'>)</span>
<a name="line-53"></a>
<a name="line-54"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>MonadUnique</span> <span class='hs-conid'>CoreM</span> <span class='hs-keyword'>where</span>
<a name="line-55"></a> <span class='hs-varid'>getUniqueSupplyM</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-56"></a> <span class='hs-varid'>us</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getS</span> <span class='hs-varid'>cs_uniq_supply</span>
<a name="line-57"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>us1</span><span class='hs-layout'>,</span> <span class='hs-varid'>us2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitUniqSupply</span> <span class='hs-varid'>us</span>
<a name="line-58"></a> <span class='hs-varid'>modifyS</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span> <span class='hs-layout'>{</span> <span class='hs-varid'>cs_uniq_supply</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>us2</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-59"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>us1</span>
<a name="line-60"></a>
<a name="line-61"></a><a name="runCoreM"></a><span class='hs-definition'>runCoreM</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HscEnv</span>
<a name="line-62"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AnnEnv</span>
<a name="line-63"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>RuleBase</span>
<a name="line-64"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>UniqSupply</span>
<a name="line-65"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Module</span>
<a name="line-66"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-varid'>a</span>
<a name="line-67"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>SimplCount</span><span class='hs-layout'>)</span>
<a name="line-68"></a><span class='hs-definition'>runCoreM</span> <span class='hs-varid'>hsc_env</span> <span class='hs-varid'>ann_env</span> <span class='hs-varid'>rule_base</span> <span class='hs-varid'>us</span> <span class='hs-varid'>mod</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span>
<a name="line-69"></a> <span class='hs-varid'>liftM</span> <span class='hs-varid'>extract</span> <span class='hs-varop'>$</span> <span class='hs-varid'>runIOEnv</span> <span class='hs-varid'>reader</span> <span class='hs-varop'>$</span> <span class='hs-varid'>unCoreM</span> <span class='hs-varid'>m</span> <span class='hs-varid'>state</span>
<a name="line-70"></a> <span class='hs-keyword'>where</span>
<a name="line-71"></a> <span class='hs-varid'>reader</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreReader</span> <span class='hs-layout'>{</span>
<a name="line-72"></a> <span class='hs-varid'>cr_hsc_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hsc_env</span><span class='hs-layout'>,</span>
<a name="line-73"></a> <span class='hs-varid'>cr_rule_base</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rule_base</span><span class='hs-layout'>,</span>
<a name="line-74"></a> <span class='hs-varid'>cr_module</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mod</span>
<a name="line-75"></a> <span class='hs-layout'>}</span>
<a name="line-76"></a> <span class='hs-varid'>state</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreState</span> <span class='hs-layout'>{</span>
<a name="line-77"></a> <span class='hs-varid'>cs_uniq_supply</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>us</span><span class='hs-layout'>,</span>
<a name="line-78"></a> <span class='hs-varid'>cs_ann_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ann_env</span>
<a name="line-79"></a> <span class='hs-layout'>}</span>
<a name="line-80"></a>
<a name="line-81"></a> <span class='hs-varid'>extract</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreState</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreWriter</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>SimplCount</span><span class='hs-layout'>)</span>
<a name="line-82"></a> <span class='hs-varid'>extract</span> <span class='hs-layout'>(</span><span class='hs-varid'>value</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>writer</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>value</span><span class='hs-layout'>,</span> <span class='hs-varid'>cw_simpl_count</span> <span class='hs-varid'>writer</span><span class='hs-layout'>)</span>
<a name="line-83"></a>
</pre>\end{code}
\subsection{Core combinators, not exported}
\begin{code}
<pre><a name="line-1"></a>
<a name="line-2"></a><a name="nop"></a><span class='hs-definition'>nop</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreState</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreIOEnv</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreState</span><span class='hs-layout'>,</span> <span class='hs-conid'>CoreWriter</span><span class='hs-layout'>)</span>
<a name="line-3"></a><span class='hs-definition'>nop</span> <span class='hs-varid'>s</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-4"></a> <span class='hs-varid'>r</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnv</span>
<a name="line-5"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>,</span> <span class='hs-varid'>emptyWriter</span> <span class='hs-varop'>$</span> <span class='hs-layout'>(</span><span class='hs-varid'>hsc_dflags</span> <span class='hs-varop'>.</span> <span class='hs-varid'>cr_hsc_env</span><span class='hs-layout'>)</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span>
<a name="line-6"></a>
<a name="line-7"></a><a name="read"></a><span class='hs-definition'>read</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreReader</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-varid'>a</span>
<a name="line-8"></a><span class='hs-definition'>read</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>getEnv</span> <span class='hs-varop'>>>=</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>r</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>nop</span> <span class='hs-varid'>s</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>r</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="getS"></a><span class='hs-definition'>getS</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreState</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-varid'>a</span>
<a name="line-11"></a><span class='hs-definition'>getS</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>nop</span> <span class='hs-varid'>s</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-12"></a>
<a name="line-13"></a><a name="modifyS"></a><span class='hs-definition'>modifyS</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreState</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreState</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-14"></a><span class='hs-definition'>modifyS</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>nop</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span>
<a name="line-15"></a>
<a name="line-16"></a><a name="write"></a><span class='hs-definition'>write</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreWriter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-17"></a><span class='hs-definition'>write</span> <span class='hs-varid'>w</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>()</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>,</span> <span class='hs-varid'>w</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-18"></a>
</pre>\end{code}
\subsection{Lifting IO into the monad}
\begin{code}
<pre><a name="line-1"></a>
<a name="line-2"></a><a name="liftIOEnv"></a><span class='hs-comment'>-- | Lift an 'IOEnv' operation into 'CoreM'</span>
<a name="line-3"></a><span class='hs-definition'>liftIOEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreIOEnv</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-varid'>a</span>
<a name="line-4"></a><span class='hs-definition'>liftIOEnv</span> <span class='hs-varid'>mx</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>CoreM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mx</span> <span class='hs-varop'>>>=</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>nop</span> <span class='hs-varid'>s</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>MonadIO</span> <span class='hs-conid'>CoreM</span> <span class='hs-keyword'>where</span>
<a name="line-7"></a> <span class='hs-varid'>liftIO</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftIOEnv</span> <span class='hs-varop'>.</span> <span class='hs-conid'>IOEnv</span><span class='hs-varop'>.</span><span class='hs-varid'>liftIO</span>
<a name="line-8"></a>
<a name="line-9"></a><a name="liftIOWithCount"></a><span class='hs-comment'>-- | Lift an 'IO' operation into 'CoreM' while consuming its 'SimplCount'</span>
<a name="line-10"></a><span class='hs-definition'>liftIOWithCount</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>SimplCount</span><span class='hs-layout'>,</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-varid'>a</span>
<a name="line-11"></a><span class='hs-definition'>liftIOWithCount</span> <span class='hs-varid'>what</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftIO</span> <span class='hs-varid'>what</span> <span class='hs-varop'>>>=</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>count</span><span class='hs-layout'>,</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>addSimplCount</span> <span class='hs-varid'>count</span> <span class='hs-varop'>>></span> <span class='hs-varid'>return</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-12"></a>
</pre>\end{code}
\subsection{Reader, writer and state accessors}
\begin{code}
<pre><a name="line-1"></a>
<a name="line-2"></a><a name="getHscEnv"></a><span class='hs-definition'>getHscEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>HscEnv</span>
<a name="line-3"></a><span class='hs-definition'>getHscEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>read</span> <span class='hs-varid'>cr_hsc_env</span>
<a name="line-4"></a>
<a name="line-5"></a><a name="getAnnEnv"></a><span class='hs-definition'>getAnnEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>AnnEnv</span>
<a name="line-6"></a><span class='hs-definition'>getAnnEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>getS</span> <span class='hs-varid'>cs_ann_env</span>
<a name="line-7"></a>
<a name="line-8"></a><a name="getRuleBase"></a><span class='hs-definition'>getRuleBase</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>RuleBase</span>
<a name="line-9"></a><span class='hs-definition'>getRuleBase</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>read</span> <span class='hs-varid'>cr_rule_base</span>
<a name="line-10"></a>
<a name="line-11"></a><a name="getModule"></a><span class='hs-definition'>getModule</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>Module</span>
<a name="line-12"></a><span class='hs-definition'>getModule</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>read</span> <span class='hs-varid'>cr_module</span>
<a name="line-13"></a>
<a name="line-14"></a><a name="addSimplCount"></a><span class='hs-definition'>addSimplCount</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SimplCount</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-15"></a><span class='hs-definition'>addSimplCount</span> <span class='hs-varid'>count</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>write</span> <span class='hs-layout'>(</span><span class='hs-conid'>CoreWriter</span> <span class='hs-layout'>{</span> <span class='hs-varid'>cw_simpl_count</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>count</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-16"></a>
<a name="line-17"></a><span class='hs-comment'>-- Convenience accessors for useful fields of HscEnv</span>
<a name="line-18"></a>
<a name="line-19"></a><a name="getDynFlags"></a><span class='hs-definition'>getDynFlags</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>DynFlags</span>
<a name="line-20"></a><span class='hs-definition'>getDynFlags</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fmap</span> <span class='hs-varid'>hsc_dflags</span> <span class='hs-varid'>getHscEnv</span>
<a name="line-21"></a>
<a name="line-22"></a><a name="getOrigNameCache"></a><span class='hs-comment'>-- | The original name cache is the current mapping from 'Module' and</span>
<a name="line-23"></a><span class='hs-comment'>-- 'OccName' to a compiler-wide unique 'Name'</span>
<a name="line-24"></a><span class='hs-definition'>getOrigNameCache</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>OrigNameCache</span>
<a name="line-25"></a><span class='hs-definition'>getOrigNameCache</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-26"></a> <span class='hs-varid'>nameCacheRef</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>fmap</span> <span class='hs-varid'>hsc_NC</span> <span class='hs-varid'>getHscEnv</span>
<a name="line-27"></a> <span class='hs-varid'>liftIO</span> <span class='hs-varop'>$</span> <span class='hs-varid'>fmap</span> <span class='hs-varid'>nsNames</span> <span class='hs-varop'>$</span> <span class='hs-varid'>readIORef</span> <span class='hs-varid'>nameCacheRef</span>
<a name="line-28"></a>
</pre>\end{code}
\subsection{Dealing with annotations}
\begin{code}
<pre><a name="line-1"></a>
<a name="line-2"></a><a name="findAnnotations"></a><span class='hs-comment'>-- | Find all the annotations we currently know about for the given target. Note that no</span>
<a name="line-3"></a><span class='hs-comment'>-- annotations will be returned if we haven't loaded information about the particular target</span>
<a name="line-4"></a><span class='hs-comment'>-- you are inquiring about: by default, only those modules that have been imported by the</span>
<a name="line-5"></a><span class='hs-comment'>-- program being compiled will have been loaded in this way.</span>
<a name="line-6"></a><span class='hs-comment'>--</span>
<a name="line-7"></a><span class='hs-comment'>-- To load the information from additional modules, you can use the functions 'DynamicLoading.forceLoadModuleInterfaces'</span>
<a name="line-8"></a><span class='hs-comment'>-- and 'DynamicLoading.forceLoadNameModuleInterface', but be aware that doing this indiscriminantly</span>
<a name="line-9"></a><span class='hs-comment'>-- will impose a performance penalty.</span>
<a name="line-10"></a><span class='hs-comment'>--</span>
<a name="line-11"></a><span class='hs-comment'>-- If no deserialization function is supplied, only transient annotations will be returned.</span>
<a name="line-12"></a><span class='hs-definition'>findAnnotations</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Typeable</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Word8</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreAnnTarget</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span>
<a name="line-13"></a><span class='hs-definition'>findAnnotations</span> <span class='hs-varid'>deserialize</span> <span class='hs-varid'>target</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-14"></a> <span class='hs-varid'>ann_env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getAnnEnv</span>
<a name="line-15"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>findAnns</span> <span class='hs-varid'>deserialize</span> <span class='hs-varid'>ann_env</span> <span class='hs-varid'>target</span><span class='hs-layout'>)</span>
<a name="line-16"></a>
<a name="line-17"></a><a name="addAnnotation"></a><span class='hs-definition'>addAnnotation</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Typeable</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Word8</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreAnnTarget</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-18"></a><span class='hs-definition'>addAnnotation</span> <span class='hs-varid'>serialize</span> <span class='hs-varid'>target</span> <span class='hs-varid'>what</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addAnnotationToEnv</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Annotation</span> <span class='hs-layout'>{</span> <span class='hs-varid'>ann_target</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>target</span><span class='hs-layout'>,</span> <span class='hs-varid'>ann_value</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>toSerialized</span> <span class='hs-varid'>serialize</span> <span class='hs-varid'>what</span> <span class='hs-layout'>}</span>
<a name="line-19"></a>
<a name="line-20"></a><a name="addAnnotationToEnv"></a><span class='hs-definition'>addAnnotationToEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Annotation</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-21"></a><span class='hs-definition'>addAnnotationToEnv</span> <span class='hs-varid'>annotation</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>modifyS</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>state</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>state</span> <span class='hs-layout'>{</span> <span class='hs-varid'>cs_ann_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendAnnEnvList</span> <span class='hs-layout'>(</span><span class='hs-varid'>cs_ann_env</span> <span class='hs-varid'>state</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>annotation</span><span class='hs-keyglyph'>]</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-22"></a>
</pre>\end{code}
\subsection{Direct screen output}
\begin{code}
<pre><a name="line-1"></a>
<a name="line-2"></a><a name="msg"></a><span class='hs-definition'>msg</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>DynFlags</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</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-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-3"></a><span class='hs-definition'>msg</span> <span class='hs-varid'>how</span> <span class='hs-varid'>doc</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-4"></a> <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getDynFlags</span>
<a name="line-5"></a> <span class='hs-varid'>liftIO</span> <span class='hs-varop'>$</span> <span class='hs-varid'>how</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>doc</span>
<a name="line-6"></a>
<a name="line-7"></a><a name="putMsgS"></a><span class='hs-comment'>-- | Output a String message to the screen</span>
<a name="line-8"></a><span class='hs-definition'>putMsgS</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-9"></a><span class='hs-definition'>putMsgS</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>putMsg</span> <span class='hs-varop'>.</span> <span class='hs-varid'>text</span>
<a name="line-10"></a>
<a name="line-11"></a><a name="putMsg"></a><span class='hs-comment'>-- | Output a message to the screen</span>
<a name="line-12"></a><span class='hs-definition'>putMsg</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SDoc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-13"></a><span class='hs-definition'>putMsg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>msg</span> <span class='hs-conid'>Err</span><span class='hs-varop'>.</span><span class='hs-varid'>putMsg</span>
<a name="line-14"></a>
<a name="line-15"></a><a name="errorMsgS"></a><span class='hs-comment'>-- | Output a string error to the screen</span>
<a name="line-16"></a><span class='hs-definition'>errorMsgS</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-17"></a><span class='hs-definition'>errorMsgS</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>errorMsg</span> <span class='hs-varop'>.</span> <span class='hs-varid'>text</span>
<a name="line-18"></a>
<a name="line-19"></a><a name="errorMsg"></a><span class='hs-comment'>-- | Output an error to the screen</span>
<a name="line-20"></a><span class='hs-definition'>errorMsg</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SDoc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-21"></a><span class='hs-definition'>errorMsg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>msg</span> <span class='hs-conid'>Err</span><span class='hs-varop'>.</span><span class='hs-varid'>errorMsg</span>
<a name="line-22"></a>
<a name="line-23"></a><a name="fatalErrorMsgS"></a><span class='hs-comment'>-- | Output a fatal string error to the screen. Note this does not by itself cause the compiler to die</span>
<a name="line-24"></a><span class='hs-definition'>fatalErrorMsgS</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-25"></a><span class='hs-definition'>fatalErrorMsgS</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fatalErrorMsg</span> <span class='hs-varop'>.</span> <span class='hs-varid'>text</span>
<a name="line-26"></a>
<a name="line-27"></a><a name="fatalErrorMsg"></a><span class='hs-comment'>-- | Output a fatal error to the screen. Note this does not by itself cause the compiler to die</span>
<a name="line-28"></a><span class='hs-definition'>fatalErrorMsg</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SDoc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-29"></a><span class='hs-definition'>fatalErrorMsg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>msg</span> <span class='hs-conid'>Err</span><span class='hs-varop'>.</span><span class='hs-varid'>fatalErrorMsg</span>
<a name="line-30"></a>
<a name="line-31"></a><a name="debugTraceMsgS"></a><span class='hs-comment'>-- | Output a string debugging message at verbosity level of @-v@ or higher</span>
<a name="line-32"></a><span class='hs-definition'>debugTraceMsgS</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-33"></a><span class='hs-definition'>debugTraceMsgS</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>debugTraceMsg</span> <span class='hs-varop'>.</span> <span class='hs-varid'>text</span>
<a name="line-34"></a>
<a name="line-35"></a><a name="debugTraceMsg"></a><span class='hs-comment'>-- | Outputs a debugging message at verbosity level of @-v@ or higher</span>
<a name="line-36"></a><span class='hs-definition'>debugTraceMsg</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SDoc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-37"></a><span class='hs-definition'>debugTraceMsg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>msg</span> <span class='hs-layout'>(</span><span class='hs-varid'>flip</span> <span class='hs-conid'>Err</span><span class='hs-varop'>.</span><span class='hs-varid'>debugTraceMsg</span> <span class='hs-num'>3</span><span class='hs-layout'>)</span>
<a name="line-38"></a>
<a name="line-39"></a><a name="dumpIfSet_dyn"></a><span class='hs-comment'>-- | Show some labelled 'SDoc' if a particular flag is set or at a verbosity level of @-v -ddump-most@ or higher</span>
<a name="line-40"></a><span class='hs-definition'>dumpIfSet_dyn</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DynFlag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-conid'>()</span>
<a name="line-41"></a><span class='hs-definition'>dumpIfSet_dyn</span> <span class='hs-varid'>flag</span> <span class='hs-varid'>str</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>msg</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>dflags</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Err</span><span class='hs-varop'>.</span><span class='hs-varid'>dumpIfSet_dyn</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>flag</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span>
<a name="line-42"></a>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a>
<a name="line-2"></a><a name="initTcForLookup"></a><span class='hs-definition'>initTcForLookup</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HscEnv</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'>IO</span> <span class='hs-varid'>a</span>
<a name="line-3"></a><span class='hs-definition'>initTcForLookup</span> <span class='hs-varid'>hsc_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftM</span> <span class='hs-layout'>(</span><span class='hs-varid'>expectJust</span> <span class='hs-str'>"initTcInteractive"</span> <span class='hs-varop'>.</span> <span class='hs-varid'>snd</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-varid'>initTc</span> <span class='hs-varid'>hsc_env</span> <span class='hs-conid'>HsSrcFile</span> <span class='hs-conid'>False</span> <span class='hs-varid'>iNTERACTIVE</span>
<a name="line-4"></a>
</pre>\end{code}
\subsection{Finding TyThings}
\begin{code}
<pre><a name="line-1"></a>
<a name="line-2"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>MonadThings</span> <span class='hs-conid'>CoreM</span> <span class='hs-keyword'>where</span>
<a name="line-3"></a> <span class='hs-varid'>lookupThing</span> <span class='hs-varid'>name</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-4"></a> <span class='hs-varid'>hsc_env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getHscEnv</span>
<a name="line-5"></a> <span class='hs-varid'>liftIO</span> <span class='hs-varop'>$</span> <span class='hs-varid'>initTcForLookup</span> <span class='hs-varid'>hsc_env</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcLookupGlobal</span> <span class='hs-varid'>name</span><span class='hs-layout'>)</span>
<a name="line-6"></a>
</pre>\end{code}
\subsection{Template Haskell interoperability}
\begin{code}
<pre><a name="line-1"></a><span class='hs-cpp'>#</span><span class='hs-varid'>ifdef</span> <span class='hs-conid'>GHCI</span>
<a name="line-2"></a><a name="thNameToGhcName"></a><span class='hs-comment'>-- | Attempt to convert a Template Haskell name to one that GHC can</span>
<a name="line-3"></a><span class='hs-comment'>-- understand. Original TH names such as those you get when you use</span>
<a name="line-4"></a><span class='hs-comment'>-- the @'foo@ syntax will be translated to their equivalent GHC name</span>
<a name="line-5"></a><span class='hs-comment'>-- exactly. Qualified or unqualifed TH names will be dynamically bound</span>
<a name="line-6"></a><span class='hs-comment'>-- to names in the module being compiled, if possible. Exact TH names</span>
<a name="line-7"></a><span class='hs-comment'>-- will be bound to the name they represent, exactly.</span>
<a name="line-8"></a><span class='hs-definition'>thNameToGhcName</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TH</span><span class='hs-varop'>.</span><span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>Name</span><span class='hs-layout'>)</span>
<a name="line-9"></a><span class='hs-definition'>thNameToGhcName</span> <span class='hs-varid'>th_name</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-10"></a> <span class='hs-varid'>hsc_env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getHscEnv</span>
<a name="line-11"></a> <span class='hs-varid'>liftIO</span> <span class='hs-varop'>$</span> <span class='hs-varid'>initTcForLookup</span> <span class='hs-varid'>hsc_env</span> <span class='hs-layout'>(</span><span class='hs-varid'>lookupThName_maybe</span> <span class='hs-varid'>th_name</span><span class='hs-layout'>)</span>
<a name="line-12"></a><span class='hs-cpp'>#endif</span>
</pre>\end{code}
</body>
</html>
