</sect1>
-->
- <sect1 id="hs2c">
+ <sect1 id="hsc2hs">
<title>Writing Haskell interfaces to C code:
- <command>hs2c</command></title>
- <indexterm><primary><command>hs2c</command></primary>
+ <command>hsc2hs</command></title>
+ <indexterm><primary><command>hsc2hs</command></primary>
</indexterm>
- <para>The <command>hs2c</command> command can be used to automate
+ <para>The <command>hsc2hs</command> command can be used to automate
some parts of the process of writing Haskell bindings to C code.
It reads an almost-Haskell source with embedded special
constructs, and outputs a real Haskell file with these constructs
two files are created when the <literal>#def</literal> construct
is used.</para>
- <para>Actually <command>hs2c</command> does not output the Haskell
+ <para>Actually <command>hsc2hs</command> does not output the Haskell
file directly. It creates a C program that includes the headers,
gets automatically compiled and run. That program outputs the
Haskell code.</para>
<term><literal>#include "file.h"</literal></term>
<listitem>
<para>The specified file gets included into the C program,
- the compiled Haskell file, and the C
- header. <literal><HsFFI.h></literal> is included
+ the compiled Haskell file, and the C header.
+ <literal><HsFFI.h></literal> is included
automatically.</para>
</listitem>
</varlistentry>
<varlistentry>
<term><literal>#define name</literal></term>
<term><literal>#define name value</literal></term>
+ <term><literal>#undef name</literal></term>
<listitem>
<para>Similar to <literal>#include</literal>. Note that
<literal>#includes</literal> and
</varlistentry>
<varlistentry>
+ <term><literal>#let name parameters = "definition"</literal></term>
+ <listitem>
+ <para>Defines a macro to be applied to the Haskell
+ source. Parameter names are comma-separated, not
+ inside parens. Such macro is invoked as other
+ <literal>#</literal>-constructs, starting with
+ <literal>#name</literal>. The definition will be
+ put in the C program inside parens as arguments of
+ <literal>printf</literal>. To refer to a parameter,
+ close the quote, put a parameter name and open the
+ quote again, to let C string literals concatenate.
+ Or use <literal>printf</literal>'s format directives.
+ Values of arguments must be given as strings, unless the
+ macro stringifies them itself using the C preprocessor's
+ <literal>#parameter</literal> syntax.</para>
+ </listitem>
+ </varlistentry>
+
+ <varlistentry>
<term><literal>#option opt</literal></term>
<listitem>
<para>The specified Haskell compiler command-line option
<term><literal>#elif condition</literal></term>
<term><literal>#else</literal></term>
<term><literal>#endif</literal></term>
+ <term><literal>#error message</literal></term>
<listitem>
<para>Conditional compilation directives are passed
unmodified to the C program, C file, and C header. Putting
<para><literal>#const</literal>, <literal>#type</literal>,
<literal>#peek</literal>, <literal>#poke</literal> and
<literal>#ptr</literal> are not hardwired into the
- <command>hs2c</command>, but are defined in a C template that is
+ <command>hsc2hs</command>, but are defined in a C template that is
included in the C program: <filename>template-hsc.h</filename>.
Custom constructs and templates can be used too. Any
<literal>#</literal>-construct with unknown key is expected to
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.2 2000/11/07 15:28:36 simonmar Exp $
+-- $Id: Main.hs,v 1.3 2000/12/28 10:34:56 qrczak Exp $
--
-- (originally "GlueHsc.hs" by Marcin 'Qrczak' Kowalczyk)
--
import Parsec
import Monad (liftM, liftM2, when)
import Char (ord, intToDigit, isSpace, isAlphaNum, toUpper)
+import List (intersperse)
data Flag
= Help
specials = [(key, arg) | Special key arg <- toks]
- needsC = any (\(key, _) -> key=="def") specials
+ needsC = any (\(key, _) -> key == "def") specials
needsH = needsC
includeGuard = map fixChar outHName
when needsH $ writeFile outHName $
"#ifndef "++includeGuard++"\n\
\#define "++includeGuard++"\n\
+ \#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409\n\
+ \#include <Rts.h>\n\
+ \#endif\n\
\#include <HsFFI.h>\n"++
concatMap outTokenH specials++
"#endif\n"
outHeaderCProg = concatMap $ \(key, arg) -> case key of
"include" -> "#include "++arg++"\n"
"define" -> "#define "++arg++"\n"
+ "undef" -> "#undef "++arg++"\n"
"def" -> case arg of
's':'t':'r':'u':'c':'t':' ':_ -> arg++"\n"
't':'y':'p':'e':'d':'e':'f':' ':_ -> arg++"\n"
_ -> ""
_ | conditional key -> "#"++key++" "++arg++"\n"
- _ -> ""
+ "let" -> case break (== '=') arg of
+ (_, "") -> ""
+ (header, _:body) -> case break isSpace header of
+ (name, args) ->
+ "#define hsc_"++name++"("++dropWhile isSpace args++") \
+ \printf ("++joinLines body++");\n"
+ _ -> ""
+ where
+ joinLines = concat . intersperse " \\\n" . lines
outHeaderHs :: Maybe String -> [(String, String)] -> String
outHeaderHs inH toks =
+ " hsc_begin_options();\n"++
concatMap outSpecial toks ++
includeH ++
" hsc_end_options();\n\n"
where
outSpecial (key, arg) = case key of
"include" -> case inH of
- Nothing -> out ("-#include "++arg)
+ Nothing -> outOption ("-#include "++arg)
Just _ -> ""
"define" -> case inH of
- Nothing -> out ("-optc-D"++toOptD arg)
- Just _ -> ""
- "option" -> out arg
+ Nothing | goodForOptD arg -> outOption ("-optc-D"++toOptD arg)
+ _ -> ""
+ "option" -> outOption arg
_ | conditional key -> "#"++key++" "++arg++"\n"
_ -> ""
+ goodForOptD arg = case arg of
+ "" -> True
+ c:_ | isSpace c -> True
+ '(':_ -> False
+ _:s -> goodForOptD s
toOptD arg = case break isSpace arg of
(name, "") -> name
(name, _:value) -> name++'=':dropWhile isSpace value
includeH = case inH of
Nothing -> ""
- Just name -> out ("-#include \""++name++"\"")
- out s = " hsc_option (\""++showCString s++"\");\n"
+ Just name -> outOption ("-#include \""++name++"\"")
+ outOption s = " hsc_option (\""++showCString s++"\");\n"
outTokenHs :: Token -> String
outTokenHs (Text s) = " fputs (\""++showCString s++"\", stdout);\n"
outTokenHs (Special key arg) = case key of
"include" -> ""
"define" -> ""
+ "undef" -> ""
"option" -> ""
"def" -> ""
_ | conditional key -> "#"++key++" "++arg++"\n"
+ "let" -> ""
_ -> " hsc_"++key++" ("++arg++");\n"
outTokenH :: (String, String) -> String
outTokenH (key, arg) = case key of
"include" -> "#include "++arg++"\n"
- "define" -> "#define " ++arg++"\n"
- "def" -> case arg of
+ "define" -> "#define " ++arg++"\n"
+ "undef" -> "#undef " ++arg++"\n"
+ "def" -> case arg of
's':'t':'r':'u':'c':'t':' ':_ -> arg++"\n"
't':'y':'p':'e':'d':'e':'f':' ':_ -> arg++"\n"
'i':'n':'l':'i':'n':'e':' ':_ ->
conditional "elif" = True
conditional "else" = True
conditional "endif" = True
+conditional "error" = True
conditional _ = False
showCString :: String -> String
+
+for arg; do
+ case "$arg" in
+ (--cc=*) HSC2HS_EXTRA=;;
+ (--) break;;
+ esac
+done
+
$HSC2HS_DIR/$HS_PROG -t $HSC2HS_DIR/template-hsc.h $HSC2HS_EXTRA "$@"
+#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409
+#include <Rts.h>
+#endif
#include <HsFFI.h>
+
#include <stddef.h>
#include <string.h>
#include <stdio.h>
#define offsetof(t, f) ((size_t) &((t *)0)->f)
#endif
-static int hsc_options_started = 0;
+#if __GLASGOW_HASKELL__
+static int hsc_options_started;
+
+static void hsc_begin_options (void)
+{
+#if __GLASGOW_HASKELL__ < 409
+ printf ("{-# OPTIONS -optc-D__GLASGOW_HASKELL__=%d", __GLASGOW_HASKELL__);
+ hsc_options_started = 1;
+#else
+ hsc_options_started = 0;
+#endif
+}
static void hsc_option (const char *s)
{
{
if (hsc_options_started) printf (" #-}\n");
}
+#else
+#define hsc_begin_options()
+#define hsc_option(s)
+#define hsc_end_options()
+#endif
#define hsc_const(x) \
if ((x) < 0) \
projects / ghc-hetmet.git / commitdiff