Sophie

Sophie

distrib > Fedora > 14 > i386 > by-pkgid > 8d1ef08c9e0d44c69764afc615a03d0d > files > 1802

ghc-ghc-devel-6.12.3-5.fc14.i686.rpm

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>utils/Panic.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The University of Glasgow 2006
% (c) The GRASP Project, Glasgow University, 1992-2000
%

Defines basic funtions for printing error messages.

It's hard to put these functions anywhere else without causing
some unnecessary loops in the module dependency graph.

\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Panic</span>  
<a name="line-2"></a>   <span class='hs-layout'>(</span> 
<a name="line-3"></a>     <span class='hs-conid'>GhcException</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'>showGhcException</span><span class='hs-layout'>,</span> <span class='hs-varid'>throwGhcException</span><span class='hs-layout'>,</span> <span class='hs-varid'>handleGhcException</span><span class='hs-layout'>,</span>
<a name="line-4"></a>     <span class='hs-varid'>ghcError</span><span class='hs-layout'>,</span> <span class='hs-varid'>progName</span><span class='hs-layout'>,</span>
<a name="line-5"></a>     <span class='hs-varid'>pgmError</span><span class='hs-layout'>,</span>
<a name="line-6"></a>
<a name="line-7"></a>     <span class='hs-varid'>panic</span><span class='hs-layout'>,</span> <span class='hs-varid'>panicFastInt</span><span class='hs-layout'>,</span> <span class='hs-varid'>assertPanic</span><span class='hs-layout'>,</span> <span class='hs-varid'>trace</span><span class='hs-layout'>,</span>
<a name="line-8"></a>     
<a name="line-9"></a>     <span class='hs-conid'>Exception</span><span class='hs-varop'>.</span><span class='hs-conid'>Exception</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'>showException</span><span class='hs-layout'>,</span> <span class='hs-varid'>try</span><span class='hs-layout'>,</span> <span class='hs-varid'>tryMost</span><span class='hs-layout'>,</span> <span class='hs-varid'>throwTo</span><span class='hs-layout'>,</span>
<a name="line-10"></a>
<a name="line-11"></a>     <span class='hs-varid'>installSignalHandlers</span><span class='hs-layout'>,</span> <span class='hs-varid'>interruptTargetThread</span>
<a name="line-12"></a>   <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-15"></a>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Config</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastTypes</span>
<a name="line-18"></a>
<a name="line-19"></a><span class='hs-cpp'>#ifndef mingw32_HOST_OS</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>Posix</span><span class='hs-varop'>.</span><span class='hs-conid'>Signals</span>
<a name="line-21"></a><span class='hs-cpp'>#endif /* mingw32_HOST_OS */</span>
<a name="line-22"></a>
<a name="line-23"></a><span class='hs-cpp'>#if defined(mingw32_HOST_OS)</span>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>GHC</span><span class='hs-varop'>.</span><span class='hs-conid'>ConsoleHandler</span>
<a name="line-25"></a><span class='hs-cpp'>#endif</span>
<a name="line-26"></a>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Exception</span>
<a name="line-28"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Concurrent</span> <span class='hs-layout'>(</span> <span class='hs-conid'>MVar</span><span class='hs-layout'>,</span> <span class='hs-conid'>ThreadId</span><span class='hs-layout'>,</span> <span class='hs-varid'>withMVar</span><span class='hs-layout'>,</span> <span class='hs-varid'>newMVar</span><span class='hs-layout'>,</span> <span class='hs-varid'>modifyMVar_</span><span class='hs-layout'>,</span>
<a name="line-29"></a>                            <span class='hs-varid'>myThreadId</span> <span class='hs-layout'>)</span>
<a name="line-30"></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-31"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Debug</span><span class='hs-varop'>.</span><span class='hs-conid'>Trace</span>	<span class='hs-layout'>(</span> <span class='hs-varid'>trace</span> <span class='hs-layout'>)</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span><span class='hs-varop'>.</span><span class='hs-conid'>Unsafe</span>	<span class='hs-layout'>(</span> <span class='hs-varid'>unsafePerformIO</span> <span class='hs-layout'>)</span>
<a name="line-33"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>Exit</span>
<a name="line-34"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>Environment</span>
</pre>\end{code}

GHC's own exception type.

\begin{code}
<pre><a name="line-1"></a><a name="ghcError"></a><span class='hs-definition'>ghcError</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GhcException</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>a</span>
<a name="line-2"></a><span class='hs-definition'>ghcError</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Exception</span><span class='hs-varop'>.</span><span class='hs-varid'>throw</span> <span class='hs-varid'>e</span>
<a name="line-3"></a>
<a name="line-4"></a><span class='hs-comment'>-- error messages all take the form</span>
<a name="line-5"></a><span class='hs-comment'>--</span>
<a name="line-6"></a><span class='hs-comment'>--	&lt;location&gt;: &lt;error&gt;</span>
<a name="line-7"></a><span class='hs-comment'>--</span>
<a name="line-8"></a><span class='hs-comment'>-- If the location is on the command line, or in GHC itself, then </span>
<a name="line-9"></a><span class='hs-comment'>-- &lt;location&gt;="ghc".  All of the error types below correspond to </span>
<a name="line-10"></a><span class='hs-comment'>-- a &lt;location&gt; of "ghc", except for ProgramError (where the string is</span>
<a name="line-11"></a><span class='hs-comment'>-- assumed to contain a location already, so we don't print one).</span>
<a name="line-12"></a>
<a name="line-13"></a><a name="GhcException"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>GhcException</span>
<a name="line-14"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PhaseFailed</span> <span class='hs-conid'>String</span>		<span class='hs-comment'>-- name of phase </span>
<a name="line-15"></a>  		<span class='hs-conid'>ExitCode</span>	<span class='hs-comment'>-- an external phase (eg. cpp) failed</span>
<a name="line-16"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Interrupted</span>			<span class='hs-comment'>-- someone pressed ^C</span>
<a name="line-17"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Signal</span> <span class='hs-conid'>Int</span>                  <span class='hs-comment'>-- some other fatal signal (SIGHUP,SIGTERM)</span>
<a name="line-18"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>UsageError</span> <span class='hs-conid'>String</span>		<span class='hs-comment'>-- prints the short usage msg after the error</span>
<a name="line-19"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>CmdLineError</span> <span class='hs-conid'>String</span>		<span class='hs-comment'>-- cmdline prob, but doesn't print usage</span>
<a name="line-20"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Panic</span> <span class='hs-conid'>String</span>		<span class='hs-comment'>-- the `impossible' happened</span>
<a name="line-21"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>InstallationError</span> <span class='hs-conid'>String</span>	<span class='hs-comment'>-- an installation problem</span>
<a name="line-22"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>ProgramError</span> <span class='hs-conid'>String</span>		<span class='hs-comment'>-- error in the user's code, probably</span>
<a name="line-23"></a>  <span class='hs-keyword'>deriving</span> <span class='hs-conid'>Eq</span>
<a name="line-24"></a>
<a name="line-25"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Exception</span> <span class='hs-conid'>GhcException</span>
<a name="line-26"></a>
<a name="line-27"></a><a name="progName"></a><span class='hs-definition'>progName</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span>
<a name="line-28"></a><span class='hs-definition'>progName</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unsafePerformIO</span> <span class='hs-layout'>(</span><span class='hs-varid'>getProgName</span><span class='hs-layout'>)</span>
<a name="line-29"></a><span class='hs-comment'>{-# NOINLINE progName #-}</span>
<a name="line-30"></a>
<a name="line-31"></a><a name="short_usage"></a><span class='hs-definition'>short_usage</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span>
<a name="line-32"></a><span class='hs-definition'>short_usage</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"Usage: For basic information, try the `--help' option."</span>
<a name="line-33"></a>
<a name="line-34"></a><a name="showException"></a><span class='hs-definition'>showException</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Exception</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>=&gt;</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>String</span>
<a name="line-35"></a><span class='hs-definition'>showException</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>show</span>
<a name="line-36"></a>
<a name="line-37"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Show</span> <span class='hs-conid'>GhcException</span> <span class='hs-keyword'>where</span>
<a name="line-38"></a>  <span class='hs-varid'>showsPrec</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>e</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>ProgramError</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showGhcException</span> <span class='hs-varid'>e</span>
<a name="line-39"></a>  <span class='hs-varid'>showsPrec</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>e</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>CmdLineError</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showString</span> <span class='hs-str'>"&lt;command line&gt;: "</span> <span class='hs-varop'>.</span> <span class='hs-varid'>showGhcException</span> <span class='hs-varid'>e</span>
<a name="line-40"></a>  <span class='hs-varid'>showsPrec</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showString</span> <span class='hs-varid'>progName</span> <span class='hs-varop'>.</span> <span class='hs-varid'>showString</span> <span class='hs-str'>": "</span> <span class='hs-varop'>.</span> <span class='hs-varid'>showGhcException</span> <span class='hs-varid'>e</span>
<a name="line-41"></a>
<a name="line-42"></a><a name="showGhcException"></a><span class='hs-definition'>showGhcException</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GhcException</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>String</span>
<a name="line-43"></a><span class='hs-definition'>showGhcException</span> <span class='hs-layout'>(</span><span class='hs-conid'>UsageError</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span>
<a name="line-44"></a>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showString</span> <span class='hs-varid'>str</span> <span class='hs-varop'>.</span> <span class='hs-varid'>showChar</span> <span class='hs-chr'>'\n'</span> <span class='hs-varop'>.</span> <span class='hs-varid'>showString</span> <span class='hs-varid'>short_usage</span>
<a name="line-45"></a><span class='hs-definition'>showGhcException</span> <span class='hs-layout'>(</span><span class='hs-conid'>PhaseFailed</span> <span class='hs-varid'>phase</span> <span class='hs-varid'>code</span><span class='hs-layout'>)</span>
<a name="line-46"></a>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showString</span> <span class='hs-str'>"phase `"</span> <span class='hs-varop'>.</span> <span class='hs-varid'>showString</span> <span class='hs-varid'>phase</span> <span class='hs-varop'>.</span> 
<a name="line-47"></a>     <span class='hs-varid'>showString</span> <span class='hs-str'>"' failed (exitcode = "</span> <span class='hs-varop'>.</span> <span class='hs-varid'>shows</span> <span class='hs-varid'>int_code</span> <span class='hs-varop'>.</span> 
<a name="line-48"></a>     <span class='hs-varid'>showString</span> <span class='hs-str'>")"</span>
<a name="line-49"></a>  <span class='hs-keyword'>where</span>
<a name="line-50"></a>    <span class='hs-varid'>int_code</span> <span class='hs-keyglyph'>=</span> 
<a name="line-51"></a>      <span class='hs-keyword'>case</span> <span class='hs-varid'>code</span> <span class='hs-keyword'>of</span>
<a name="line-52"></a>        <span class='hs-conid'>ExitSuccess</span>   <span class='hs-keyglyph'>-&gt;</span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-keyglyph'>::</span><span class='hs-conid'>Int</span><span class='hs-layout'>)</span>
<a name="line-53"></a>	<span class='hs-conid'>ExitFailure</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>x</span>
<a name="line-54"></a><span class='hs-definition'>showGhcException</span> <span class='hs-layout'>(</span><span class='hs-conid'>CmdLineError</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span>
<a name="line-55"></a>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showString</span> <span class='hs-varid'>str</span>
<a name="line-56"></a><span class='hs-definition'>showGhcException</span> <span class='hs-layout'>(</span><span class='hs-conid'>ProgramError</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span>
<a name="line-57"></a>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showString</span> <span class='hs-varid'>str</span>
<a name="line-58"></a><span class='hs-definition'>showGhcException</span> <span class='hs-layout'>(</span><span class='hs-conid'>InstallationError</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span>
<a name="line-59"></a>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showString</span> <span class='hs-varid'>str</span>
<a name="line-60"></a><span class='hs-definition'>showGhcException</span> <span class='hs-layout'>(</span><span class='hs-conid'>Interrupted</span><span class='hs-layout'>)</span>
<a name="line-61"></a>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showString</span> <span class='hs-str'>"interrupted"</span>
<a name="line-62"></a><span class='hs-definition'>showGhcException</span> <span class='hs-layout'>(</span><span class='hs-conid'>Signal</span> <span class='hs-varid'>n</span><span class='hs-layout'>)</span>
<a name="line-63"></a>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showString</span> <span class='hs-str'>"signal: "</span> <span class='hs-varop'>.</span> <span class='hs-varid'>shows</span> <span class='hs-varid'>n</span>
<a name="line-64"></a><span class='hs-definition'>showGhcException</span> <span class='hs-layout'>(</span><span class='hs-conid'>Panic</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span>
<a name="line-65"></a>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showString</span> <span class='hs-layout'>(</span><span class='hs-str'>"panic! (the 'impossible' happened)\n"</span>
<a name="line-66"></a>		 <span class='hs-varop'>++</span> <span class='hs-str'>"  (GHC version "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>cProjectVersion</span> <span class='hs-varop'>++</span> <span class='hs-str'>" for "</span> <span class='hs-varop'>++</span> <span class='hs-conid'>TargetPlatform_NAME</span> <span class='hs-varop'>++</span> <span class='hs-str'>"):\n\t"</span>
<a name="line-67"></a>	         <span class='hs-varop'>++</span> <span class='hs-varid'>s</span> <span class='hs-varop'>++</span> <span class='hs-str'>"\n\n"</span>
<a name="line-68"></a>	         <span class='hs-varop'>++</span> <span class='hs-str'>"Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n"</span><span class='hs-layout'>)</span>
<a name="line-69"></a>
<a name="line-70"></a><a name="throwGhcException"></a><span class='hs-definition'>throwGhcException</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GhcException</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>a</span>
<a name="line-71"></a><span class='hs-definition'>throwGhcException</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Exception</span><span class='hs-varop'>.</span><span class='hs-varid'>throw</span>
<a name="line-72"></a>
<a name="line-73"></a><a name="handleGhcException"></a><span class='hs-definition'>handleGhcException</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ExceptionMonad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=&gt;</span> <span class='hs-layout'>(</span><span class='hs-conid'>GhcException</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-74"></a><span class='hs-definition'>handleGhcException</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ghandle</span>
<a name="line-75"></a>
<a name="line-76"></a><a name="ghcExceptionTc"></a><span class='hs-definition'>ghcExceptionTc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyCon</span>
<a name="line-77"></a><span class='hs-definition'>ghcExceptionTc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTyCon</span> <span class='hs-str'>"GhcException"</span>
<a name="line-78"></a><span class='hs-comment'>{-# NOINLINE ghcExceptionTc #-}</span>
<a name="line-79"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Typeable</span> <span class='hs-conid'>GhcException</span> <span class='hs-keyword'>where</span>
<a name="line-80"></a>  <span class='hs-varid'>typeOf</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkTyConApp</span> <span class='hs-varid'>ghcExceptionTc</span> <span class='hs-conid'>[]</span>
</pre>\end{code}

Panics and asserts.

\begin{code}
<pre><a name="line-1"></a><a name="panic"></a><span class='hs-definition'>panic</span><span class='hs-layout'>,</span> <span class='hs-varid'>pgmError</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>a</span>
<a name="line-2"></a><span class='hs-definition'>panic</span>    <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>throwGhcException</span> <span class='hs-layout'>(</span><span class='hs-conid'>Panic</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-3"></a><a name="pgmError"></a><span class='hs-definition'>pgmError</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>throwGhcException</span> <span class='hs-layout'>(</span><span class='hs-conid'>ProgramError</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-4"></a>
<a name="line-5"></a><span class='hs-comment'>--  #-versions because panic can't return an unboxed int, and that's</span>
<a name="line-6"></a><span class='hs-comment'>-- what TAG_ is with GHC at the moment.  Ugh. (Simon)</span>
<a name="line-7"></a><span class='hs-comment'>-- No, man -- Too Beautiful! (Will)</span>
<a name="line-8"></a>
<a name="line-9"></a><a name="panicFastInt"></a><span class='hs-definition'>panicFastInt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>FastInt</span>
<a name="line-10"></a><span class='hs-definition'>panicFastInt</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>panic</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span> <span class='hs-conid'>()</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-sel'>_ILIT</span><span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-11"></a>
<a name="line-12"></a><a name="assertPanic"></a><span class='hs-definition'>assertPanic</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>a</span>
<a name="line-13"></a><span class='hs-definition'>assertPanic</span> <span class='hs-varid'>file</span> <span class='hs-varid'>line</span> <span class='hs-keyglyph'>=</span> 
<a name="line-14"></a>  <span class='hs-conid'>Exception</span><span class='hs-varop'>.</span><span class='hs-varid'>throw</span> <span class='hs-layout'>(</span><span class='hs-conid'>Exception</span><span class='hs-varop'>.</span><span class='hs-conid'>AssertionFailed</span> 
<a name="line-15"></a>           <span class='hs-layout'>(</span><span class='hs-str'>"ASSERT failed! file "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>file</span> <span class='hs-varop'>++</span> <span class='hs-str'>", line "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-varid'>line</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
</pre>\end{code}

\begin{code}
<pre><a name="line-1"></a><span class='hs-comment'>-- | tryMost is like try, but passes through Interrupted and Panic</span>
<a name="line-2"></a><span class='hs-comment'>-- exceptions.  Used when we want soft failures when reading interface</span>
<a name="line-3"></a><span class='hs-comment'>-- files, for example.</span>
<a name="line-4"></a>
<a name="line-5"></a><a name="tryMost"></a><span class='hs-comment'>-- XXX I'm not entirely sure if this is catching what we really want to catch</span>
<a name="line-6"></a><span class='hs-definition'>tryMost</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Either</span> <span class='hs-conid'>SomeException</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-7"></a><span class='hs-definition'>tryMost</span> <span class='hs-varid'>action</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>try</span> <span class='hs-varid'>action</span>
<a name="line-8"></a>                    <span class='hs-keyword'>case</span> <span class='hs-varid'>r</span> <span class='hs-keyword'>of</span>
<a name="line-9"></a>                        <span class='hs-conid'>Left</span> <span class='hs-varid'>se</span> <span class='hs-keyglyph'>-&gt;</span>
<a name="line-10"></a>                            <span class='hs-keyword'>case</span> <span class='hs-varid'>fromException</span> <span class='hs-varid'>se</span> <span class='hs-keyword'>of</span>
<a name="line-11"></a>                                <span class='hs-comment'>-- Some GhcException's we rethrow,</span>
<a name="line-12"></a>                                <span class='hs-conid'>Just</span> <span class='hs-conid'>Interrupted</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>throwIO</span> <span class='hs-varid'>se</span>
<a name="line-13"></a>                                <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-conid'>Signal</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>  <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>throwIO</span> <span class='hs-varid'>se</span>
<a name="line-14"></a>                                <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-conid'>Panic</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>   <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>throwIO</span> <span class='hs-varid'>se</span>
<a name="line-15"></a>                                <span class='hs-comment'>-- others we return</span>
<a name="line-16"></a>                                <span class='hs-conid'>Just</span> <span class='hs-keyword'>_</span>           <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Left</span> <span class='hs-varid'>se</span><span class='hs-layout'>)</span>
<a name="line-17"></a>                                <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-&gt;</span>
<a name="line-18"></a>                                    <span class='hs-keyword'>case</span> <span class='hs-varid'>fromException</span> <span class='hs-varid'>se</span> <span class='hs-keyword'>of</span>
<a name="line-19"></a>                                        <span class='hs-comment'>-- All IOExceptions are returned</span>
<a name="line-20"></a>                                        <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IOException</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span>
<a name="line-21"></a>                                            <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Left</span> <span class='hs-varid'>se</span><span class='hs-layout'>)</span>
<a name="line-22"></a>                                        <span class='hs-comment'>-- Anything else is rethrown</span>
<a name="line-23"></a>                                        <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>throwIO</span> <span class='hs-varid'>se</span>
<a name="line-24"></a>                        <span class='hs-conid'>Right</span> <span class='hs-varid'>v</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Right</span> <span class='hs-varid'>v</span><span class='hs-layout'>)</span>
</pre>\end{code}

Standard signal handlers for catching ^C, which just throw an
exception in the target thread.  The current target thread is
the thread at the head of the list in the MVar passed to
installSignalHandlers.

\begin{code}
<pre><a name="line-1"></a><a name="installSignalHandlers"></a><span class='hs-definition'>installSignalHandlers</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-2"></a><span class='hs-definition'>installSignalHandlers</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-3"></a>  <span class='hs-varid'>main_thread</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>myThreadId</span>
<a name="line-4"></a>  <span class='hs-varid'>modifyMVar_</span> <span class='hs-varid'>interruptTargetThread</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-varop'>.</span> <span class='hs-layout'>(</span><span class='hs-varid'>main_thread</span> <span class='hs-conop'>:</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'>let</span>
<a name="line-7"></a>      <span class='hs-varid'>interrupt_exn</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>toException</span> <span class='hs-conid'>Interrupted</span><span class='hs-layout'>)</span>
<a name="line-8"></a>
<a name="line-9"></a>      <span class='hs-varid'>interrupt</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-10"></a>	<span class='hs-varid'>withMVar</span> <span class='hs-varid'>interruptTargetThread</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>targets</span> <span class='hs-keyglyph'>-&gt;</span>
<a name="line-11"></a>	  <span class='hs-keyword'>case</span> <span class='hs-varid'>targets</span> <span class='hs-keyword'>of</span>
<a name="line-12"></a>	   <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-13"></a>	   <span class='hs-layout'>(</span><span class='hs-varid'>thread</span><span class='hs-conop'>:</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>throwTo</span> <span class='hs-varid'>thread</span> <span class='hs-varid'>interrupt_exn</span>
<a name="line-14"></a>
<a name="line-15"></a>  <span class='hs-comment'>--</span>
<a name="line-16"></a><span class='hs-cpp'>#if !defined(mingw32_HOST_OS)</span>
<a name="line-17"></a>  <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>installHandler</span> <span class='hs-varid'>sigQUIT</span>  <span class='hs-layout'>(</span><span class='hs-conid'>Catch</span> <span class='hs-varid'>interrupt</span><span class='hs-layout'>)</span> <span class='hs-conid'>Nothing</span> 
<a name="line-18"></a>  <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>installHandler</span> <span class='hs-varid'>sigINT</span>   <span class='hs-layout'>(</span><span class='hs-conid'>Catch</span> <span class='hs-varid'>interrupt</span><span class='hs-layout'>)</span> <span class='hs-conid'>Nothing</span>
<a name="line-19"></a>  <span class='hs-comment'>-- see #3656; in the future we should install these automatically for</span>
<a name="line-20"></a>  <span class='hs-comment'>-- all Haskell programs in the same way that we install a ^C handler.</span>
<a name="line-21"></a>  <span class='hs-keyword'>let</span> <span class='hs-varid'>fatal_signal</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>throwTo</span> <span class='hs-varid'>main_thread</span> <span class='hs-layout'>(</span><span class='hs-conid'>Signal</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>n</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-22"></a>  <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>installHandler</span> <span class='hs-varid'>sigHUP</span>   <span class='hs-layout'>(</span><span class='hs-conid'>Catch</span> <span class='hs-layout'>(</span><span class='hs-varid'>fatal_signal</span> <span class='hs-varid'>sigHUP</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>  <span class='hs-conid'>Nothing</span>
<a name="line-23"></a>  <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>installHandler</span> <span class='hs-varid'>sigTERM</span>  <span class='hs-layout'>(</span><span class='hs-conid'>Catch</span> <span class='hs-layout'>(</span><span class='hs-varid'>fatal_signal</span> <span class='hs-varid'>sigTERM</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-conid'>Nothing</span>
<a name="line-24"></a>  <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-25"></a><span class='hs-cpp'>#else</span>
<a name="line-26"></a>  <span class='hs-comment'>-- GHC 6.3+ has support for console events on Windows</span>
<a name="line-27"></a>  <span class='hs-comment'>-- NOTE: running GHCi under a bash shell for some reason requires</span>
<a name="line-28"></a>  <span class='hs-comment'>-- you to press Ctrl-Break rather than Ctrl-C to provoke</span>
<a name="line-29"></a>  <span class='hs-comment'>-- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know</span>
<a name="line-30"></a>  <span class='hs-comment'>-- why --SDM 17/12/2004</span>
<a name="line-31"></a>  <span class='hs-keyword'>let</span> <span class='hs-varid'>sig_handler</span> <span class='hs-conid'>ControlC</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>interrupt</span>
<a name="line-32"></a>      <span class='hs-varid'>sig_handler</span> <span class='hs-conid'>Break</span>    <span class='hs-keyglyph'>=</span> <span class='hs-varid'>interrupt</span>
<a name="line-33"></a>      <span class='hs-varid'>sig_handler</span> <span class='hs-keyword'>_</span>        <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-34"></a>
<a name="line-35"></a>  <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>installHandler</span> <span class='hs-layout'>(</span><span class='hs-conid'>Catch</span> <span class='hs-varid'>sig_handler</span><span class='hs-layout'>)</span>
<a name="line-36"></a>  <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-37"></a><span class='hs-cpp'>#endif</span>
<a name="line-38"></a>
<a name="line-39"></a><a name="interruptTargetThread"></a><span class='hs-comment'>{-# NOINLINE interruptTargetThread #-}</span>
<a name="line-40"></a><span class='hs-definition'>interruptTargetThread</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MVar</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>ThreadId</span><span class='hs-keyglyph'>]</span>
<a name="line-41"></a><span class='hs-definition'>interruptTargetThread</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unsafePerformIO</span> <span class='hs-layout'>(</span><span class='hs-varid'>newMVar</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
</pre>\end{code}
</body>
</html>