Sophie

Sophie

distrib > Fedora > 14 > x86_64 > by-pkgid > 8d1ef08c9e0d44c69764afc615a03d0d > files > 1927

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>typecheck/TcForeign.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The University of Glasgow 2006
% (c) The AQUA Project, Glasgow University, 1998
%
\section[TcForeign]{Typechecking \tr{foreign} declarations}

A foreign declaration is used to either give an externally
implemented function a Haskell type (and calling interface) or
give a Haskell function an external calling interface. Either way,
the range of argument and result types these functions can accommodate
is restricted to what the outside world understands (read C), and this
module checks to see if a foreign declaration has got a legal type.

\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>TcForeign</span> 
<a name="line-2"></a>	<span class='hs-layout'>(</span> 
<a name="line-3"></a>	  <span class='hs-varid'>tcForeignImports</span>
<a name="line-4"></a>        <span class='hs-layout'>,</span> <span class='hs-varid'>tcForeignExports</span>
<a name="line-5"></a>	<span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-8"></a>
<a name="line-9"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HsSyn</span>
<a name="line-10"></a>
<a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcRnMonad</span>
<a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcHsType</span>
<a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcExpr</span>
<a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcEnv</span>
<a name="line-15"></a>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ForeignCall</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ErrUtils</span>
<a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Id</span>
<a name="line-19"></a><span class='hs-cpp'>#if alpha_TARGET_ARCH</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Type</span>
<a name="line-21"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>SMRep</span>
<a name="line-22"></a><span class='hs-cpp'>#endif</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcType</span>
<a name="line-25"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DynFlags</span>
<a name="line-26"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>SrcLoc</span>
<a name="line-28"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Bag</span>
<a name="line-29"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastString</span>
</pre>\end{code}

\begin{code}
<pre><a name="line-1"></a><a name="isForeignImport"></a><span class='hs-comment'>-- Defines a binding</span>
<a name="line-2"></a><span class='hs-definition'>isForeignImport</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LForeignDecl</span> <span class='hs-varid'>name</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-3"></a><span class='hs-definition'>isForeignImport</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>ForeignImport</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</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-4"></a><span class='hs-definition'>isForeignImport</span> <span class='hs-keyword'>_</span>			      <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-5"></a>
<a name="line-6"></a><a name="isForeignExport"></a><span class='hs-comment'>-- Exports a binding</span>
<a name="line-7"></a><span class='hs-definition'>isForeignExport</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LForeignDecl</span> <span class='hs-varid'>name</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-8"></a><span class='hs-definition'>isForeignExport</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>ForeignExport</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</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-9"></a><span class='hs-definition'>isForeignExport</span> <span class='hs-keyword'>_</span>	  	              <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
</pre>\end{code}

%************************************************************************
%*									*
\subsection{Imports}
%*									*
%************************************************************************

\begin{code}
<pre><a name="line-1"></a><a name="tcForeignImports"></a><span class='hs-definition'>tcForeignImports</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LForeignDecl</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LForeignDecl</span> <span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-2"></a><span class='hs-definition'>tcForeignImports</span> <span class='hs-varid'>decls</span>
<a name="line-3"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapAndUnzipM</span> <span class='hs-layout'>(</span><span class='hs-varid'>wrapLocSndM</span> <span class='hs-varid'>tcFImport</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>filter</span> <span class='hs-varid'>isForeignImport</span> <span class='hs-varid'>decls</span><span class='hs-layout'>)</span>
<a name="line-4"></a>
<a name="line-5"></a><a name="tcFImport"></a><span class='hs-definition'>tcFImport</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ForeignDecl</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Id</span><span class='hs-layout'>,</span> <span class='hs-conid'>ForeignDecl</span> <span class='hs-conid'>Id</span><span class='hs-layout'>)</span>
<a name="line-6"></a><span class='hs-definition'>tcFImport</span> <span class='hs-varid'>fo</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>ForeignImport</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>nm</span><span class='hs-layout'>)</span> <span class='hs-varid'>hs_ty</span> <span class='hs-varid'>imp_decl</span><span class='hs-layout'>)</span>
<a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addErrCtxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>foreignDeclCtxt</span> <span class='hs-varid'>fo</span><span class='hs-layout'>)</span>  <span class='hs-varop'>$</span> 
<a name="line-8"></a>   <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>sig_ty</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>tcHsSigType</span> <span class='hs-layout'>(</span><span class='hs-conid'>ForSigCtxt</span> <span class='hs-varid'>nm</span><span class='hs-layout'>)</span> <span class='hs-varid'>hs_ty</span>
<a name="line-9"></a>      <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> 
<a name="line-10"></a>          <span class='hs-comment'>-- Drop the foralls before inspecting the</span>
<a name="line-11"></a>          <span class='hs-comment'>-- structure of the foreign type.</span>
<a name="line-12"></a>	    <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>t_ty</span><span class='hs-layout'>)</span>	      <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcSplitForAllTys</span> <span class='hs-varid'>sig_ty</span>
<a name="line-13"></a>	    <span class='hs-layout'>(</span><span class='hs-varid'>arg_tys</span><span class='hs-layout'>,</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcSplitFunTys</span> <span class='hs-varid'>t_ty</span>
<a name="line-14"></a>	    <span class='hs-varid'>id</span>  	      <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkLocalId</span> <span class='hs-varid'>nm</span> <span class='hs-varid'>sig_ty</span>
<a name="line-15"></a> 		<span class='hs-comment'>-- Use a LocalId to obey the invariant that locally-defined </span>
<a name="line-16"></a>		<span class='hs-comment'>-- things are LocalIds.  However, it does not need zonking,</span>
<a name="line-17"></a>		<span class='hs-comment'>-- (so TcHsSyn.zonkForeignExports ignores it).</span>
<a name="line-18"></a>   
<a name="line-19"></a>      <span class='hs-layout'>;</span> <span class='hs-varid'>imp_decl'</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>tcCheckFIType</span> <span class='hs-varid'>sig_ty</span> <span class='hs-varid'>arg_tys</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>imp_decl</span>
<a name="line-20"></a>         <span class='hs-comment'>-- Can't use sig_ty here because sig_ty :: Type and </span>
<a name="line-21"></a>	 <span class='hs-comment'>-- we need HsType Id hence the undefined</span>
<a name="line-22"></a>      <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>id</span><span class='hs-layout'>,</span> <span class='hs-conid'>ForeignImport</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span> <span class='hs-varid'>undefined</span> <span class='hs-varid'>imp_decl'</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-23"></a><span class='hs-definition'>tcFImport</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcFImport"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>
</pre>\end{code}


------------ Checking types for foreign import ----------------------
\begin{code}
<pre><a name="line-1"></a><a name="tcCheckFIType"></a><span class='hs-definition'>tcCheckFIType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>ForeignImport</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>ForeignImport</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-definition'>tcCheckFIType</span> <span class='hs-varid'>sig_ty</span> <span class='hs-varid'>arg_tys</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>idecl</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>CImport</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>safety</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>CLabel</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-4"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span> <span class='hs-varid'>null</span> <span class='hs-varid'>arg_tys</span> <span class='hs-layout'>)</span>
<a name="line-5"></a>    <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>checkCg</span> <span class='hs-varid'>checkCOrAsmOrInterp</span>
<a name="line-6"></a>       <span class='hs-layout'>;</span> <span class='hs-varid'>checkSafety</span> <span class='hs-varid'>safety</span>
<a name="line-7"></a>       <span class='hs-layout'>;</span> <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-varid'>isFFILabelTy</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>illegalForeignTyErr</span> <span class='hs-varid'>empty</span> <span class='hs-varid'>sig_ty</span><span class='hs-layout'>)</span>
<a name="line-8"></a>       <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-varid'>idecl</span> <span class='hs-layout'>}</span>	     <span class='hs-comment'>-- NB check res_ty not sig_ty!</span>
<a name="line-9"></a>       	 	      	     <span class='hs-comment'>--    In case sig_ty is (forall a. ForeignPtr a)</span>
<a name="line-10"></a>
<a name="line-11"></a><span class='hs-definition'>tcCheckFIType</span> <span class='hs-varid'>sig_ty</span> <span class='hs-varid'>arg_tys</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>idecl</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>CImport</span> <span class='hs-varid'>cconv</span> <span class='hs-varid'>safety</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>CWrapper</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-12"></a>   	<span class='hs-comment'>-- Foreign wrapper (former f.e.d.)</span>
<a name="line-13"></a>   	<span class='hs-comment'>-- The type must be of the form ft -&gt; IO (FunPtr ft), where ft is a</span>
<a name="line-14"></a>   	<span class='hs-comment'>-- valid foreign type.  For legacy reasons ft -&gt; IO (Ptr ft) as well</span>
<a name="line-15"></a>   	<span class='hs-comment'>-- as ft -&gt; IO Addr is accepted, too.  The use of the latter two forms</span>
<a name="line-16"></a>   	<span class='hs-comment'>-- is DEPRECATED, though.</span>
<a name="line-17"></a>    <span class='hs-varid'>checkCg</span> <span class='hs-varid'>checkCOrAsmOrInterp</span>
<a name="line-18"></a>    <span class='hs-varid'>checkCConv</span> <span class='hs-varid'>cconv</span>
<a name="line-19"></a>    <span class='hs-varid'>checkSafety</span> <span class='hs-varid'>safety</span>
<a name="line-20"></a>    <span class='hs-keyword'>case</span> <span class='hs-varid'>arg_tys</span> <span class='hs-keyword'>of</span>
<a name="line-21"></a>        <span class='hs-keyglyph'>[</span><span class='hs-varid'>arg1_ty</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>checkForeignArgs</span> <span class='hs-varid'>isFFIExternalTy</span> <span class='hs-varid'>arg1_tys</span>
<a name="line-22"></a>                        <span class='hs-varid'>checkForeignRes</span> <span class='hs-varid'>nonIOok</span>  <span class='hs-varid'>isFFIExportResultTy</span> <span class='hs-varid'>res1_ty</span>
<a name="line-23"></a>                        <span class='hs-varid'>checkForeignRes</span> <span class='hs-varid'>mustBeIO</span> <span class='hs-varid'>isFFIDynResultTy</span>    <span class='hs-varid'>res_ty</span>
<a name="line-24"></a>                        <span class='hs-varid'>checkFEDArgs</span> <span class='hs-varid'>arg1_tys</span>
<a name="line-25"></a>                  <span class='hs-keyword'>where</span>
<a name="line-26"></a>                     <span class='hs-layout'>(</span><span class='hs-varid'>arg1_tys</span><span class='hs-layout'>,</span> <span class='hs-varid'>res1_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcSplitFunTys</span> <span class='hs-varid'>arg1_ty</span>
<a name="line-27"></a>        <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>addErrTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>illegalForeignTyErr</span> <span class='hs-varid'>empty</span> <span class='hs-varid'>sig_ty</span><span class='hs-layout'>)</span>
<a name="line-28"></a>    <span class='hs-varid'>return</span> <span class='hs-varid'>idecl</span>
<a name="line-29"></a>
<a name="line-30"></a><span class='hs-definition'>tcCheckFIType</span> <span class='hs-varid'>sig_ty</span> <span class='hs-varid'>arg_tys</span> <span class='hs-varid'>res_ty</span> <span class='hs-varid'>idecl</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>CImport</span> <span class='hs-varid'>cconv</span> <span class='hs-varid'>safety</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>CFunction</span> <span class='hs-varid'>target</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-31"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isDynamicTarget</span> <span class='hs-varid'>target</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-comment'>-- Foreign import dynamic</span>
<a name="line-32"></a>      <span class='hs-varid'>checkCg</span> <span class='hs-varid'>checkCOrAsmOrInterp</span>
<a name="line-33"></a>      <span class='hs-varid'>checkCConv</span> <span class='hs-varid'>cconv</span>
<a name="line-34"></a>      <span class='hs-varid'>checkSafety</span> <span class='hs-varid'>safety</span>
<a name="line-35"></a>      <span class='hs-keyword'>case</span> <span class='hs-varid'>arg_tys</span> <span class='hs-keyword'>of</span>           <span class='hs-comment'>-- The first arg must be Ptr, FunPtr, or Addr</span>
<a name="line-36"></a>        <span class='hs-conid'>[]</span>                <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyword'>do</span>
<a name="line-37"></a>          <span class='hs-varid'>check</span> <span class='hs-conid'>False</span> <span class='hs-layout'>(</span><span class='hs-varid'>illegalForeignTyErr</span> <span class='hs-varid'>empty</span> <span class='hs-varid'>sig_ty</span><span class='hs-layout'>)</span>
<a name="line-38"></a>          <span class='hs-varid'>return</span> <span class='hs-varid'>idecl</span>
<a name="line-39"></a>        <span class='hs-layout'>(</span><span class='hs-varid'>arg1_ty</span><span class='hs-conop'>:</span><span class='hs-varid'>arg_tys</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyword'>do</span>
<a name="line-40"></a>          <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>getDOpts</span>
<a name="line-41"></a>          <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-varid'>isFFIDynArgumentTy</span> <span class='hs-varid'>arg1_ty</span><span class='hs-layout'>)</span>
<a name="line-42"></a>                <span class='hs-layout'>(</span><span class='hs-varid'>illegalForeignTyErr</span> <span class='hs-varid'>argument</span> <span class='hs-varid'>arg1_ty</span><span class='hs-layout'>)</span>
<a name="line-43"></a>          <span class='hs-varid'>checkForeignArgs</span> <span class='hs-layout'>(</span><span class='hs-varid'>isFFIArgumentTy</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>safety</span><span class='hs-layout'>)</span> <span class='hs-varid'>arg_tys</span>
<a name="line-44"></a>          <span class='hs-varid'>checkForeignRes</span> <span class='hs-varid'>nonIOok</span> <span class='hs-layout'>(</span><span class='hs-varid'>isFFIImportResultTy</span> <span class='hs-varid'>dflags</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span>
<a name="line-45"></a>          <span class='hs-varid'>return</span> <span class='hs-varid'>idecl</span>
<a name="line-46"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>cconv</span> <span class='hs-varop'>==</span> <span class='hs-conid'>PrimCallConv</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-47"></a>      <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>getDOpts</span>
<a name="line-48"></a>      <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-varid'>dopt</span> <span class='hs-conid'>Opt_GHCForeignImportPrim</span> <span class='hs-varid'>dflags</span><span class='hs-layout'>)</span>
<a name="line-49"></a>            <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"Use -XGHCForeignImportPrim to allow `foreign import prim'."</span><span class='hs-layout'>)</span>
<a name="line-50"></a>      <span class='hs-varid'>checkCg</span> <span class='hs-layout'>(</span><span class='hs-varid'>checkCOrAsmOrDotNetOrInterp</span><span class='hs-layout'>)</span>
<a name="line-51"></a>      <span class='hs-varid'>checkCTarget</span> <span class='hs-varid'>target</span>
<a name="line-52"></a>      <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-varid'>playSafe</span> <span class='hs-varid'>safety</span><span class='hs-layout'>)</span>
<a name="line-53"></a>            <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"The safe/unsafe annotation should not be used with `foreign import prim'."</span><span class='hs-layout'>)</span>
<a name="line-54"></a>      <span class='hs-varid'>checkForeignArgs</span> <span class='hs-layout'>(</span><span class='hs-varid'>isFFIPrimArgumentTy</span> <span class='hs-varid'>dflags</span><span class='hs-layout'>)</span> <span class='hs-varid'>arg_tys</span>
<a name="line-55"></a>      <span class='hs-comment'>-- prim import result is more liberal, allows (#,,#)</span>
<a name="line-56"></a>      <span class='hs-varid'>checkForeignRes</span> <span class='hs-varid'>nonIOok</span> <span class='hs-layout'>(</span><span class='hs-varid'>isFFIPrimResultTy</span> <span class='hs-varid'>dflags</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span>
<a name="line-57"></a>      <span class='hs-varid'>return</span> <span class='hs-varid'>idecl</span>
<a name="line-58"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>              <span class='hs-comment'>-- Normal foreign import</span>
<a name="line-59"></a>      <span class='hs-varid'>checkCg</span> <span class='hs-layout'>(</span><span class='hs-varid'>checkCOrAsmOrDotNetOrInterp</span><span class='hs-layout'>)</span>
<a name="line-60"></a>      <span class='hs-varid'>checkCConv</span> <span class='hs-varid'>cconv</span>
<a name="line-61"></a>      <span class='hs-varid'>checkSafety</span> <span class='hs-varid'>safety</span>
<a name="line-62"></a>      <span class='hs-varid'>checkCTarget</span> <span class='hs-varid'>target</span>
<a name="line-63"></a>      <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>getDOpts</span>
<a name="line-64"></a>      <span class='hs-varid'>checkForeignArgs</span> <span class='hs-layout'>(</span><span class='hs-varid'>isFFIArgumentTy</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>safety</span><span class='hs-layout'>)</span> <span class='hs-varid'>arg_tys</span>
<a name="line-65"></a>      <span class='hs-varid'>checkForeignRes</span> <span class='hs-varid'>nonIOok</span> <span class='hs-layout'>(</span><span class='hs-varid'>isFFIImportResultTy</span> <span class='hs-varid'>dflags</span><span class='hs-layout'>)</span> <span class='hs-varid'>res_ty</span>
<a name="line-66"></a>      <span class='hs-varid'>checkMissingAmpersand</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>arg_tys</span> <span class='hs-varid'>res_ty</span>
<a name="line-67"></a>      <span class='hs-varid'>return</span> <span class='hs-varid'>idecl</span>
<a name="line-68"></a>
<a name="line-69"></a><a name="checkCTarget"></a><span class='hs-comment'>-- This makes a convenient place to check</span>
<a name="line-70"></a><span class='hs-comment'>-- that the C identifier is valid for C</span>
<a name="line-71"></a><span class='hs-definition'>checkCTarget</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CCallTarget</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-72"></a><span class='hs-definition'>checkCTarget</span> <span class='hs-layout'>(</span><span class='hs-conid'>StaticTarget</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-73"></a>    <span class='hs-varid'>checkCg</span> <span class='hs-varid'>checkCOrAsmOrDotNetOrInterp</span>
<a name="line-74"></a>    <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-varid'>isCLabelString</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>badCName</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span>
<a name="line-75"></a><span class='hs-definition'>checkCTarget</span> <span class='hs-conid'>DynamicTarget</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"checkCTarget DynamicTarget"</span>
<a name="line-76"></a>
<a name="line-77"></a><a name="checkMissingAmpersand"></a><span class='hs-definition'>checkMissingAmpersand</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DynFlags</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-78"></a><span class='hs-definition'>checkMissingAmpersand</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>arg_tys</span> <span class='hs-varid'>res_ty</span>
<a name="line-79"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>null</span> <span class='hs-varid'>arg_tys</span> <span class='hs-varop'>&amp;&amp;</span> <span class='hs-varid'>isFunPtrTy</span> <span class='hs-varid'>res_ty</span> <span class='hs-varop'>&amp;&amp;</span>
<a name="line-80"></a>    <span class='hs-varid'>dopt</span> <span class='hs-conid'>Opt_WarnDodgyForeignImports</span> <span class='hs-varid'>dflags</span>
<a name="line-81"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addWarn</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'>"possible missing &amp; in foreign import of FunPtr"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-82"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-83"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
</pre>\end{code}

On an Alpha, with foreign export dynamic, due to a giant hack when
building adjustor thunks, we only allow 4 integer arguments with
foreign export dynamic (i.e., 32 bytes of arguments after padding each
argument to a quadword, excluding floating-point arguments).

The check is needed for both via-C and native-code routes

\begin{code}
<pre><a name="line-1"></a><span class='hs-cpp'>#</span><span class='hs-varid'>include</span> <span class='hs-str'>"nativeGen/NCG.h"</span>
<a name="line-2"></a>
<a name="line-3"></a><a name="checkFEDArgs"></a><span class='hs-definition'>checkFEDArgs</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'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-4"></a><span class='hs-cpp'>#if alpha_TARGET_ARCH</span>
<a name="line-5"></a><span class='hs-definition'>checkFEDArgs</span> <span class='hs-varid'>arg_tys</span>
<a name="line-6"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-varid'>integral_args</span> <span class='hs-varop'>&lt;=</span> <span class='hs-num'>32</span><span class='hs-layout'>)</span> <span class='hs-varid'>err</span>
<a name="line-7"></a>  <span class='hs-keyword'>where</span>
<a name="line-8"></a>    <span class='hs-varid'>integral_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sum</span> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-varid'>widthInBytes</span> <span class='hs-varop'>.</span> <span class='hs-varid'>argMachRep</span> <span class='hs-varop'>.</span> <span class='hs-varid'>primRepToCgRep</span><span class='hs-layout'>)</span> <span class='hs-varid'>prim_rep</span>
<a name="line-9"></a>			<span class='hs-keyglyph'>|</span> <span class='hs-varid'>prim_rep</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>map</span> <span class='hs-varid'>typePrimRep</span> <span class='hs-varid'>arg_tys</span><span class='hs-layout'>,</span>
<a name="line-10"></a>			  <span class='hs-varid'>primRepHint</span> <span class='hs-varid'>prim_rep</span> <span class='hs-varop'>/=</span> <span class='hs-conid'>FloatHint</span> <span class='hs-keyglyph'>]</span>
<a name="line-11"></a>    <span class='hs-varid'>err</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'>"On Alpha, I can only handle 32 bytes of non-floating-point arguments to foreign export dynamic"</span><span class='hs-layout'>)</span>
<a name="line-12"></a><span class='hs-cpp'>#else</span>
<a name="line-13"></a><span class='hs-definition'>checkFEDArgs</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-14"></a><span class='hs-cpp'>#endif</span>
</pre>\end{code}


%************************************************************************
%*									*
\subsection{Exports}
%*									*
%************************************************************************

\begin{code}
<pre><a name="line-1"></a><a name="tcForeignExports"></a><span class='hs-definition'>tcForeignExports</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LForeignDecl</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> 
<a name="line-2"></a>    		 <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>LHsBinds</span> <span class='hs-conid'>TcId</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>LForeignDecl</span> <span class='hs-conid'>TcId</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-3"></a><span class='hs-definition'>tcForeignExports</span> <span class='hs-varid'>decls</span>
<a name="line-4"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldlM</span> <span class='hs-varid'>combine</span> <span class='hs-layout'>(</span><span class='hs-varid'>emptyLHsBinds</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>filter</span> <span class='hs-varid'>isForeignExport</span> <span class='hs-varid'>decls</span><span class='hs-layout'>)</span>
<a name="line-5"></a>  <span class='hs-keyword'>where</span>
<a name="line-6"></a>   <span class='hs-varid'>combine</span> <span class='hs-layout'>(</span><span class='hs-varid'>binds</span><span class='hs-layout'>,</span> <span class='hs-varid'>fs</span><span class='hs-layout'>)</span> <span class='hs-varid'>fe</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-7"></a>       <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>wrapLocSndM</span> <span class='hs-varid'>tcFExport</span> <span class='hs-varid'>fe</span>
<a name="line-8"></a>       <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span> <span class='hs-varop'>`consBag`</span> <span class='hs-varid'>binds</span><span class='hs-layout'>,</span> <span class='hs-varid'>f</span><span class='hs-conop'>:</span><span class='hs-varid'>fs</span><span class='hs-layout'>)</span>
<a name="line-9"></a>
<a name="line-10"></a><a name="tcFExport"></a><span class='hs-definition'>tcFExport</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ForeignDecl</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-layout'>(</span><span class='hs-conid'>LHsBind</span> <span class='hs-conid'>Id</span><span class='hs-layout'>,</span> <span class='hs-conid'>ForeignDecl</span> <span class='hs-conid'>Id</span><span class='hs-layout'>)</span>
<a name="line-11"></a><span class='hs-definition'>tcFExport</span> <span class='hs-varid'>fo</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>ForeignExport</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>nm</span><span class='hs-layout'>)</span> <span class='hs-varid'>hs_ty</span> <span class='hs-varid'>spec</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-12"></a>   <span class='hs-varid'>addErrCtxt</span> <span class='hs-layout'>(</span><span class='hs-varid'>foreignDeclCtxt</span> <span class='hs-varid'>fo</span><span class='hs-layout'>)</span>      <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-13"></a>
<a name="line-14"></a>   <span class='hs-varid'>sig_ty</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>tcHsSigType</span> <span class='hs-layout'>(</span><span class='hs-conid'>ForSigCtxt</span> <span class='hs-varid'>nm</span><span class='hs-layout'>)</span> <span class='hs-varid'>hs_ty</span>
<a name="line-15"></a>   <span class='hs-varid'>rhs</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>tcPolyExpr</span> <span class='hs-layout'>(</span><span class='hs-varid'>nlHsVar</span> <span class='hs-varid'>nm</span><span class='hs-layout'>)</span> <span class='hs-varid'>sig_ty</span>
<a name="line-16"></a>
<a name="line-17"></a>   <span class='hs-varid'>tcCheckFEType</span> <span class='hs-varid'>sig_ty</span> <span class='hs-varid'>spec</span>
<a name="line-18"></a>
<a name="line-19"></a>	  <span class='hs-comment'>-- we're exporting a function, but at a type possibly more</span>
<a name="line-20"></a>	  <span class='hs-comment'>-- constrained than its declared/inferred type. Hence the need</span>
<a name="line-21"></a>	  <span class='hs-comment'>-- to create a local binding which will call the exported function</span>
<a name="line-22"></a>	  <span class='hs-comment'>-- at a particular type (and, maybe, overloading).</span>
<a name="line-23"></a>
<a name="line-24"></a>
<a name="line-25"></a>   <span class='hs-comment'>-- We need to give a name to the new top-level binding that</span>
<a name="line-26"></a>   <span class='hs-comment'>-- is *stable* (i.e. the compiler won't change it later),</span>
<a name="line-27"></a>   <span class='hs-comment'>-- because this name will be referred to by the C code stub.</span>
<a name="line-28"></a>   <span class='hs-varid'>id</span>  <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>mkStableIdFromName</span> <span class='hs-varid'>nm</span> <span class='hs-varid'>sig_ty</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>mkForeignExportOcc</span>
<a name="line-29"></a>   <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-layout'>(</span><span class='hs-conid'>VarBind</span> <span class='hs-varid'>id</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>ForeignExport</span> <span class='hs-layout'>(</span><span class='hs-conid'>L</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span> <span class='hs-varid'>undefined</span> <span class='hs-varid'>spec</span><span class='hs-layout'>)</span>
<a name="line-30"></a><span class='hs-definition'>tcFExport</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"tcFExport"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>
</pre>\end{code}

------------ Checking argument types for foreign export ----------------------

\begin{code}
<pre><a name="line-1"></a><a name="tcCheckFEType"></a><span class='hs-definition'>tcCheckFEType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>ForeignExport</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-2"></a><span class='hs-definition'>tcCheckFEType</span> <span class='hs-varid'>sig_ty</span> <span class='hs-layout'>(</span><span class='hs-conid'>CExport</span> <span class='hs-layout'>(</span><span class='hs-conid'>CExportStatic</span> <span class='hs-varid'>str</span> <span class='hs-varid'>cconv</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-3"></a>    <span class='hs-varid'>checkCg</span> <span class='hs-varid'>checkCOrAsm</span>
<a name="line-4"></a>    <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-varid'>isCLabelString</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>badCName</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span>
<a name="line-5"></a>    <span class='hs-varid'>checkCConv</span> <span class='hs-varid'>cconv</span>
<a name="line-6"></a>    <span class='hs-varid'>checkForeignArgs</span> <span class='hs-varid'>isFFIExternalTy</span> <span class='hs-varid'>arg_tys</span>
<a name="line-7"></a>    <span class='hs-varid'>checkForeignRes</span> <span class='hs-varid'>nonIOok</span> <span class='hs-varid'>isFFIExportResultTy</span> <span class='hs-varid'>res_ty</span>
<a name="line-8"></a>  <span class='hs-keyword'>where</span>
<a name="line-9"></a>      <span class='hs-comment'>-- Drop the foralls before inspecting n</span>
<a name="line-10"></a>      <span class='hs-comment'>-- the structure of the foreign type.</span>
<a name="line-11"></a>    <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>t_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcSplitForAllTys</span> <span class='hs-varid'>sig_ty</span>
<a name="line-12"></a>    <span class='hs-layout'>(</span><span class='hs-varid'>arg_tys</span><span class='hs-layout'>,</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tcSplitFunTys</span> <span class='hs-varid'>t_ty</span>
</pre>\end{code}



%************************************************************************
%*									*
\subsection{Miscellaneous}
%*									*
%************************************************************************

\begin{code}
<pre><a name="line-1"></a><a name="checkForeignArgs"></a><span class='hs-comment'>------------ Checking argument types for foreign import ----------------------</span>
<a name="line-2"></a><span class='hs-definition'>checkForeignArgs</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-3"></a><span class='hs-definition'>checkForeignArgs</span> <span class='hs-varid'>pred</span> <span class='hs-varid'>tys</span>
<a name="line-4"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapM_</span> <span class='hs-varid'>go</span> <span class='hs-varid'>tys</span>
<a name="line-5"></a>  <span class='hs-keyword'>where</span>
<a name="line-6"></a>    <span class='hs-varid'>go</span> <span class='hs-varid'>ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-varid'>pred</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>illegalForeignTyErr</span> <span class='hs-varid'>argument</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-7"></a>
<a name="line-8"></a><a name="checkForeignRes"></a><span class='hs-comment'>------------ Checking result types for foreign calls ----------------------</span>
<a name="line-9"></a><span class='hs-comment'>-- Check that the type has the form </span>
<a name="line-10"></a><span class='hs-comment'>--    (IO t) or (t) , and that t satisfies the given predicate.</span>
<a name="line-11"></a><span class='hs-comment'>--</span>
<a name="line-12"></a><span class='hs-definition'>checkForeignRes</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-13"></a>
<a name="line-14"></a><a name="nonIOok"></a><span class='hs-definition'>nonIOok</span><span class='hs-layout'>,</span> <span class='hs-varid'>mustBeIO</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span>
<a name="line-15"></a><span class='hs-definition'>nonIOok</span>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-16"></a><a name="mustBeIO"></a><span class='hs-definition'>mustBeIO</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-17"></a>
<a name="line-18"></a><span class='hs-definition'>checkForeignRes</span> <span class='hs-varid'>non_io_result_ok</span> <span class='hs-varid'>pred_res_ty</span> <span class='hs-varid'>ty</span>
<a name="line-19"></a>	<span class='hs-comment'>-- (IO t) is ok, and so is any newtype wrapping thereof</span>
<a name="line-20"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>res_ty</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>tcSplitIOType_maybe</span> <span class='hs-varid'>ty</span><span class='hs-layout'>,</span>
<a name="line-21"></a>    <span class='hs-varid'>pred_res_ty</span> <span class='hs-varid'>res_ty</span>
<a name="line-22"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-23"></a> 
<a name="line-24"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-25"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>check</span> <span class='hs-layout'>(</span><span class='hs-varid'>non_io_result_ok</span> <span class='hs-varop'>&amp;&amp;</span> <span class='hs-varid'>pred_res_ty</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> 
<a name="line-26"></a>	  <span class='hs-layout'>(</span><span class='hs-varid'>illegalForeignTyErr</span> <span class='hs-varid'>result</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
</pre>\end{code}

\begin{code}
<pre><a name="line-1"></a><a name="checkCOrAsm"></a><span class='hs-definition'>checkCOrAsm</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HscTarget</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>SDoc</span>
<a name="line-2"></a><span class='hs-definition'>checkCOrAsm</span> <span class='hs-conid'>HscC</span>   <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-3"></a><span class='hs-definition'>checkCOrAsm</span> <span class='hs-conid'>HscAsm</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-4"></a><span class='hs-definition'>checkCOrAsm</span> <span class='hs-keyword'>_</span>
<a name="line-5"></a>   <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"requires via-C or native code generation (-fvia-C)"</span><span class='hs-layout'>)</span>
<a name="line-6"></a>
<a name="line-7"></a><a name="checkCOrAsmOrInterp"></a><span class='hs-definition'>checkCOrAsmOrInterp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HscTarget</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>SDoc</span>
<a name="line-8"></a><span class='hs-definition'>checkCOrAsmOrInterp</span> <span class='hs-conid'>HscC</span>           <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-9"></a><span class='hs-definition'>checkCOrAsmOrInterp</span> <span class='hs-conid'>HscAsm</span>         <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-10"></a><span class='hs-definition'>checkCOrAsmOrInterp</span> <span class='hs-conid'>HscInterpreted</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-11"></a><span class='hs-definition'>checkCOrAsmOrInterp</span> <span class='hs-keyword'>_</span>
<a name="line-12"></a>   <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"requires interpreted, C or native code generation"</span><span class='hs-layout'>)</span>
<a name="line-13"></a>
<a name="line-14"></a><a name="checkCOrAsmOrDotNetOrInterp"></a><span class='hs-definition'>checkCOrAsmOrDotNetOrInterp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HscTarget</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>SDoc</span>
<a name="line-15"></a><span class='hs-definition'>checkCOrAsmOrDotNetOrInterp</span> <span class='hs-conid'>HscC</span>           <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-16"></a><span class='hs-definition'>checkCOrAsmOrDotNetOrInterp</span> <span class='hs-conid'>HscAsm</span>         <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-17"></a><span class='hs-definition'>checkCOrAsmOrDotNetOrInterp</span> <span class='hs-conid'>HscInterpreted</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-18"></a><span class='hs-definition'>checkCOrAsmOrDotNetOrInterp</span> <span class='hs-keyword'>_</span>
<a name="line-19"></a>   <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"requires interpreted, C or native code generation"</span><span class='hs-layout'>)</span>
<a name="line-20"></a>
<a name="line-21"></a><a name="checkCg"></a><span class='hs-definition'>checkCg</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>HscTarget</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>SDoc</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-22"></a><span class='hs-definition'>checkCg</span> <span class='hs-varid'>check</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-23"></a>   <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>getDOpts</span>
<a name="line-24"></a>   <span class='hs-keyword'>let</span> <span class='hs-varid'>target</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hscTarget</span> <span class='hs-varid'>dflags</span>
<a name="line-25"></a>   <span class='hs-keyword'>case</span> <span class='hs-varid'>target</span> <span class='hs-keyword'>of</span>
<a name="line-26"></a>     <span class='hs-conid'>HscNothing</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-27"></a>     <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-&gt;</span>
<a name="line-28"></a>       <span class='hs-keyword'>case</span> <span class='hs-varid'>check</span> <span class='hs-varid'>target</span> <span class='hs-keyword'>of</span>
<a name="line-29"></a>	 <span class='hs-conid'>Nothing</span>  <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-30"></a>	 <span class='hs-conid'>Just</span> <span class='hs-varid'>err</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>addErrTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"Illegal foreign declaration:"</span> <span class='hs-varop'>&lt;+&gt;</span> <span class='hs-varid'>err</span><span class='hs-layout'>)</span>
</pre>\end{code}
			   
Calling conventions

\begin{code}
<pre><a name="line-1"></a><a name="checkCConv"></a><span class='hs-definition'>checkCConv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CCallConv</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-2"></a><span class='hs-definition'>checkCConv</span> <span class='hs-conid'>CCallConv</span>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-3"></a><span class='hs-cpp'>#if i386_TARGET_ARCH</span>
<a name="line-4"></a><span class='hs-definition'>checkCConv</span> <span class='hs-conid'>StdCallConv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-5"></a><span class='hs-cpp'>#else</span>
<a name="line-6"></a><span class='hs-definition'>checkCConv</span> <span class='hs-conid'>StdCallConv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addErrTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"calling convention not supported on this platform: stdcall"</span><span class='hs-layout'>)</span>
<a name="line-7"></a><span class='hs-cpp'>#endif</span>
<a name="line-8"></a><span class='hs-definition'>checkCConv</span> <span class='hs-conid'>PrimCallConv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addErrTc</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"The `prim' calling convention can only be used with `foreign import'"</span><span class='hs-layout'>)</span>
<a name="line-9"></a><span class='hs-definition'>checkCConv</span> <span class='hs-conid'>CmmCallConv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"checkCConv CmmCallConv"</span>
</pre>\end{code}

