jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Chicken: a few bug fixes, a new example and some new test suite runme, and some doc updates

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@7143 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
John Lenz 2005-04-05 17:48:31 +00:00
commit 7e55b36764
19 changed files with 435 additions and 180 deletions
Download patch file Download diff file Expand all files Collapse all files

11
CHANGES.current
View file

@ -1,6 +1,17 @@
Version 1.3.25 (In progress)
============================
04/05/2005: wuzzeb (John Lenz)
[Chicken]
+ Added Examples/chicken/egg, an example on how to build a chicken
extension library in the form of an egg. Also updated the
documentation on the different linking options.
+ chicken test-suite now has support to check SWIG with the -proxy
argument if there exists a _proxy_runme.ss file.
+ More fixes for overloaded functions and -proxy
03/31/2005: wsfulton
Turned on extra template features for all languages which were
previously only available to Python.

186
Doc/Manual/Chicken.html
View file

@ -104,11 +104,14 @@
generation improvements, part of the wrapper is direct CHICKEN
function calls (<tt>example_wrap.c</tt>) and part is CHICKEN
Scheme (<tt>example.scm</tt>). The basic Scheme code must
be compiled to C using your system's CHICKEN compiler.
be compiled to C using your system's CHICKEN compiler or
both files can be compiled directly using the much simpler <tt>csc</tt>.
</p>
<div class="shell">
<pre>% chicken example.scm -output-file oexample.c</pre>
<pre>
% chicken example.scm -output-file oexample.c
</pre>
</div>
<p>
@ -132,7 +135,8 @@
<p>
This will generate <tt>example_wrap.cxx</tt> and
<tt>example.scm</tt>. The basic Scheme code must be
compiled to C using your system's CHICKEN compiler.
compiled to C using your system's CHICKEN compiler or
both files can be compiled directly using the much simpler <tt>csc</tt>.
</p>
<div class="shell">
@ -317,21 +321,7 @@
</p>
<H2><a name="Chicken_nn12"></a>17.4 Compilation</H2>
<p>
Please refer to <em>CHICKEN - A practical and portable Scheme
system - User's manual</em> for detailed help on how to compile
C code for use in a CHICKEN program. Briefly, to compile C
code, be sure to add <tt>`chicken-config -cflags`</tt> or
<tt>`chicken-config -shared -cflags`</tt> to your compiler
options. Use the <tt>-shared</tt> option if you want to create
a dynamically loadable module. You might also want to use the
much simpler <tt>csc</tt> or <tt>csc.bat</tt>.
</p>
<H2><a name="Chicken_nn13"></a>17.5 Linkage</H2>
<H2><a name="Chicken_nn12"></a>17.4 Linkage</H2>
<p>
@ -342,51 +332,139 @@
-extra-libs -libs`</tt> or <tt>`chicken-config -shared
-extra-libs -libs`</tt>to your linker options. Use the
<tt>-shared</tt> option if you want to create a dynamically
loadable module.
loadable module. You might also want to use the much simpler
<tt>csc</tt> or <tt>csc.bat</tt>.
</p>
<H3><a name="Chicken_nn14"></a>17.5.1 Shared library</H3>
<p>Each scheme file that is generated
by SWIG contains <code>(declare (uses <i>modname</i>))</code>. This means that to load the
module from scheme code, the code must include <code>(declare (uses <i>modname</i>))</code>.
</p>
<p>
The easiest way to use SWIG and CHICKEN is to use the csc compiler
wrapper provided by CHICKEN. Assume you have a SWIG interface file
in example.i and the C functions being wrapped are in example_impl.c.
</p>
<H3><a name="Chicken_nn13"></a>17.4.1 Static binary or shared library linked at compile time</H3>
<p>We can easily use csc to build a static binary.</p>
<div class="shell">
<pre>
$ swig -chicken example.i
$ csc -svk example.scm example_impl.c example_wrap.c
$ csi example.so test_script.scm
</pre>
</div>
<p>
You must be careful not to name the example_impl.c file example.c because
when compiling example.scm, csc compiles that into example.c!
</p>
<p>
The test_script.scm should have <code>(load-library 'example "example.so")</code>
and <code>(declare (uses example))</code>. As well, the path to example.so should
be accessable to the loader. You might need to set LD_LIBRARY_PATH.
</p>
<H3><a name="Chicken_nn15"></a>17.5.2 Static binary</H3>
<p>Again, we can easily use csc to build a binary.</p>
<div class="shell">
<pre>
$ swig -chicken example.i
$ csc -vk example.scm example_impl.c example_wrap.c test_script.scm -o example
$ csc -v example.scm example_impl.c example_wrap.c test_script.scm -o example
$ ./example
</pre>
</div>
<H2><a name="Chicken_nn16"></a>17.6 Typemaps</H2>
<p>Similar to the above, any number of <tt>module.scm</tt> files could be compiled
into a shared library, and then that shared library linked when compiling the
main application.</p>
<div class="shell">
<pre>
$ swig -chicken example.i
$ csc -sv example.scm example_wrap.c example_impl.c -o example.so
</pre>
</div>
<p>The <tt>exmaple.so</tt> file can then linked with <tt>test_script.scm</tt> when it
is compiled, in which case <tt>test_script.scm</tt> must have <code>(declare (uses example))</code>.
Multiple SWIG modules could have been linked into <tt>example.so</tt> and each
one accessed with a <code>(declare (uses ... ))</code>.
</p>
<div class="shell">
<pre>
$ csc -v test_script.scm -lexample
</pre>
</div>
<p>An alternative is the test_script.scm can have the code <code>(load-library 'example "example.so")</code>,
in which case the test script does not need to be linked with example.so. The test_script.scm file can then
be run with <tt>csi</tt>.
</p>
<H3><a name="Chicken_nn14"></a>17.4.2 Building chicken extension libraries</H3>
<p>Building a shared library like in the above section only works if the library
is linked at compile time with a script containing <code>(declare (uses ...))</code> or is
loaded explictetly with <code>(load-library 'example "example.so")</code>. It is
not the format that chicken expects for extension libraries and eggs. The problem is the
<code>(declare (unit <i>modname</i>))</code> inside the <tt>modname.scm</tt> file. There are
two possible solutions to this.</p>
<p>First, SWIG accepts a <tt>-nounit</tt> argument, in which case the <code>(declare (unit <i>modname</i>))</code>
is not generated. Then, the <tt>modname.scm</tt> and <tt>modname_wrap.c</tt> files <b>must</b> be compiled into
their own shared library.</p>
<div class="shell">
<pre>
$ csc -sv modname.scm modname_wrap.c modname_impl.c -o modname.so
</pre>
</div>
<p>This library can then be loaded by scheme code with the <code>(require 'modname)</code> function.
See <a href="http://www.call-with-current-continuation.org/manual/Loading-extension-libraries.html">
Loading-extension-libraries</a> in the eval unit inside the Chicken manual for more information.</p>
<p>Another alternative is to run SWIG normally and create a scheme file that contains <code>(declare (uses <i>modname</i>))</code>
and then compile that file into the shared library as well. For example, inside the <tt>mod_load.scm</tt> file,</p>
<div class="targetlang">
<pre>
(declare (uses mod1))
(declare (uses mod2))
</pre>
</div>
<p>Which would then be compiled with</p>
<div class="shell">
<pre>
$ swig -chicken mod1.i
$ swig -chicken mod2.i
$ csc -sv mod_load.scm mod1.scm mod2.scm mod1_wrap.c mod2_wrap.c mod1_impl.c mod2_impl.c -o mod.so
</pre>
</div>
<p>Then the extension library can be loaded with <code>(require 'mod)</code>. As we can see here,
<tt>mod_load.scm</tt> contains the code that gets exectued when the module is loaded. All this code
does is load both mod1 and mod2. As we can see, this technique is more useful when you want to
combine a few SWIG modules into one chicken extension library, especially if modules are related by
<code>%import</code></p>
<p>In either method, the files that are compiled into the shared library could also be
packaged into an egg. The <tt>mod1_wrap.c</tt> and <tt>mod2_wrap.c</tt> files that are created by SWIG
are stand alone and do not need SWIG to be installed to be compiled. Thus the egg could be
distributed and used by anyone, even if SWIG is not installed.</p>
<p>See the <tt>Examples/chicken/egg</tt> directory in the SWIG source for an example that builds
two eggs, one using the first method and one using the second method.</p>
<H3><a name="Chicken_nn15"></a>17.4.3 Linking multiple SWIG modules with TinyCLOS</H3>
<p>Linking together multiple modules that share type information using the <code>%import</code>
directive while also using <tt>-proxy</tt> is more complicated. For example, if <tt>mod2.i</tt> imports <tt>mod1.i</tt>, then the
<tt>mod2.scm</tt> file contains references to symbols declared in <tt>mod1.scm</tt>,
and thus a <code>(declare (uses <i>mod1</i>))</code> or <code>(require '<i>mod1</i>)</code> must be exported
to the top of <tt>mod2.scm</tt>. By default, when SWIG encounters an <code>%import "modname.i"</code> directive,
it exports <code>(declare (uses <i>modname</i>))</code> into the scm file. This works fine unless mod1 was compiled with
the <tt>-nounit</tt> argument or was compiled into an extension library with other modules under a different name.</p>
<p>One option is to override the automatic generation of <code>(declare (uses mod1))</code>
by passing the <tt>-noclosuses</tt> option to SWIG when compiling <tt>mod2.i</tt>.
SWIG then provides the <code>%insert(closprefix) %{ %}</code> directive. Any scheme code inside that directive is inserted into the
generated .scm file, and if <tt>mod1</tt> was compiled with <tt>-nounit</tt>, the directive should contain <code>(require 'mod1)</code>.
This option allows for mixed loading as well, where some modules are imported with <code>(declare (uses <i>modname</i>))</code>
(which means they were compiled without -nounit) and some are imported with <code>(require 'modname)</code>.</p>
<p>The other option is to use the second idea in the above section. Compile all the modules normally, without any
<code>%insert(closprefix)</code>, <tt>-nounit</tt>, or <tt>-noclosuses</tt>. Then the modules will import each other correctly
with <code>(declare (uses ...))</code>.
To create an extension library or an egg, just create a <tt>module_load.scm</tt> file that <code>(declare (uses ...))</code>
all the modules.</p>
<H2><a name="Chicken_nn16"></a>17.5 Typemaps</H2>
<p>
@ -395,7 +473,7 @@ $ ./example
<code>Lib/chicken/chicken.swg</code>.
</p>
<H2><a name="Chicken_nn17"></a>17.7 Pointers</H2>
<H2><a name="Chicken_nn17"></a>17.6 Pointers</H2>
<p>
@ -428,7 +506,7 @@ $ ./example
type. flags is either zero or SWIG_POINTER_DISOWN (see below).
</p>
<H3><a name="collection"></a>17.7.1 Garbage collection</H3>
<H3><a name="collection"></a>17.6.1 Garbage collection</H3>
<p>If the owner flag passed to <code>SWIG_NewPointerObj</code> is 1, <code>NewPointerObj</code> will add a
@ -459,7 +537,7 @@ $ ./example
must be called manually.
</p>
<H2><a name="Chicken_nn18"></a>17.8 Unsupported features and known problems</H2>
<H2><a name="Chicken_nn18"></a>17.7 Unsupported features and known problems</H2>
<ul>

1
Examples/chicken/README
View file

@ -2,6 +2,7 @@ This directory contains examples for CHICKEN.
class -- illustrates the shadow-class C++ interface
constants -- handling #define and %constant literals
egg -- examples of building chicken extension libraries
multimap -- typemaps with multiple sub-types
overload -- C++ function overloading
simple -- the simple example from the user manual

39
Examples/chicken/egg/Makefile Normal file
View file

@ -0,0 +1,39 @@
SWIG = ../../../preinst-swig
all: single multi
# This creates an egg which contains only the single module. Any additional implementation files
# that implement the interface being wrapped should also be added to this egg
single: single_wrap.cxx
mkdir -p eggs
tar czf eggs/single.egg single.setup single.scm single_wrap.cxx
rm -f single.scm single_wrap.cxx
# complie the single module with -nounit
single_wrap.cxx: single.i
$(SWIG) -chicken -c++ -proxy -nounit single.i
# Now build both mod1 and mod2 into a single egg
multi: mod1_wrap.cxx mod2_wrap.cxx
mkdir -p eggs
tar czf eggs/multi.egg multi.setup multi_init.scm mod1.scm mod1_wrap.cxx mod2.scm mod2_wrap.cxx
rm -f mod1.scm mod1_wrap.cxx mod2.scm mod2_wrap.cxx
mod1_wrap.cxx: mod1.i
$(SWIG) -chicken -c++ -proxy mod1.i
mod2_wrap.cxx: mod2.i
$(SWIG) -chicken -c++ -proxy mod2.i
clean:
rm -rf eggs
# this part is for testing...
setup:
cd eggs && \
mkdir -p install && \
chicken-setup -repository `pwd`/install single.egg && \
chicken-setup -repository `pwd`/install multi.egg
check:
cd eggs/install && csi ../../test.scm

19
Examples/chicken/egg/README Normal file
View file

@ -0,0 +1,19 @@
These examples show how to build a chicken extension module in the form of an
egg. There are two eggs that get built, single.egg which contains a single
module which is built with -nounit and multi.egg, which contains two modules
mod1 and mod2. These are built normally, and multi_init.scm loads them both.
Read section "17.4.2 Building chicken extension libraries" in the manual
for a description of these two techniques.
To build:
$ make
$ make setup
$ make run
$ make clean
The eggs are built into an eggs subdirectory, because chicken-setup has
problems installing eggs when there are other files named similar in
the same directory. The make setup step runs chicken-setup to install
the eggs into the eggs/install directory.

8
Examples/chicken/egg/mod1.i Normal file
View file

@ -0,0 +1,8 @@
%module mod1
%inline %{
class Bar {
public:
int b;
};
%}

17
Examples/chicken/egg/mod2.i Normal file
View file

@ -0,0 +1,17 @@
%module mod2
%import "mod1.i"
%{
class Bar {
public:
int b;
};
%}
%inline %{
class Bar2 : public Bar {
public:
int c;
};
%}

2
Examples/chicken/egg/multi.setup Normal file
View file

@ -0,0 +1,2 @@
(run (csc -s -o multi.so multi_init.scm mod1.scm mod1_wrap.cxx mod2.scm mod2_wrap.cxx))
(install-extension 'multi '("multi.so"))

2
Examples/chicken/egg/multi_init.scm Normal file
View file

@ -0,0 +1,2 @@
(declare (uses mod1))
(declare (uses mod2))

8
Examples/chicken/egg/single.i Normal file
View file

@ -0,0 +1,8 @@
%module single
%inline %{
class Foo {
public:
int a;
};
%}

2
Examples/chicken/egg/single.setup Normal file
View file

@ -0,0 +1,2 @@
(run (csc -s -o single.so single.scm single_wrap.cxx))
(install-extension 'single '("single.so"))

18
Examples/chicken/egg/test.scm Normal file
View file

@ -0,0 +1,18 @@
(require-extension single)
(require-extension multi)
(define f (make <Foo>))
(slot-set! f 'a 3)
(print (slot-ref f 'a))
(define b (make <Bar>))
(slot-set! b 'b 2)
(print (slot-ref b 'b))
(define b2 (make <Bar2>))
(slot-set! b2 'b 4)
(slot-set! b2 'c 6)
(print (slot-ref b2 'b))
(print (slot-ref b2 'c))
(exit 0)

23
Examples/test-suite/chicken/Makefile.in
View file

@ -6,6 +6,7 @@
LANGUAGE = chicken
VARIANT =
SCRIPTSUFFIX = _runme.ss
PROXYSUFFIX = _runme_proxy.ss
srcdir = @srcdir@
top_srcdir = @top_srcdir@
top_builddir = @top_builddir@
@ -24,11 +25,17 @@ SWIGOPT +=
$(setup) \
($(swig_and_compile_cpp); ) && \
$(run_testcase)
if [ -f $(srcdir)/$(SCRIPTPREFIX)$*$(PROXYSUFFIX) ]; then ( \
$(MAKE) $*.cppproxy; ) \
fi;
%.ctest:
$(setup) \
($(swig_and_compile_c); ) && \
$(run_testcase)
if [ -f $(srcdir)/$(SCRIPTPREFIX)$*$(PROXYSUFFIX) ]; then ( \
$(MAKE) $*.cproxy; ) \
fi;
%.multicpptest:
$(setup) \
@ -42,6 +49,22 @@ run_testcase = \
env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(CHICKEN_CSI) $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX);) \
fi;
# If there exists a PROXYSUFFIX runme file, we also generate the wrapper
# with the -proxy argument
%.cppproxy: SWIGOPT += -proxy
%.cppproxy: SCRIPTSUFFIX = $(PROXYSUFFIX)
%.cppproxy:
echo "Checking testcase $* (with run test) under chicken with -proxy"; \
($(swig_and_compile_cpp); ) && \
$(run_testcase)
%.cproxy: SWIGOPT += -proxy
%.cproxy: SCRIPTSUFFIX = $(PROXYSUFFIX)
%.cproxy:
echo "Checking testcase $* (with run test) under chicken with -proxy"; \
($(swig_and_compile_c); ) && \
$(run_testcase)
# Clean
%.clean:

4
Examples/test-suite/chicken/README
View file

@ -5,3 +5,7 @@ NOTE: I had to use _runme.ss becuase otherwise it would be hard to implement mak
Since when SWIG runs it generates an example.scm file for every test, to clean those files
I needed to add a rm -f *.scm to make clean. But we don't want the runme scripts to
dissappear as well!
Any testcases which have _runme_proxy.ss appended after the testcase name will be detected
and run with the -proxy argument passed to SWIG. SWIG will not be run with the -unhide-primitive
option, so the _runme_proxy.ss file must use only the tinyclos exported interface.

21
Examples/test-suite/chicken/newobject2_runme.ss
View file

@ -1,20 +1,29 @@
(load-library 'newobject2 "newobject2.so")
(define f (make <Foo>))
(define f (new-Foo))
(slot-set! f 'dummy 14)
(if (not (= (slot-ref f 'dummy) 14))
(Foo-dummy-set f 14)
(if (not (= (Foo-dummy-get f) 14))
(error "Bad dummy value"))
(if (not (= (fooCount) 0))
(error "Bad foo count 1"))
(define f2 (makeFoo))
(slot-set! f2 'dummy 16)
(if (not (= (slot-ref f2 'dummy) 16))
(if (not (= (fooCount) 1))
(error "Bad foo count 2"))
(Foo-dummy-set f2 16)
(if (not (= (Foo-dummy-get f2) 16))
(error "Bad dummy value for f2"))
(set! f #f)
(set! f2 #f)
(gc)
(gc #t)
(if (not (= (fooCount) -1))
(error "Bad foo count 3"))
(exit 0)

29
Examples/test-suite/chicken/newobject2_runme_proxy.ss Normal file
View file

@ -0,0 +1,29 @@
(load-library 'newobject2 "newobject2.so")
(define f (make <Foo>))
(slot-set! f 'dummy 14)
(if (not (= (slot-ref f 'dummy) 14))
(error "Bad dummy value"))
(if (not (= (fooCount) 0))
(error "Bad foo count 1"))
(define f2 (makeFoo))
(if (not (= (fooCount) 1))
(error "Bad foo count 2"))
(slot-set! f2 'dummy 16)
(if (not (= (slot-ref f2 'dummy) 16))
(error "Bad dummy value for f2"))
(set! f #f)
(set! f2 #f)
(gc #t)
(if (not (= (fooCount) -1))
(error "Bad foo count 3"))
(exit 0)

6
Lib/cdata.i
View file

@ -45,6 +45,12 @@ typedef struct SWIGCDATA {
$result = gh_str2scm($1.data,$1.len);
}
%typemap(in) (const void *indata, int inlen) = (char *STRING, int LENGTH);
#elif SWIGCHICKEN
%typemap(out) SWIGCDATA {
C_word *string_space = C_alloc(C_SIZEOF_STRING($1.len));
$result = C_string(&string_space, $1.len, $1.data);
}
%typemap(in) (const void *indata, int inlen) = (char *STRING, int LENGTH);
#else
%echo "cdata.i module not supported."
#endif

2
Lib/chicken/swigclosprefix.scm
View file

@ -1,4 +1,4 @@
(declare (hide swig-initialize swig-initialize-return))
(declare (hide swig-initialize swig-init-return))
(define (swig-initialize obj initargs create)
(slot-set! obj 'swig-this

217
Source/Modules/chicken.cxx
View file

@ -56,27 +56,34 @@ static String *swigtype_ptr = 0;
static String *f_sym_size = 0;
static String *closcode = 0;
/* some options */
static int declare_unit = 1;
static int no_collection = 0;
/* C++ Support + Clos Classes */
static int clos = 0;
static String *class_name = 0;
static String *short_class_name = 0;
static String *clos_class_methods = 0;
/* sections of the clos code */
static String *clos_class_defines = 0;
static String *clos_methods = 0;
static int in_class = 0;
static int have_constructor = 0;
static String *constructor_name = 0;
static bool exporting_destructor = false;
static String *constructor_name = 0;
static String *memberfunction_name = 0;
static int useclassprefix = 0;
static String *closprefix = 0;
static String *memberfunction_name = 0;
static int hide_primitive = 1;
static Hash *primitive_names = 0;
static int declare_unit = 1;
static int no_collection = 0;
/* Used for overloading constructors */
static int has_constructor_args = 0;
static List *constructor_arg_types = 0;
static String *constructor_dispatch = 0;
static String *constructor_dispatch_func = 0;
static Hash *overload_parameter_lists = 0;
@ -88,7 +95,6 @@ public:
virtual int functionWrapper(Node *n);
virtual int variableWrapper(Node *n);
virtual int constantWrapper(Node *n);
virtual int classDeclaration(Node *n);
virtual int classHandler(Node *n);
virtual int memberfunctionHandler(Node *n);
virtual int membervariableHandler(Node *n);
@ -229,6 +235,8 @@ CHICKEN::top(Node *n)
Swig_register_filebyname("closprefix", closhelpers);
closcode = NewString("");
clos_class_defines = NewString("");
clos_methods = NewString("");
Printf(f_runtime, "/* -*- buffer-read-only: t -*- vi: set ro: */\n");
Swig_banner(f_runtime);
@ -290,6 +298,8 @@ CHICKEN::top(Node *n)
Replaceall(closhelpers,"$module", scmmodule);
Printf (f_scm, "%s\n", closhelpers);
Printf (f_scm, "%s\n", closcode);
Printf (f_scm, "%s\n", clos_class_defines);
Printf (f_scm, "%s\n", clos_methods);
}
Printf(f_scm, "%s\n", chickentext);
@ -313,6 +323,10 @@ CHICKEN::top(Node *n)
Delete(closhelpers);
Delete(overload_parameter_lists);
Delete(closcode);
Delete(clos_class_defines);
Delete(clos_methods);
/* Close all of the files */
Delete(primitive_names);
Delete(scmmodule);
@ -449,10 +463,11 @@ CHICKEN::functionWrapper(Node *n)
if (i < num_required) {
if (strcmp("void", Char(pt)) != 0) {
Node *class_node = Swig_symbol_clookup_check(pb, Getattr(n, "sym:symtab"), checkNodeClass);
String *closclassname = (class_node == NULL) ? NULL : Getattr(class_node, "chicken:closclassname");
if (closclassname) {
Append(function_arg_types, closclassname);
if (class_node) {
String *class_name = NewStringf("<%s>", Getattr(class_node, "sym:name"));
Append(function_arg_types, class_name);
any_specialized_arg = true;
Delete(class_name);
} else {
Append(function_arg_types, "^^##primitive$$");
}
@ -625,11 +640,7 @@ CHICKEN::functionWrapper(Node *n)
1);
Delete(fmt);
}
if (in_class) {
Printv(clos_class_methods, method_def, NIL);
} else {
Printv(closcode, method_def, NIL);
}
Printv(clos_methods, method_def, NIL);
Delete(clos_name);
Delete(method_def);
}
@ -645,28 +656,8 @@ CHICKEN::functionWrapper(Node *n)
flist = NewList();
Setattr(overload_parameter_lists, scmname, flist);
}
/* remove all primitive arguments from the end of the list */
List *nlst = NewList();
List *plst = NewList();
Iterator i;
for (i = First(function_arg_types); i.item; i = Next(i)) {
if (Strcmp(i.item, "^^##optional$$") == 0) {
/* skip it */
} else if (Strcmp(i.item, "^^##primitive$$") == 0) {
Append(plst, i.item);
} else {
/* append plst onto nlst */
Iterator j;
for (j = First(plst); j.item; j = Next(j)) {
Append(nlst, j.item);
}
Delete(plst);
plst = NewList();
Append(nlst, i.item);
}
}
Delete(plst);
Append(flist, nlst);
Append(flist, Copy(function_arg_types));
if (!Getattr(n,"sym:nextSibling")) {
dispatchFunction(n);
@ -810,7 +801,7 @@ CHICKEN::variableWrapper(Node *n) {
String *class_name = SwigType_typedef_resolve_all(SwigType_base(t));
String *clos_name = chickenNameMapping(scmname, (char *)"");
/* Simply re-export the procedure */
Printv(closcode, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
Delete(class_name);
Delete(clos_name);
}
@ -975,7 +966,7 @@ CHICKEN::constantWrapper(Node *n)
if (!in_class) {
String *clos_name = chickenNameMapping(scmname, (char *)"");
Printv(closcode, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
Delete(clos_name);
}
@ -998,21 +989,12 @@ CHICKEN::constantWrapper(Node *n)
return SWIG_OK;
}
int
CHICKEN::classDeclaration(Node *n)
{
String *class_name = NewStringf("<%s>", Getattr(n, "sym:name"));
Setattr(n, "chicken:closclassname", class_name);
return Language::classDeclaration(n);
}
int
CHICKEN::classHandler(Node *n)
{
/* Create new strings for building up a wrapper function */
have_constructor = 0;
constructor_dispatch = 0;
constructor_dispatch_func = 0;
constructor_name = 0;
class_name = NewString("");
@ -1043,17 +1025,17 @@ CHICKEN::classHandler(Node *n)
String *scmmod = NewString(module);
Replaceall(scmmod, "_", "-");
Printv(closcode,"(define ", class_name, "\n",
Printv(clos_class_defines,"(define ", class_name, "\n",
" (make <swig-metaclass-", scmmod, "> 'name '", class_name, "\n", NIL);
Delete(scmmod);
if (Len(base_class) > 2) {
Printv(closcode," 'direct-supers (list ", base_class, ")\n", NIL);
Printv(clos_class_defines," 'direct-supers (list ", base_class, ")\n", NIL);
} else {
Printv(closcode," 'direct-supers (list <object>)\n", NIL);
Printv(clos_class_defines," 'direct-supers (list <object>)\n", NIL);
}
Printf(closcode, " 'direct-slots (list 'swig-this\n");
Printf(clos_class_defines, " 'direct-slots (list 'swig-this\n");
String *mangled_classname = Swig_name_mangle(Getattr(n, "sym:name"));
@ -1066,22 +1048,15 @@ CHICKEN::classHandler(Node *n)
SwigType_remember(ct);
/* Emit all of the members */
clos_class_methods = NewString("");
in_class = 1;
Language::classHandler(n);
in_class = 0;
Printf(closcode, ")))\n");
if (constructor_dispatch_func) {
Printf(closcode, "%s", constructor_dispatch_func);
Delete(constructor_dispatch_func);
constructor_dispatch_func = 0;
}
Printf(clos_class_defines, ")))\n\n");
if (have_constructor) {
Printv(closcode, "(define-method (initialize (obj ", class_name, ") initargs)\n",
Printv(clos_methods, "(define-method (initialize (obj ", class_name, ") initargs)\n",
" (call-next-method)\n",
" (swig-initialize obj initargs ", NIL);
if (constructor_arg_types) {
@ -1089,31 +1064,27 @@ CHICKEN::classHandler(Node *n)
"(lambda (%s) %s)",
chickenPrimitiveName(constructor_name),
0);
Printf(closcode, "%s", func_call);
Printf(clos_methods, "%s", func_call);
Delete(func_call);
Delete(constructor_arg_types);
constructor_arg_types = 0;
} else if (constructor_dispatch) {
Printf(closcode, "%s", constructor_dispatch);
Printf(clos_methods, "%s", constructor_dispatch);
Delete(constructor_dispatch);
constructor_dispatch = 0;
} else {
Printf(closcode, "%s", chickenPrimitiveName(constructor_name));
Printf(clos_methods, "%s", chickenPrimitiveName(constructor_name));
}
Printf(closcode, ")\n)\n");
Printf(clos_methods, ")\n)\n");
Delete(constructor_name);
constructor_name = 0;
} else {
Printv(closcode, "(define-method (initialize (obj ", class_name, ") initargs)\n",
Printv(clos_methods, "(define-method (initialize (obj ", class_name, ") initargs)\n",
" (call-next-method)\n",
" (swig-initialize obj initargs (lambda x #f)))\n",
NIL);
}
Printf(closcode, "%s\n", clos_class_methods);
Delete(clos_class_methods);
clos_class_methods = 0;
/* export class initialization function */
if (clos) {
String *funcname = NewString(mangled_classname);
@ -1132,7 +1103,7 @@ CHICKEN::classHandler(Node *n)
"}\n", NIL);
addMethod(closfuncname, funcname);
Printv(closcode, "(", chickenPrimitiveName(closfuncname), " (lambda (x) (make ", class_name, " 'swig-this x)))\n", NIL);
Printv(clos_methods, "(", chickenPrimitiveName(closfuncname), " (lambda (x) (make ", class_name, " 'swig-this x)))\n\n", NIL);
Delete(closfuncname);
Delete(funcname);
@ -1173,7 +1144,7 @@ CHICKEN::staticmemberfunctionHandler(Node *n)
String *proc = NewString(iname);
Replaceall(proc, "_", "-");
memberfunction_name = chickenNameMapping(proc, short_class_name);
memberfunction_name = NewStringf("%s-%s", short_class_name, proc);
Language::staticmemberfunctionHandler(n);
Delete(memberfunction_name);
memberfunction_name = NULL;
@ -1194,21 +1165,20 @@ CHICKEN::membervariableHandler(Node *n)
Replaceall(proc,"_","-");
Node *class_node = Swig_symbol_clookup(pb, Getattr(n, "sym:symtab"));
String *closclassname = (class_node == NULL) ? NULL : Getattr(class_node, "chicken:closclassname");
String *getfunc = NewStringf("%s-%s-get", short_class_name, proc);
String *setfunc = NewStringf("%s-%s-set", short_class_name, proc);
Printv(closcode," (list '", proc, " ':swig-virtual ':swig-get ", chickenPrimitiveName(getfunc), NIL);
Printv(clos_class_defines," (list '", proc, " ':swig-virtual ':swig-get ", chickenPrimitiveName(getfunc), NIL);
if (!Getattr(n,"feature:immutable")) {
if (closclassname) {
Printv(closcode, " ':swig-set (lambda (x y) (", chickenPrimitiveName(setfunc), " x (slot-ref y 'swig-this))))\n", NIL);
if (class_node) {
Printv(clos_class_defines, " ':swig-set (lambda (x y) (", chickenPrimitiveName(setfunc), " x (slot-ref y 'swig-this))))\n", NIL);
} else {
Printv(closcode, " ':swig-set ", chickenPrimitiveName(setfunc), ")\n", NIL);
Printv(clos_class_defines, " ':swig-set ", chickenPrimitiveName(setfunc), ")\n", NIL);
}
} else {
Printf(closcode, ")\n");
Printf(clos_class_defines, ")\n");
}
Delete(proc);
@ -1229,15 +1199,14 @@ CHICKEN::staticmembervariableHandler(Node *n)
String *closprocname = chickenNameMapping(proc, short_class_name);
Node *class_node = Swig_symbol_clookup(pb, Getattr(n, "sym:symtab"));
String *closclassname = (class_node == NULL) ? NULL : Getattr(class_node, "chicken:closclassname");
String *primfunc = NewStringf("%s-%s", short_class_name, proc);
if (closclassname) {
Printv(clos_class_methods, "(define (", closprocname, " . lst) (if (null? lst) (", chickenPrimitiveName(primfunc), ") (",
if (class_node) {
Printv(clos_methods, "(define (", closprocname, " . lst) (if (null? lst) (", chickenPrimitiveName(primfunc), ") (",
chickenPrimitiveName(primfunc), " (slot-ref (car lst) 'swig-this))))\n", NIL);
} else {
Printv(clos_class_methods, "(define ", closprocname, " ", chickenPrimitiveName(primfunc), ")\n", NIL);
Printv(clos_methods, "(define ", closprocname, " ", chickenPrimitiveName(primfunc), ")\n", NIL);
}
Delete(closprocname);
@ -1298,14 +1267,21 @@ String *CHICKEN::buildClosFunctionCall(List *types, char *format, String_or_char
Iterator arg_type;
int arg_count = 0;
int optional_arguments = 0;
int first_argument = 1;
for (arg_type = First(types); arg_type.item; arg_type = Next(arg_type)) {
if (Strcmp(arg_type.item, "^^##optional$$") == 0) {
optional_arguments = 1;
} else if (Strcmp(arg_type.item, "^^##primitive$$") == 0) {
Printf(method_signature, " arg%i", arg_count);
if (first_argument)
Printf(method_signature, " (arg%i <top>)", arg_count);
else
Printf(method_signature, " arg%i", arg_count);
Printf(func_args, " arg%i", arg_count);
first_argument = 0;
} else {
first_argument = 0;
if (method_specialize) {
Printf(method_signature, " (arg%i %s)", arg_count, arg_type.item);
} else {
@ -1447,7 +1423,7 @@ CHICKEN::dispatchFunction(Node *n)
constructor_dispatch = NewStringf("%s@SWIG@new@dispatch", short_class_name);
clos_name = Copy(constructor_dispatch);
construct = 1;
constructor_dispatch_func = NewStringf("(declare (hide %s))\n", clos_name);
Printf(clos_methods, "(declare (hide %s))\n", clos_name);
} else if (in_class)
clos_name = NewString(memberfunction_name);
else
@ -1455,51 +1431,54 @@ CHICKEN::dispatchFunction(Node *n)
Iterator f;
List *prev = 0;
int has_all_prim = 0;
int has_empty_call = 0;
int all_primitive = 1;
/* first check for duplicates and an empty call */
String *method_name = NewString(clos_name);
String *newlist = NewList();
for (f = First(flist); f.item; f = Next(f)) {
/* check if cur is a duplicate of prev */
if (prev && compareTypeLists(f.item, prev) == 0) {
Delete(f.item);
continue;
}
if (Len(f.item) == 0) {
has_all_prim = 1;
} else if (Len(f.item) == 0) {
has_empty_call = 1;
Delete(method_name);
method_name = NewStringf("%s@SWIG@multireal", clos_name);
Delete(f.item);
continue;
} else {
Append(newlist, f.item);
prev = f.item;
Iterator j;
for (j = First(f.item); j.item; j = Next(j)) {
if (Strcmp(j.item, "^^##optional$$") != 0 && Strcmp(j.item, "^^##primitive$$") != 0)
all_primitive = 0;
}
}
/* now export clos code for argument */
List *n = NewList();
n = Copy(f.item);
Push(n, "^^##optional$$");
String *fmt = NewStringf("(define-method (%s %%s) %%s)\n", clos_name);
String *func_call = buildClosFunctionCall(n, Char(fmt), chickenPrimitiveName(scmname), 1);
if (construct)
Printf(constructor_dispatch_func, "%s", func_call);
else if (in_class)
Printf(clos_class_methods, "%s", func_call);
else
Printf(closcode, "%s", func_call);
Delete(func_call);
Delete(n);
Delete(prev);
prev = f.item;
}
if (prev) Delete(prev);
Delete(flist);
flist = newlist;
if (has_all_prim) {
String *func_call = NewStringf("(define-method (%s . args) (apply %s args))\n", clos_name, chickenPrimitiveName(scmname));
if (construct)
Printf(constructor_dispatch_func, "%s", func_call);
else if (in_class)
Printf(clos_class_methods, "%s", func_call);
else
Printf(closcode, "%s", func_call);
Delete(func_call);
if (all_primitive) {
Printf(clos_methods, "(define %s %s)\n", method_name, chickenPrimitiveName(scmname));
} else {
for (f = First(flist); f.item; f = Next(f)) {
/* now export clos code for argument */
String *fmt = NewStringf("(define-method (%s %%s) %%s)\n", method_name);
String *func_call = buildClosFunctionCall(f.item, Char(fmt), chickenPrimitiveName(scmname), 1);
Printf(clos_methods, "%s", func_call);
Delete(f.item);
Delete(func_call);
}
if (has_empty_call) {
Printf(clos_methods, "(declare (hide %s))\n", method_name);
Printf(clos_methods, "(define (%s . args) (if (null? args) (%s) (apply %s@SWIG@multireal args)))\n",
clos_name, chickenPrimitiveName(scmname), clos_name);
}
}
Delete(method_name);
Delete(clos_name);
Delete(flist);
}