Deprecated "threadsafe" calls

\begin{code}
<pre><a name="line-1"></a><a name="checkSafety"></a><span class='hs-definition'>checkSafety</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Safety</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-2"></a><span class='hs-definition'>checkSafety</span> <span class='hs-layout'>(</span><span class='hs-conid'>PlaySafe</span> <span class='hs-conid'>True</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addWarn</span> <span class='hs-layout'>(</span><span class='hs-varid'>text</span> <span class='hs-str'>"The `threadsafe' foreign import style is deprecated. Use `safe' instead."</span><span class='hs-layout'>)</span>
<a name="line-3"></a><span class='hs-definition'>checkSafety</span> <span class='hs-keyword'>_</span>               <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
</pre>\end{code}

Warnings

\begin{code}
<pre><a name="line-1"></a><a name="check"></a><span class='hs-definition'>check</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Message</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-2"></a><span class='hs-definition'>check</span> <span class='hs-conid'>True</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-3"></a><span class='hs-definition'>check</span> <span class='hs-keyword'>_</span>    <span class='hs-varid'>the_err</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addErrTc</span> <span class='hs-varid'>the_err</span>
<a name="line-4"></a>
<a name="line-5"></a><a name="illegalForeignTyErr"></a><span class='hs-definition'>illegalForeignTyErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SDoc</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Type</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>SDoc</span>
<a name="line-6"></a><span class='hs-definition'>illegalForeignTyErr</span> <span class='hs-varid'>arg_or_res</span> <span class='hs-varid'>ty</span>
<a name="line-7"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hang</span> <span class='hs-layout'>(</span><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'>"Unacceptable"</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>arg_or_res</span><span class='hs-layout'>,</span> 
<a name="line-8"></a>                <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"type in foreign declaration:"</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-9"></a>	 <span class='hs-num'>4</span> <span class='hs-layout'>(</span><span class='hs-varid'>hsep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>ty</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-10"></a>
<a name="line-11"></a><a name="argument"></a><span class='hs-comment'>-- Used for 'arg_or_res' argument to illegalForeignTyErr</span>
<a name="line-12"></a><span class='hs-definition'>argument</span><span class='hs-layout'>,</span> <span class='hs-varid'>result</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SDoc</span>
<a name="line-13"></a><span class='hs-definition'>argument</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-str'>"argument"</span>
<a name="line-14"></a><a name="result"></a><span class='hs-definition'>result</span>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>text</span> <span class='hs-str'>"result"</span>
<a name="line-15"></a>
<a name="line-16"></a><a name="badCName"></a><span class='hs-definition'>badCName</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CLabelString</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Message</span>
<a name="line-17"></a><span class='hs-definition'>badCName</span> <span class='hs-varid'>target</span> 
<a name="line-18"></a>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sep</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'>target</span><span class='hs-layout'>)</span> <span class='hs-varop'>&lt;+&gt;</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"is not a valid C identifier"</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-19"></a>
<a name="line-20"></a><a name="foreignDeclCtxt"></a><span class='hs-definition'>foreignDeclCtxt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ForeignDecl</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>SDoc</span>
<a name="line-21"></a><span class='hs-definition'>foreignDeclCtxt</span> <span class='hs-varid'>fo</span>
<a name="line-22"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hang</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'>"When checking declaration:"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-23"></a>         <span class='hs-num'>4</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>fo</span><span class='hs-layout'>)</span>
</pre>\end{code}

</body>
</html>