summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorWilliam S Fulton <wsf@fultondesigns.co.uk>2022-10-06 23:12:38 +0100
committerWilliam S Fulton <wsf@fultondesigns.co.uk>2022-10-06 23:29:33 +0100
commitcea25abca535fa27b89eedaf2dd978991b42e1a5 (patch)
tree85e669698ad41a576e5ccdf52eef8de35340e92e
parent7b0f7caaf2c4d8e863b38a88099ea9dd7e3df0e5 (diff)
downloadswig-cea25abca535fa27b89eedaf2dd978991b42e1a5.tar.gz
Completely remove CFFI
No meaningful progress to update CFFI to experimental status has been made since CFFI was disabled in SWIG-4.0.0 as the first stage to removal. This commit is the final stage to remove it. See issue #1966 for an attempt at updating CFFI to experimental status. Anyone wishing for SWIG to support CFFI again might want to utilise this work.
Diffstat
-rw-r--r--Doc/Manual/Lisp.html604
-rw-r--r--Examples/Makefile.in40
-rw-r--r--Examples/test-suite/cffi/Makefile.in55
-rw-r--r--Lib/cffi/cffi.swg286
-rw-r--r--Source/Modules/cffi.cxx1171
5 files changed, 0 insertions, 2156 deletions
diff --git a/Doc/Manual/Lisp.html b/Doc/Manual/Lisp.html
deleted file mode 100644
index 6d8463beb..000000000
--- a/Doc/Manual/Lisp.html
+++ /dev/null
@@ -1,604 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
-<html>
-<head>
-<title>SWIG and Common Lisp</title>
-<link rel="stylesheet" type="text/css" href="style.css">
-<meta http-equiv="content-type" content="text/html; charset=UTF-8">
-</head>
-
-<body bgcolor="#ffffff">
-<H1><a name="Lisp">29 SWIG and Common Lisp</a></H1>
-<!-- INDEX -->
-<div class="sectiontoc">
-<ul>
-<li><a href="#Lisp_nn3">Common Foreign Function Interface(CFFI)</a>
-<ul>
-<li><a href="#Lisp_nn4">Additional Commandline Options </a>
-<li><a href="#Lisp_nn5">Generating CFFI bindings</a>
-<li><a href="#Lisp_nn6">Generating CFFI bindings for C++ code</a>
-<li><a href="#Lisp_nn7">Inserting user code into generated files</a>
-</ul>
-<ul>
-<li><a href="#Lisp_nn9">Additional Commandline Options </a>
-</ul>
-</ul>
-</div>
-<!-- INDEX -->
-
-
-
-<p>
- Common Lisp is a high-level, all-purpose, object-oriented,
- dynamic, functional programming language with long history.
- Common Lisp is used in many fields, ranging from web development to
- finance, and also common in computer science education.
- There are more than 9 different implementations of common lisp which
- are available, all have different foreign function
- interfaces. SWIG currently supports the
- Common Foreign Function Interface(CFFI).
-</p>
-
-<H2><a name="Lisp_nn3">29.2 Common Foreign Function Interface(CFFI)</a></H2>
-
-
-<p>
- CFFI, the Common Foreign Function Interface, is a portable foreign
- function interface for ANSI Common Lisp systems.
- CFFI requires only a small set of
- low-level functionality from the Lisp implementation, such as
- calling a foreign function by name, allocating foreign memory,
- and dereferencing pointers.
-</p>
-
-<p>
- To run the cffi module of SWIG requires very little effort, you
- just need to run:
-</p>
-<div class="code"><pre>
-swig -cffi -module <i>module-name</i> <i>file-name</i>
-
-</pre></div>
-
-<p>
- But a better was of using all the power of SWIG is to write SWIG
- interface files. Below we will explain how to write interface
- files and the various things which you can do with them.
-</p>
-
-<H3><a name="Lisp_nn4">29.2.1 Additional Commandline Options </a></H3>
-
-
-<table summary="CFFI specific options">
-<tr>
- <th> CFFI specific options</th>
-</tr>
-
-<tr>
-<td>-generate-typedef</td>
-<td>If this option is given then defctype will be used to generate<br/>
- shortcuts according to the typedefs in the input.
-</td>
-</tr>
-
-<tr>
-<td>-[no]cwrap</td>
-<td>Turn on or turn off generation of an intermediate C file when<br/>
- creating a C interface. By default this is only done for C++ code.
-</td>
-</tr>
-
-<tr>
-<td>-[no]swig-lisp</td>
-<td>Turns on or off generation of code for helper lisp macro, functions,
- etc. which SWIG uses while generating wrappers. These macros, functions
- may still be used by generated wrapper code.
-</td>
-</tr>
-
-</table>
-
-<H3><a name="Lisp_nn5">29.2.2 Generating CFFI bindings</a></H3>
-
-
-<p>
-
-As we mentioned earlier the ideal way to use SWIG is to use interface
- files. To illustrate the use of it, let's assume that we have a
- file named <i>test.h</i> with the following C code:
-</p>
-
-<div class="code"><pre>
-#define y 5
-#define x (y &gt;&gt; 1)
-
-typedef int days;
-
-struct bar {
- short p, q;
- char a, b;
- int *z[1000];
- struct bar * n;
-};
-
-struct bar * my_struct;
-
-struct foo {
- int a;
- struct foo * b[100];
-};
-
-int pointer_func(void (*ClosureFun)( void* _fun, void* _data, void* _evt ), int p);
-
-int func123(div_t * p, int **q[100], int r[][1000][10]);
-
-void lispsort_double (int n, double * array);
-
-enum color { RED, BLUE, GREEN};
-</pre></div>
-
-<p>
-Corresponding to this we will write a simple interface file:
-</p>
-
-<div class="code"><pre>
-%module test
-
-%include "test.h"
-
-</pre></div>
-
-<p>
-The generated SWIG Code will be:
-</p>
-
-<div class="targetlang"><pre>
-;;;SWIG wrapper code starts here
-
-(cl:defmacro defanonenum (&amp;body enums)
- "Converts anonymous enums to defconstants."
- `(cl:progn , @(cl:loop for value in enums
- for index = 0 then (cl:1+ index)
- when (cl:listp value) do (cl:setf index (cl:second value)
- value (cl:first value))
- collect `(cl:defconstant , value , index))))
-
-(cl:eval-when (:compile-toplevel :load-toplevel)
- (cl:unless (cl:fboundp 'swig-lispify)
- (cl:defun swig-lispify (name flag cl:&amp;optional (package cl:*package*))
- (cl:labels ((helper (lst last rest cl:&amp;aux (c (cl:car lst)))
- (cl:cond
- ((cl:null lst)
- rest)
- ((cl:upper-case-p c)
- (helper (cl:cdr lst) 'upper
- (cl:case last
- ((lower digit) (cl:list* c #\- rest))
- (cl:t (cl:cons c rest)))))
- ((cl:lower-case-p c)
- (helper (cl:cdr lst) 'lower (cl:cons (cl:char-upcase c) rest)))
- ((cl:digit-char-p c)
- (helper (cl:cdr lst) 'digit
- (cl:case last
- ((upper lower) (cl:list* c #\- rest))
- (cl:t (cl:cons c rest)))))
- ((cl:char-equal c #\_)
- (helper (cl:cdr lst) '_ (cl:cons #\- rest)))
- (cl:t
- (cl:error "Invalid character: ~A" c)))))
- (cl:let ((fix (cl:case flag
- ((constant enumvalue) "+")
- (variable "*")
- (cl:t ""))))
- (cl:intern
- (cl:concatenate
- 'cl:string
- fix
- (cl:nreverse (helper (cl:concatenate 'cl:list name) cl:nil cl:nil))
- fix)
- package))))))
-
-;;;SWIG wrapper code ends here
-
-
-(cl:defconstant y 5)
-
-(cl:defconstant x (cl:ash 5 -1))
-
-(cffi:defcstruct bar
- (p :short)
- (q :short)
- (a :char)
- (b :char)
- (z :pointer)
- (n :pointer))
-
-(cffi:defcvar ("my_struct" my_struct)
- :pointer)
-
-(cffi:defcstruct foo
- (a :int)
- (b :pointer))
-
-(cffi:defcfun ("pointer_func" pointer_func) :int
- (ClosureFun :pointer)
- (p :int))
-
-(cffi:defcfun ("func123" func123) :int
- (p :pointer)
- (q :pointer)
- (r :pointer))
-
-(cffi:defcfun ("lispsort_double" lispsort_double) :void
- (n :int)
- (array :pointer))
-
-(cffi:defcenum color
- :RED
- :BLUE
- :GREEN)
-</pre></div>
-
-<p>
- The <i>SWIG wrapper</i> code refers to the special code which SWIG
- may need to use while wrapping C code. You can turn on/off the
- generation of this code by using the <i>-[no]swig-lisp</i>
- option. You must have noticed that SWIG goes one extra step to
- ensure that CFFI does not do automatic lispification of the C
- function names. The reason SWIG does this is because quite often
- developers want to build a nice CLOS based lispy API, and this one
- to one correspondence between C function names and lisp function
- name helps.
-</p>
-
-<p> Maybe you want to have your own convention for generating lisp
- function names for corresponding C function names, or you just
- want to lispify the names, also, before we forget you want to
- export the generated lisp names. To do this, we will use the
- SWIG <a
- href="Customization.html#Customization_features">feature directive</a>.
-Let's edit the interface file such that the C type "div_t*" is changed
- to Lisp type ":my-pointer", we lispify all names,
- export everything, and do some more stuff.
-
-</p>
-<div class="code"><pre>
-%module test
-
-%typemap(cin) div_t* ":my-pointer"
-
-%feature("intern_function", "1");
-%feature("export");
-
-%feature("inline") lispsort_double;
-%feature("intern_function", "my-lispify") lispsort_double;
-%feature("export", package="'some-other-package") lispsort_double;
-
-%rename func123 renamed_cool_func;
-
-%ignore "pointer_func";
-
-%include "test.h"
-
-</pre></div>
-
-<p>
-The <i>typemap(cin)</i> ensures that for all arguments which are input
- to C with the type "div_t*", the ":my-pointer" type be
- used. Similarly <i>typemap(cout)</i> are used for all types which
- are returned from C.
-</p>
-<p>
-The feature <i>intern_function</i> ensures that all C names are
- interned using the <b>swig-lispify</b> function. The "1" given
- to the feature is optional. The use of feature like
- <i>%feature("intern_function", "1");</i> globally enables
- interning for everything. If you want to target a single
- function, or declaration then use the targeted version of
- feature, <i>%feature("intern_function", "my-lispify")
- lispsort_double;</i>, here we are using an additional feature
- which allows us to use our lispify function.
-</p>
-<p>The <i>export</i> feature allows us to export the symbols. If
- the <i>package</i> argument is given, then the symbol will be exported to
- the specified Lisp package. The <i>inline</i> feature declaims the
- declared function as inline. The <i>rename</i> directive allows us to
- change the name(it is useful when generating C wrapper code for handling
- overloaded functions). The <i>ignore</i> directive ignores a certain
- declaration.
-</p>
-<p>There are several other things which are possible, to see some
- example of usage of SWIG look at the Lispbuilder and wxCL
- projects. The generated code with 'noswig-lisp' option is:
-</p>
-
-<div class="targetlang"><pre>
-(cl:defconstant #.(swig-lispify "y" 'constant) 5)
-
-(cl:export '#.(swig-lispify "y" 'constant))
-
-(cl:defconstant #.(swig-lispify "x" 'constant) (cl:ash 5 -1))
-
-(cl:export '#.(swig-lispify "x" 'constant))
-
-(cffi:defcstruct #.(swig-lispify "bar" 'classname)
- (#.(swig-lispify "p" 'slotname) :short)
- (#.(swig-lispify "q" 'slotname) :short)
- (#.(swig-lispify "a" 'slotname) :char)
- (#.(swig-lispify "b" 'slotname) :char)
- (#.(swig-lispify "z" 'slotname) :pointer)
- (#.(swig-lispify "n" 'slotname) :pointer))
-
-(cl:export '#.(swig-lispify "bar" 'classname))
-
-(cl:export '#.(swig-lispify "p" 'slotname))
-
-(cl:export '#.(swig-lispify "q" 'slotname))
-
-(cl:export '#.(swig-lispify "a" 'slotname))
-
-(cl:export '#.(swig-lispify "b" 'slotname))
-
-(cl:export '#.(swig-lispify "z" 'slotname))
-
-(cl:export '#.(swig-lispify "n" 'slotname))
-
-(cffi:defcvar ("my_struct" #.(swig-lispify "my_struct" 'variable))
- :pointer)
-
-(cl:export '#.(swig-lispify "my_struct" 'variable))
-
-(cffi:defcstruct #.(swig-lispify "foo" 'classname)
- (#.(swig-lispify "a" 'slotname) :int)
- (#.(swig-lispify "b" 'slotname) :pointer))
-
-(cl:export '#.(swig-lispify "foo" 'classname))
-
-(cl:export '#.(swig-lispify "a" 'slotname))
-
-(cl:export '#.(swig-lispify "b" 'slotname))
-
-(cffi:defcfun ("renamed_cool_func" #.(swig-lispify "renamed_cool_func" 'function)) :int
- (p :my-pointer)
- (q :pointer)
- (r :pointer))
-
-(cl:export '#.(swig-lispify "renamed_cool_func" 'function))
-
-(cl:declaim (cl:inline #.(my-lispify "lispsort_double" 'function)))
-
-(cffi:defcfun ("lispsort_double" #.(my-lispify "lispsort_double" 'function)) :void
- (n :int)
- (array :pointer))
-
-(cl:export '#.(my-lispify "lispsort_double" 'function) 'some-other-package)
-
-(cffi:defcenum #.(swig-lispify "color" 'enumname)
- #.(swig-lispify "RED" 'enumvalue :keyword)
- #.(swig-lispify "BLUE" 'enumvalue :keyword)
- #.(swig-lispify "GREEN" 'enumvalue :keyword))
-
-(cl:export '#.(swig-lispify "color" 'enumname))
-
-</pre></div>
-
-<H3><a name="Lisp_nn6">29.2.3 Generating CFFI bindings for C++ code</a></H3>
-
-
-<p>This feature to SWIG (for CFFI) is very new and still far from
- complete. Pitch in with your patches, bug reports and feature
- requests to improve it.
-</p>
-<p> Generating bindings for C++ code, requires <i>-c++</i> option to be
- present and it first generates C binding which will wrap the C++
- code, and then generates the
- corresponding CFFI wrapper code. In the generated C wrapper
- code, you will often want to put your own C code, such as the
- code to include various files. This can be done by making use of
- "%{" and "%}" as shown below.
-</p>
-<div class="code"><pre>
-%{
- #include "Test/test.h"
-%}
-</pre></div>
-<p>
-Also, while parsing the C++ file and generating C wrapper code SWIG
- may need to be able to understand various symbols used in other
- header files. To help SWIG in doing this while ensuring that
- wrapper code is generated for the target file, use the "import"
- directive. The "include" directive specifies the target file for
- which wrapper code will be generated.
-</p>
-<div class="code"><pre>
-
-%import "ancillary/header.h"
-
-%include "target/header.h"
-
-</pre></div>
-<p>
-Various features which were available for C headers can also be used
- here. The target header which we are going to use here is:
-</p>
-<div class="code"><pre>
-namespace OpenDemo {
- class Test
- {
- public:
- float x;
- // constructors
- Test (void) {x = 0;}
- Test (float X) {x = X;}
-
- // vector addition
- Test operator+ (const Test&amp; v) const {return Test (x+v.x);}
-
- // length squared
- float lengthSquared (void) const {return this-&gt;dot (*this);}
-
- static float distance (const Test&amp; a, const Test&amp; b){return(a-b).length();}
-
- inline Test parallelComponent (const Test&amp; unitBasis) const {
- return unitBasis * projection;
- }
-
- Test setYtoZero (void) const {return Test (this-&gt;x);}
-
- static const Test zero;
- };
-
- inline Test operator* (float s, const Test&amp; v) {return v*s;}
-
- inline std::ostream&amp; operator&lt;&lt; (std::ostream&amp; o, const Test&amp; v)
- {
- return o &lt;&lt; "(" &lt;&lt; v.x &lt;&lt; ")";
- }
-
- inline Test RandomUnitVectorOnXZPlane (void)
- {
- return RandomVectorInUnitRadiusSphere().setYtoZero().normalize();
- }
-}
-</pre></div>
-<p>The interface used is: </p>
-<div class="code"><pre>
-%module test
-%include "test.cpp"
-</pre></div>
-
-<p>
-SWIG generates 3 files, the first one is a C wrap which we don't show,
- the second is the plain CFFI wrapper which is as shown below:
-</p>
-<div class="targetlang"><pre>
-(cffi:defcfun ("_wrap_Test_x_set" Test_x_set) :void
- (self :pointer)
- (x :float))
-
-(cffi:defcfun ("_wrap_Test_x_get" Test_x_get) :float
- (self :pointer))
-
-(cffi:defcfun ("_wrap_new_Test__SWIG_0" new_Test) :pointer)
-
-(cffi:defcfun ("_wrap_new_Test__SWIG_1" new_Test) :pointer
- (X :float))
-
-(cffi:defcfun ("_wrap_Test___add__" Test___add__) :pointer
- (self :pointer)
- (v :pointer))
-
-(cffi:defcfun ("_wrap_Test_lengthSquared" Test_lengthSquared) :float
- (self :pointer))
-
-(cffi:defcfun ("_wrap_Test_distance" Test_distance) :float
- (a :pointer)
- (b :pointer))
-
-(cffi:defcfun ("_wrap_Test_parallelComponent" Test_parallelComponent) :pointer
- (self :pointer)
- (unitBasis :pointer))
-
-(cffi:defcfun ("_wrap_Test_setYtoZero" Test_setYtoZero) :pointer
- (self :pointer))
-
-(cffi:defcvar ("Test_zero" Test_zero)
- :pointer)
-
-(cffi:defcfun ("_wrap_delete_Test" delete_Test) :void
- (self :pointer))
-
-(cffi:defcfun ("_wrap___mul__" __mul__) :pointer
- (s :float)
- (v :pointer))
-
-(cffi:defcfun ("_wrap___lshift__" __lshift__) :pointer
- (o :pointer)
- (v :pointer))
-
-(cffi:defcfun ("_wrap_RandomUnitVectorOnXZPlane" RandomUnitVectorOnXZPlane) :pointer)
-</pre></div>
-
-<p>
-The output is pretty good but it fails in disambiguating overloaded
- functions such as the constructor, in this case. One way of
- resolving this problem is to make the interface use the rename
- directiv, but hopefully there are better solutions.
- In addition SWIG also generates, a CLOS file
-</p>
-
-
-<div class="targetlang"><pre>
-(clos:defclass test()
- ((ff :reader ff-pointer)))
-
-(clos:defmethod (cl:setf x) (arg0 (obj test))
- (Test_x_set (ff-pointer obj) arg0))
-
-(clos:defmethod x ((obj test))
- (Test_x_get (ff-pointer obj)))
-
-(cl:shadow "+")
-(clos:defmethod + ((obj test) (self test) (v test))
- (Test___add__ (ff-pointer obj) (ff-pointer self) (ff-pointer v)))
-
-(clos:defmethod length-squared ((obj test) (self test))
- (Test_lengthSquared (ff-pointer obj) (ff-pointer self)))
-
-(clos:defmethod parallel-component ((obj test) (self test) (unitBasis test))
- (Test_parallelComponent (ff-pointer obj) (ff-pointer self) (ff-pointer unitBasis)))
-
-(clos:defmethod set-yto-zero ((obj test) (self test))
- (Test_setYtoZero (ff-pointer obj) (ff-pointer self)))
-</pre></div>
-
-<p>I agree that the CFFI C++ module needs lot more work. But I hope it
- provides a starting point, on which you can base your work of
- importing C++ libraries to Lisp.
-</p>
-<p>
-If you have any questions, suggestions, patches, etc., related to CFFI
- module feel free to contact us on the SWIG mailing list, and
- also please add a "[CFFI]" tag in the subject line.
-
-<H3><a name="Lisp_nn7">29.2.4 Inserting user code into generated files</a></H3>
-
-
-<p>
-It is often necessary to <a href="SWIG.html#SWIG_nn40">include user-defined code</a>
-into the automatically generated interface files. For example, when building
-a C++ interface, example_wrap.cxx will likely not compile unless
-you add a <tt>#include "header.h"</tt> directive. This can be done
-using the SWIG <tt>%insert(section) %{ ...code... %}</tt> directive:
-</p>
-
-<div class="code">
-<pre>
-%module example
-
-%{
-#include "header.h"
-%}
-
-%include "header.h"
-
-int fact(int n);
-</pre>
-</div>
-
-<p>
-Additional sections have been added for inserting into the
-generated lisp interface file:
-</p>
-<ul>
- <li><tt>lisphead</tt> - inserts before type declarations</li>
- <li><tt>swiglisp</tt> - inserts after type declarations according to
- where it appears in the .i file</li>
-</ul>
-<p>
-Note that the block <tt>%{ ... %}</tt> is effectively a shortcut for
-<tt>%insert("header") %{ ... %}</tt>.
-</p>
-
-
-</body>
-</html>
diff --git a/Examples/Makefile.in b/Examples/Makefile.in
index 28c87862c..e28e48149 100644
--- a/Examples/Makefile.in
+++ b/Examples/Makefile.in
@@ -203,46 +203,6 @@ android_clean:
rm -rf obj
##################################################################
-##### CFFI ######
-##################################################################
-
-CFFI = @CFFIBIN@
-CFFI_SCRIPT=$(RUNME).lisp
-
-cffi: $(SRCDIR_SRCS)
- $(SWIG) -cffi $(SWIGOPT) -o $(ISRCS) $(INTERFACEPATH)
-# $(CC) -c $(CCSHARED) $(CPPFLAGS) $(CFLAGS) $(ISRCS) $(INCLUDES) $(SRCDIR_SRCS)
-# $(LDSHARED) $(CFLAGS) $(LDFLAGS) $(OBJS) $(IOBJS) $(LIBS) -o $(LIBPREFIX)$(TARGET)$(SO)
-
-cffi_cpp: $(SRCDIR_SRCS)
- $(SWIG) -c++ -cffi $(SWIGOPT) -o $(ICXXSRCS) $(INTERFACEPATH)
- $(CXX) -c $(CCSHARED) $(CPPFLAGS) $(CXXFLAGS) $(ICXXSRCS) $(SRCDIR_SRCS) $(SRCDIR_CXXSRCS) $(INCLUDES)
- $(CXXSHARED) $(CXXFLAGS) $(LDFLAGS) $(OBJS) $(IOBJS) $(LIBS) $(CPP_DLLIBS) -o $(LIBPREFIX)$(TARGET)$(SO)
-
-# -----------------------------------------------------------------
-# Run CFFI example
-# -----------------------------------------------------------------
-
-cffi_run:
- $(RUNTOOL) $(CFFI) -batch -s $(CFFI_SCRIPT) $(RUNPIPE)
-
-# -----------------------------------------------------------------
-# Version display
-# -----------------------------------------------------------------
-
-cffi_version:
- $(CFFI) --version
-
-# -----------------------------------------------------------------
-# Cleaning the CFFI examples
-# -----------------------------------------------------------------
-
-cffi_clean:
- rm -f *_wrap* *~ .~*
- rm -f core @EXTRA_CLEAN@
- rm -f *.@OBJEXT@ *@SO@
-
-##################################################################
##### CSHARP ######
##################################################################
diff --git a/Examples/test-suite/cffi/Makefile.in b/Examples/test-suite/cffi/Makefile.in
deleted file mode 100644
index e27b2c85d..000000000
--- a/Examples/test-suite/cffi/Makefile.in
+++ /dev/null
@@ -1,55 +0,0 @@
-#######################################################################
-# Makefile for cffi test-suite
-#######################################################################
-
-LANGUAGE = cffi
-CFFI = @CFFIBIN@
-SCRIPTSUFFIX = _runme.lisp
-
-HAVE_CXX11 = @HAVE_CXX11@
-HAVE_CXX14 = @HAVE_CXX14@
-HAVE_CXX17 = @HAVE_CXX17@
-HAVE_CXX20 = @HAVE_CXX20@
-srcdir = @srcdir@
-top_srcdir = @top_srcdir@
-top_builddir = @top_builddir@
-
-include $(srcdir)/../common.mk
-
-# Overridden variables here
-# no C++ tests for now
-CPP_TEST_CASES =
-#C_TEST_CASES +=
-
-# Custom tests - tests with additional commandline options
-# none!
-
-# Rules for the different types of tests
-%.cpptest:
- $(setup)
- +$(swig_and_compile_cpp)
- $(run_testcase)
-
-%.ctest:
- $(setup)
- +$(swig_and_compile_c)
- $(run_testcase)
-
-%.multicpptest:
- $(setup)
- +$(swig_and_compile_multi_cpp)
- $(run_testcase)
-
-# Runs the testcase. A testcase is only run if
-# a file is found which has _runme.lisp appended after the testcase name.
-run_testcase = \
- if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then \
- env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(RUNTOOL) $(CFFI) -batch -s $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX); \
- fi
-
-# Clean: (does nothing, we don't generate extra cffi code)
-%.clean:
- @exit 0
-
-clean:
- $(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile SRCDIR='$(SRCDIR)' cffi_clean
diff --git a/Lib/cffi/cffi.swg b/Lib/cffi/cffi.swg
deleted file mode 100644
index b96d3d4fd..000000000
--- a/Lib/cffi/cffi.swg
+++ /dev/null
@@ -1,286 +0,0 @@
-/* Define a C preprocessor symbol that can be used in interface files
- to distinguish between the SWIG language modules. */
-
-#define SWIG_CFFI
-
-/* Typespecs for basic types. */
-
-%typemap(cin) void ":void"
-
-%typemap(cin) char ":char"
-%typemap(cin) char * ":string"
-%typemap(cin) unsigned char ":unsigned-char"
-%typemap(cin) signed char ":char"
-
-%typemap(cin) short ":short"
-%typemap(cin) signed short ":short"
-%typemap(cin) unsigned short ":unsigned-short"
-
-%typemap(cin) int ":int"
-%typemap(cin) signed int ":int"
-%typemap(cin) unsigned int ":unsigned-int"
-
-%typemap(cin) long ":long"
-%typemap(cin) signed long ":long"
-%typemap(cin) unsigned long ":unsigned-long"
-
-%typemap(cin) long long ":long-long"
-%typemap(cin) signed long long ":long-long"
-%typemap(cin) unsigned long long ":unsigned-long-long"
-
-%typemap(cin) float ":float"
-%typemap(cin) double ":double"
-%typemap(cin) SWIGTYPE ":pointer"
-
-%typemap(cout) void ":void"
-
-%typemap(cout) char ":char"
-%typemap(cout) char * ":string"
-%typemap(cout) unsigned char ":unsigned-char"
-%typemap(cout) signed char ":char"
-
-%typemap(cout) short ":short"
-%typemap(cout) signed short ":short"
-%typemap(cout) unsigned short ":unsigned-short"
-
-%typemap(cout) int ":int"
-%typemap(cout) signed int ":int"
-%typemap(cout) unsigned int ":unsigned-int"
-
-%typemap(cout) long ":long"
-%typemap(cout) signed long ":long"
-%typemap(cout) unsigned long ":unsigned-long"
-
-%typemap(cout) long long ":long-long"
-%typemap(cout) signed long long ":long-long"
-%typemap(cout) unsigned long long ":unsigned-long-long"
-
-%typemap(cout) float ":float"
-%typemap(cout) double ":double"
-%typemap(cout) SWIGTYPE ":pointer"
-
-
-%typemap(ctype) bool "int"
-%typemap(ctype) char, unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- float, double, long double, char *, void *, void,
- enum SWIGTYPE, SWIGTYPE *,
- SWIGTYPE[ANY], SWIGTYPE &, SWIGTYPE && "$1_ltype";
-%typemap(ctype) SWIGTYPE "$&1_type"
-
-%typemap(in) bool "$1 = (bool)$input;"
-%typemap(in) char, unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- float, double, long double, char *, void *, void,
- enum SWIGTYPE, SWIGTYPE *,
- SWIGTYPE[ANY], SWIGTYPE &, SWIGTYPE && "$1 = $input;";
-%typemap(in) SWIGTYPE "$1 = *$input;"
-
-%typemap(out) void ""
-%typemap(out) bool "$result = (int)$1;"
-%typemap(out) char, unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- float, double, long double, char *, void *,
- enum SWIGTYPE, SWIGTYPE *,
- SWIGTYPE[ANY], SWIGTYPE &, SWIGTYPE && "$result = $1;";
-#ifdef __cplusplus
-%typemap(out) SWIGTYPE
-%{ $result = new $1_ltype($1); %}
-#else
-%typemap(out) SWIGTYPE {
- $result = ($&1_ltype) malloc(sizeof($1_type));
- memmove($result, &$1, sizeof($1_type));
-}
-#endif
-
-%typecheck(SWIG_TYPECHECK_BOOL) bool { $1 = 1; };
-%typecheck(SWIG_TYPECHECK_CHAR) char { $1 = 1; };
-%typecheck(SWIG_TYPECHECK_FLOAT) float { $1 = 1; };
-%typecheck(SWIG_TYPECHECK_DOUBLE) double { $1 = 1; };
-%typecheck(SWIG_TYPECHECK_STRING) char * { $1 = 1; };
-%typecheck(SWIG_TYPECHECK_INTEGER)
- unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- enum SWIGTYPE { $1 = 1; };
-%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&,
- SWIGTYPE[ANY], SWIGTYPE { $1 = 1; };
-/* This maps C/C++ types to Lisp classes for overload dispatch */
-
-%typemap(lisptype) bool "cl:boolean"
-%typemap(lisptype) char "cl:character"
-%typemap(lisptype) unsigned char "cl:integer"
-%typemap(lisptype) signed char "cl:integer"
-
-%typemap(lispclass) bool "t"
-%typemap(lispclass) char "cl:character"
-%typemap(lispclass) unsigned char, signed char,
- short, signed short, unsigned short,
- int, signed int, unsigned int,
- long, signed long, unsigned long,
- enum SWIGTYPE "cl:integer";
-/* CLOS methods can't be specialized on single-float or double-float */
-%typemap(lispclass) float "cl:number"
-%typemap(lispclass) double "cl:number"
-%typemap(lispclass) char * "cl:string"
-
-/* Array reference typemaps */
-%apply SWIGTYPE & { SWIGTYPE ((&)[ANY]) }
-%apply SWIGTYPE && { SWIGTYPE ((&&)[ANY]) }
-
-/* const pointers */
-%apply SWIGTYPE * { SWIGTYPE *const }
-%apply SWIGTYPE (CLASS::*) { SWIGTYPE (CLASS::*const) }
-%apply SWIGTYPE & { SWIGTYPE (CLASS::*const&) }
-
-%{
-
-#ifdef __cplusplus
-# define EXTERN extern "C"
-#else
-# define EXTERN extern
-#endif
-
-#define EXPORT EXTERN SWIGEXPORT
-
-#include <string.h>
-%}
-
-%insert("swiglisp") %{
-;;;SWIG wrapper code starts here
-
-(cl:defmacro defanonenum (cl:&body enums)
- "Converts anonymous enums to defconstants."
- `(cl:progn ,@(cl:loop for value in enums
- for index = 0 then (cl:1+ index)
- when (cl:listp value) do (cl:setf index (cl:second value)
- value (cl:first value))
- collect `(cl:defconstant ,value ,index))))
-
-(cl:eval-when (:compile-toplevel :load-toplevel)
- (cl:unless (cl:fboundp 'swig-lispify)
- (cl:defun swig-lispify (name flag cl:&optional (package cl:*package*))
- (cl:labels ((helper (lst last rest cl:&aux (c (cl:car lst)))
- (cl:cond
- ((cl:null lst)
- rest)
- ((cl:upper-case-p c)
- (helper (cl:cdr lst) 'upper
- (cl:case last
- ((lower digit) (cl:list* c #\- rest))
- (cl:t (cl:cons c rest)))))
- ((cl:lower-case-p c)
- (helper (cl:cdr lst) 'lower (cl:cons (cl:char-upcase c) rest)))
- ((cl:digit-char-p c)
- (helper (cl:cdr lst) 'digit
- (cl:case last
- ((upper lower) (cl:list* c #\- rest))
- (cl:t (cl:cons c rest)))))
- ((cl:char-equal c #\_)
- (helper (cl:cdr lst) '_ (cl:cons #\- rest)))
- (cl:t
- (cl:error "Invalid character: ~A" c)))))
- (cl:let ((fix (cl:case flag
- ((constant enumvalue) "+")
- (variable "*")
- (cl:t ""))))
- (cl:intern
- (cl:concatenate
- 'cl:string
- fix
- (cl:nreverse (helper (cl:concatenate 'cl:list name) cl:nil cl:nil))
- fix)
- package))))))
-
-;;;SWIG wrapper code ends here
-%}
-
-//////////////////////////////////////////////////////////////
-
-/* name conversion for overloaded operators. */
-#ifdef __cplusplus
-%rename(__add__) *::operator+;
-%rename(__pos__) *::operator+();
-%rename(__pos__) *::operator+() const;
-
-%rename(__sub__) *::operator-;
-%rename(__neg__) *::operator-() const;
-%rename(__neg__) *::operator-();
-
-%rename(__mul__) *::operator*;
-%rename(__deref__) *::operator*();
-%rename(__deref__) *::operator*() const;
-
-%rename(__div__) *::operator/;
-%rename(__mod__) *::operator%;
-%rename(__logxor__) *::operator^;
-%rename(__logand__) *::operator&;
-%rename(__logior__) *::operator|;
-%rename(__lognot__) *::operator~();
-%rename(__lognot__) *::operator~() const;
-
-%rename(__not__) *::operator!();
-%rename(__not__) *::operator!() const;
-
-%rename(__assign__) *::operator=;
-
-%rename(__add_assign__) *::operator+=;
-%rename(__sub_assign__) *::operator-=;
-%rename(__mul_assign__) *::operator*=;
-%rename(__div_assign__) *::operator/=;
-%rename(__mod_assign__) *::operator%=;
-%rename(__logxor_assign__) *::operator^=;
-%rename(__logand_assign__) *::operator&=;
-%rename(__logior_assign__) *::operator|=;
-
-%rename(__lshift__) *::operator<<;
-%rename(__lshift_assign__) *::operator<<=;
-%rename(__rshift__) *::operator>>;
-%rename(__rshift_assign__) *::operator>>=;
-
-%rename(__eq__) *::operator==;
-%rename(__ne__) *::operator!=;
-%rename(__lt__) *::operator<;
-%rename(__gt__) *::operator>;
-%rename(__lte__) *::operator<=;
-%rename(__gte__) *::operator>=;
-
-%rename(__and__) *::operator&&;
-%rename(__or__) *::operator||;
-
-%rename(__preincr__) *::operator++();
-%rename(__postincr__) *::operator++(int);
-%rename(__predecr__) *::operator--();
-%rename(__postdecr__) *::operator--(int);
-
-%rename(__comma__) *::operator,();
-%rename(__comma__) *::operator,() const;
-
-%rename(__member_ref__) *::operator->;
-%rename(__member_func_ref__) *::operator->*;
-
-%rename(__funcall__) *::operator();
-%rename(__aref__) *::operator[];
-#endif
-
-
-%{
-
-#ifdef __cplusplus
-# define EXTERN extern "C"
-#else
-# define EXTERN extern
-#endif
-
-#define EXPORT EXTERN SWIGEXPORT
-
-#include <string.h>
-#include <stdlib.h>
-%}
diff --git a/Source/Modules/cffi.cxx b/Source/Modules/cffi.cxx
deleted file mode 100644
index f517ef1d3..000000000
--- a/Source/Modules/cffi.cxx
+++ /dev/null
@@ -1,1171 +0,0 @@
-/* -----------------------------------------------------------------------------
- * This file is part of SWIG, which is licensed as a whole under version 3
- * (or any later version) of the GNU General Public License. Some additional
- * terms also apply to certain portions of SWIG. The full details of the SWIG
- * license and copyrights can be found in the LICENSE and COPYRIGHT files
- * included with the SWIG source code as distributed by the SWIG developers
- * and at https://www.swig.org/legal.html.
- *
- * cffi.cxx
- *
- * cffi language module for SWIG.
- * ----------------------------------------------------------------------------- */
-
-#include "swigmod.h"
-#include "cparse.h"
-#include <ctype.h>
-
-//#define CFFI_DEBUG
-//#define CFFI_WRAP_DEBUG
-
-static const char *usage = "\
-CFFI Options (available with -cffi)\n\
- -generate-typedef - Use defctype to generate shortcuts according to the\n\
- typedefs in the input.\n\
- -[no]cwrap - Turn on or turn off generation of an intermediate C\n\
- file when creating a C interface. By default this is\n\
- only done for C++ code.\n\
- -[no]swig-lisp - Turn on or off generation of code for helper lisp\n\
- macro, functions, etc. which SWIG uses while\n\
- generating wrappers. These macros, functions may still\n\
- be used by generated wrapper code.\n\
-";
-
-class CFFI:public Language {
-public:
- String *f_cl;
- String *f_clhead;
- String *f_clwrap;
- bool CWrap; // generate wrapper file for C code?
- File *f_begin;
- File *f_runtime;
- File *f_cxx_header;
- File *f_cxx_wrapper;
- File *f_clos;
-
- String *module;
- virtual void main(int argc, char *argv[]);
- virtual int top(Node *n);
- virtual int functionWrapper(Node *n);
- virtual int variableWrapper(Node *n);
- virtual int constantWrapper(Node *n);
- // virtual int classDeclaration(Node *n);
- virtual int enumDeclaration(Node *n);
- virtual int typedefHandler(Node *n);
-
- //c++ specific code
- virtual int constructorHandler(Node *n);
- virtual int destructorHandler(Node *n);
- virtual int memberfunctionHandler(Node *n);
- virtual int membervariableHandler(Node *n);
- virtual int classHandler(Node *n);
-
-private:
- static void checkConstraints(ParmList *parms, Wrapper *f);
- static void argout(ParmList *parms, Wrapper *f);
- static String *freearg(ParmList *parms);
- static void cleanupFunction(Node *n, Wrapper *f, ParmList *parms);
-
- void emit_defun(Node *n, String *name);
- void emit_defmethod(Node *n);
- void emit_initialize_instance(Node *n);
- void emit_getter(Node *n);
- void emit_setter(Node *n);
- void emit_class(Node *n);
- void emit_struct_union(Node *n, bool un);
- void emit_export(Node *n, String *name);
- void emit_inline(Node *n, String *name);
- String *lispy_name(char *name);
- String *lispify_name(Node *n, String *ty, const char *flag, bool kw = false);
- String *convert_literal(String *num_param, String *type, bool try_to_split = true);
- String *infix_to_prefix(String *val, char split_op, const String *op, String *type);
- String *strip_parens(String *string);
- String *trim(String *string);
- int generate_typedef_flag;
- bool no_swig_lisp;
-};
-
-void CFFI::main(int argc, char *argv[]) {
- int i;
-
- Preprocessor_define("SWIGCFFI 1", 0);
- SWIG_library_directory("cffi");
- SWIG_config_file("cffi.swg");
- generate_typedef_flag = 0;
- no_swig_lisp = false;
- CWrap = false;
- for (i = 1; i < argc; i++) {
- if (!Strcmp(argv[i], "-help")) {
- Printf(stdout, "%s\n", usage);
- } else if (!strcmp(argv[i], "-cwrap")) {
- CWrap = true;
- Swig_mark_arg(i);
- } else if ((Strcmp(argv[i], "-generate-typedef") == 0)) {
- generate_typedef_flag = 1;
- Swig_mark_arg(i);
- } else if (!strcmp(argv[i], "-nocwrap")) {
- CWrap = false;
- Swig_mark_arg(i);
- } else if (!strcmp(argv[i], "-swig-lisp")) {
- no_swig_lisp = false;
- Swig_mark_arg(i);
- } else if (!strcmp(argv[i], "-noswig-lisp")) {
- no_swig_lisp = true;
- Swig_mark_arg(i);
- }
-
- }
- f_clhead = NewString("");
- f_clwrap = NewString("");
- f_cl = NewString("");
-
- allow_overloading();
-}
-
-int CFFI::top(Node *n) {
- File *f_null = NewString("");
- module = Getattr(n, "name");
-
- String *cxx_filename = Getattr(n, "outfile");
- String *lisp_filename = NewString("");
-
- Printf(lisp_filename, "%s%s.lisp", SWIG_output_directory(), module);
-
- File *f_lisp = NewFile(lisp_filename, "w", SWIG_output_files());
- if (!f_lisp) {
- FileErrorDisplay(lisp_filename);
- Exit(EXIT_FAILURE);
- }
-
- if (CPlusPlus || CWrap) {
- f_begin = NewFile(cxx_filename, "w", SWIG_output_files());
- if (!f_begin) {
- Delete(f_lisp);
- Printf(stderr, "Unable to open %s for writing\n", cxx_filename);
- Exit(EXIT_FAILURE);
- }
-
- String *clos_filename = NewString("");
- Printf(clos_filename, "%s%s-clos.lisp", SWIG_output_directory(), module);
- f_clos = NewFile(clos_filename, "w", SWIG_output_files());
- if (!f_clos) {
- Delete(f_lisp);
- Printf(stderr, "Unable to open %s for writing\n", cxx_filename);
- Exit(EXIT_FAILURE);
- }
- } else {
- f_begin = NewString("");
- f_clos = NewString("");
- }
-
- f_runtime = NewString("");
- f_cxx_header = f_runtime;
- f_cxx_wrapper = NewString("");
-
- Swig_register_filebyname("header", f_cxx_header);
- Swig_register_filebyname("wrapper", f_cxx_wrapper);
- Swig_register_filebyname("begin", f_begin);
- Swig_register_filebyname("runtime", f_runtime);
- Swig_register_filebyname("lisphead", f_clhead);
- if (!no_swig_lisp)
- Swig_register_filebyname("swiglisp", f_cl);
- else
- Swig_register_filebyname("swiglisp", f_null);
-
- Swig_banner(f_begin);
-
- Printf(f_runtime, "\n\n#ifndef SWIGCFFI\n#define SWIGCFFI\n#endif\n\n");
-
- Swig_banner_target_lang(f_lisp, ";;;");
-
- Language::top(n);
- Printf(f_lisp, "%s\n", f_clhead);
- Printf(f_lisp, "%s\n", f_cl);
- Printf(f_lisp, "%s\n", f_clwrap);
-
- Delete(f_lisp);
- Delete(f_cl);
- Delete(f_clhead);
- Delete(f_clwrap);
- Dump(f_runtime, f_begin);
- Delete(f_runtime);
- Delete(f_begin);
- Delete(f_cxx_wrapper);
- Delete(f_null);
-
- return SWIG_OK;
-}
-
-int CFFI::classHandler(Node *n) {
-#ifdef CFFI_DEBUG
- Printf(stderr, "class %s::%s\n", "some namespace", //current_namespace,
- Getattr(n, "sym:name"));
-#endif
- String *name = Getattr(n, "sym:name");
- String *kind = Getattr(n, "kind");
-
- // maybe just remove this check and get rid of the else clause below.
- if (Strcmp(kind, "struct") == 0) {
- emit_struct_union(n, false);
- return SWIG_OK;
- } else if (Strcmp(kind, "union") == 0) {
- emit_struct_union(n, true);
- return SWIG_OK;
- } else if (Strcmp(kind, "class") == 0) {
- emit_class(n);
- Language::classHandler(n);
- } else {
- Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind);
- Printf(stderr, " (name: %s)\n", name);
- Exit(EXIT_FAILURE);
- return SWIG_OK;
- }
-
- return SWIG_OK;
-}
-
-int CFFI::constructorHandler(Node *n) {
-#ifdef CFFI_DEBUG
- Printf(stderr, "constructor %s\n", Getattr(n, "name"));
- Printf(stderr, "constructor %s\n and %s", Getattr(n, "kind"), Getattr(n, "sym:name"));
-#endif
- Setattr(n, "cffi:constructorfunction", "1");
- // Let SWIG generate a global forwarding function.
- return Language::constructorHandler(n);
-}
-
-int CFFI::destructorHandler(Node *n) {
-#ifdef CFFI_DEBUG
- Printf(stderr, "destructor %s\n", Getattr(n, "name"));
-#endif
-
- // Let SWIG generate a global forwarding function.
- return Language::destructorHandler(n);
-}
-
-void CFFI::emit_defmethod(Node *n) {
- String *args_placeholder = NewStringf("");
- String *args_call = NewStringf("");
-
- ParmList *pl = Getattr(n, "parms");
- int argnum = 0;
- Node *parent = getCurrentClass();
- bool first = 0;
-
- for (Parm *p = pl; p; p = nextSibling(p), argnum++) {
- String *argname = Getattr(p, "name");
- String *ffitype = Swig_typemap_lookup("lispclass", p, "", 0);
-
- int tempargname = 0;
-
- if(!first)
- first = true;
- else
- Printf(args_placeholder, " ");
-
- if (!argname) {
- argname = NewStringf("arg%d", argnum);
- tempargname = 1;
- } else if (Strcmp(argname, "t") == 0 || Strcmp(argname, "T") == 0) {
- argname = NewStringf("t-arg%d", argnum);
- tempargname = 1;
- }
- if (Len(ffitype) > 0)
- Printf(args_placeholder, "(%s %s)", argname, ffitype);
- else
- Printf(args_placeholder, "%s", argname);
-
- if (ffitype && Strcmp(ffitype, lispify_name(parent, lispy_name(Char(Getattr(parent, "sym:name"))), "'classname")) == 0)
- Printf(args_call, " (ff-pointer %s)", argname);
- else
- Printf(args_call, " %s", argname);
-
- Delete(ffitype);
-
- if (tempargname)
- Delete(argname);
- }
-
- String *method_name = Getattr(n, "name");
- int x = Replace(method_name, "operator ", "", DOH_REPLACE_FIRST); //
-
- if (x == 1)
- Printf(f_clos, "(cl:shadow \"%s\")\n", method_name);
-
- Printf(f_clos, "(cl:defmethod %s (%s)\n (%s%s))\n\n",
- lispify_name(n, lispy_name(Char(method_name)), "'method"), args_placeholder,
- lispify_name(n, Getattr(n, "sym:name"), "'function"), args_call);
-
-}
-
-void CFFI::emit_initialize_instance(Node *n) {
- String *args_placeholder = NewStringf("");
- String *args_call = NewStringf("");
-
- ParmList *pl = Getattr(n, "parms");
- int argnum = 0;
- Node *parent = getCurrentClass();
-
- for (Parm *p = pl; p; p = nextSibling(p), argnum++) {
- String *argname = Getattr(p, "name");
- String *ffitype = Swig_typemap_lookup("lispclass", p, "", 0);
-
- int tempargname = 0;
- if (!argname) {
- argname = NewStringf("arg%d", argnum);
- tempargname = 1;
- } else if (Strcmp(argname, "t") == 0 || Strcmp(argname, "T") == 0) {
- argname = NewStringf("t-arg%d", argnum);
- tempargname = 1;
- }
- if (Len(ffitype) > 0)
- Printf(args_placeholder, " (%s %s)", argname, ffitype);
- else
- Printf(args_placeholder, " %s", argname);
-
- if (ffitype && Strcmp(ffitype, lispify_name(parent, lispy_name(Char(Getattr(parent, "sym:name"))), "'classname")) == 0)
- Printf(args_call, " (ff-pointer %s)", argname);
- else
- Printf(args_call, " %s", argname);
-
- Delete(ffitype);
-
- if (tempargname)
- Delete(argname);
- }
-
- Printf(f_clos, "(cl:defmethod initialize-instance :after ((obj %s) &key%s)\n (setf (slot-value obj 'ff-pointer) (%s%s)))\n\n",
- lispify_name(parent, lispy_name(Char(Getattr(parent, "sym:name"))), "'class"), args_placeholder,
- lispify_name(n, Getattr(n, "sym:name"), "'function"), args_call);
-
-}
-
-void CFFI::emit_setter(Node *n) {
- Node *parent = getCurrentClass();
- Printf(f_clos, "(cl:defmethod (cl:setf %s) (arg0 (obj %s))\n (%s (ff-pointer obj) arg0))\n\n",
- lispify_name(n, Getattr(n, "name"), "'method"),
- lispify_name(parent, lispy_name(Char(Getattr(parent, "sym:name"))), "'class"), lispify_name(n, Getattr(n, "sym:name"), "'function"));
-}
-
-
-void CFFI::emit_getter(Node *n) {
- Node *parent = getCurrentClass();
- Printf(f_clos, "(cl:defmethod %s ((obj %s))\n (%s (ff-pointer obj)))\n\n",
- lispify_name(n, Getattr(n, "name"), "'method"),
- lispify_name(parent, lispy_name(Char(Getattr(parent, "sym:name"))), "'class"), lispify_name(n, Getattr(n, "sym:name"), "'function"));
-}
-
-int CFFI::memberfunctionHandler(Node *n) {
- // Let SWIG generate a global forwarding function.
- Setattr(n, "cffi:memberfunction", "1");
- return Language::memberfunctionHandler(n);
-}
-
-int CFFI::membervariableHandler(Node *n) {
- // Let SWIG generate a get/set function pair.
- Setattr(n, "cffi:membervariable", "1");
- return Language::membervariableHandler(n);
-}
-
-
-void CFFI::checkConstraints(ParmList *parms, Wrapper *f) {
- Parm *p = parms;
- while (p) {
- String *tm = Getattr(p, "tmap:check");
- if (!tm) {
- p = nextSibling(p);
- } else {
- tm = Copy(tm);
- Replaceall(tm, "$input", Getattr(p, "emit:input"));
- Printv(f->code, tm, "\n\n", NULL);
- Delete(tm);
- p = Getattr(p, "tmap:check:next");
- }
- }
-}
-
-void CFFI::argout(ParmList *parms, Wrapper *f) {
- Parm *p = parms;
- while (p) {
- String *tm = Getattr(p, "tmap:argout");
- if (!tm) {
- p = nextSibling(p);
- } else {
- tm = Copy(tm);
- Replaceall(tm, "$result", Swig_cresult_name());
- Replaceall(tm, "$input", Getattr(p, "emit:input"));
- Printv(f->code, tm, "\n", NULL);
- Delete(tm);
- p = Getattr(p, "tmap:argout:next");
- }
- }
-}
-
-String *CFFI::freearg(ParmList *parms) {
- String *ret = NewString("");
- Parm *p = parms;
- while (p) {
- String *tm = Getattr(p, "tmap:freearg");
- if (!tm) {
- p = nextSibling(p);
- } else {
- tm = Copy(tm);
- Replaceall(tm, "$input", Getattr(p, "emit:input"));
- Printv(ret, tm, "\n", NULL);
- Delete(tm);
- p = Getattr(p, "tmap:freearg:next");
- }
- }
- return ret;
-}
-
-void CFFI::cleanupFunction(Node *n, Wrapper *f, ParmList *parms) {
- String *cleanup = freearg(parms);
- Printv(f->code, cleanup, NULL);
-
- if (GetFlag(n, "feature:new")) {
- String *tm = Swig_typemap_lookup("newfree", n, Swig_cresult_name(), 0);
- if (tm) {
- Printv(f->code, tm, "\n", NULL);
- Delete(tm);
- }
- }
-
- Replaceall(f->code, "$cleanup", cleanup);
- Delete(cleanup);
-
- Replaceall(f->code, "$symname", Getattr(n, "sym:name"));
-}
-
-int CFFI::functionWrapper(Node *n) {
-
- ParmList *parms = Getattr(n, "parms");
- String *iname = Getattr(n, "sym:name");
- Wrapper *f = NewWrapper();
-
- String *raw_return_type = Swig_typemap_lookup("ctype", n, "", 0);
- SwigType *return_type = Swig_cparse_type(raw_return_type);
- SwigType *resolved = SwigType_typedef_resolve_all(return_type);
- int is_void_return = (Cmp(resolved, "void") == 0);
- Delete(resolved);
-
- if (!is_void_return) {
- String *lresult_init = NewStringf("lresult = (%s)0", raw_return_type);
- Wrapper_add_localv(f, "lresult", raw_return_type, lresult_init, NIL);
- Delete(lresult_init);
- }
-
- String *overname = 0;
- if (Getattr(n, "sym:overloaded")) {
- overname = Getattr(n, "sym:overname");
- } else {
- if (!addSymbol(iname, n)) {
- DelWrapper(f);
- return SWIG_ERROR;
- }
- }
-
- String *wname = Swig_name_wrapper(iname);
- if (overname) {
- Append(wname, overname);
- }
- Setattr(n, "wrap:name", wname);
-
- // Emit all of the local variables for holding arguments.
- emit_parameter_variables(parms, f);
-
- // Attach the standard typemaps
- Swig_typemap_attach_parms("ctype", parms, f);
- emit_attach_parmmaps(parms, f);
-
- int num_arguments = emit_num_arguments(parms);
- String *name_and_parms = NewStringf("%s (", wname);
- int i;
- Parm *p;
- int gencomma = 0;
-
-#ifdef CFFI_DEBUG
- Printf(stderr, "function - %s - %d\n", Getattr(n, "name"), num_arguments);
-#endif
-
- for (i = 0, p = parms; i < num_arguments; i++) {
-
- while (checkAttribute(p, "tmap:in:numinputs", "0")) {
- p = Getattr(p, "tmap:in:next");
- }
-
- SwigType *c_parm_type = Swig_cparse_type(Getattr(p, "tmap:ctype"));
- String *arg = NewStringf("l%s", Getattr(p, "lname"));
-
- // Emit parameter declaration
- if (gencomma)
- Printf(name_and_parms, ", ");
- String *parm_decl = SwigType_str(c_parm_type, arg);
- Printf(name_and_parms, "%s", parm_decl);
-#ifdef CFFI_DEBUG
- Printf(stderr, " param: %s\n", parm_decl);
-#endif
- Delete(parm_decl);
- gencomma = 1;
-
- // Emit parameter conversion code
- String *parm_code = Getattr(p, "tmap:in");
- {
- Replaceall(parm_code, "$input", arg);
- Setattr(p, "emit:input", arg);
- Printf(f->code, "%s\n", parm_code);
- p = Getattr(p, "tmap:in:next");
- }
-
- Delete(arg);
- }
- Printf(name_and_parms, ")");
-
- // Emit the function definition
- String *signature = SwigType_str(return_type, name_and_parms);
- Printf(f->def, "EXPORT %s {", signature);
-
- checkConstraints(parms, f);
-
- Printf(f->code, " try {\n");
-
- String *actioncode = emit_action(n);
-
- String *result_convert = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode);
- if (result_convert) {
- Replaceall(result_convert, "$result", "lresult");
- Printf(f->code, "%s\n", result_convert);
- }
- Delete(result_convert);
-
- argout(parms, f);
-
- cleanupFunction(n, f, parms);
-
- /* See if there is any return cleanup code */
- String *tm = 0;
- if ((tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0))) {
- Printf(f->code, "%s\n", tm);
- Delete(tm);
- }
-
- if (!is_void_return) {
- Printf(f->code, " return lresult;\n");
- }
-
- emit_return_variable(n, Getattr(n, "type"), f);
-
- Printf(f->code, " } catch (...) {\n");
- if (!is_void_return)
- Printf(f->code, " return (%s)0;\n", raw_return_type);
- Printf(f->code, " }\n");
- Printf(f->code, "}\n");
-
- if (CPlusPlus)
- Wrapper_print(f, f_runtime);
-
- if (CPlusPlus) {
- emit_defun(n, wname);
- if (Getattr(n, "cffi:memberfunction"))
- emit_defmethod(n);
- else if (Getattr(n, "cffi:membervariable")) {
- if (Getattr(n, "memberget"))
- emit_getter(n);
- else if (Getattr(n, "memberset"))
- emit_setter(n);
- }
- else if (Getattr(n, "cffi:constructorfunction")) {
- emit_initialize_instance(n);
- }
- } else
- emit_defun(n, iname);
-
- // if (!overloaded || !Getattr(n, "sym:nextSibling")) {
- // update_package_if_needed(n);
- // emit_buffered_defuns(n);
- // // this is the last overload.
- // if (overloaded) {
- // emit_dispatch_defun(n);
- // }
- // }
-
- Delete(wname);
- DelWrapper(f);
-
- return SWIG_OK;
-}
-
-
-void CFFI::emit_defun(Node *n, String *name) {
- String *func_name = Getattr(n, "sym:name");
-
- ParmList *pl = Getattr(n, "parms");
-
- int argnum = 0;
-
- func_name = lispify_name(n, func_name, "'function");
-
- emit_inline(n, func_name);
-
- Printf(f_cl, "\n(cffi:defcfun (\"%s\" %s)", name, func_name);
- String *ffitype = Swig_typemap_lookup("cout", n, ":pointer", 0);
-
- Printf(f_cl, " %s", ffitype);
- Delete(ffitype);
-
- for (Parm *p = pl; p; p = nextSibling(p), argnum++) {
-
- if (SwigType_isvarargs(Getattr(p, "type"))) {
- Printf(f_cl, "\n %s", NewString("&rest"));
- continue;
- }
-
- String *argname = Getattr(p, "name");
-
- ffitype = Swig_typemap_lookup("cin", p, "", 0);
-
- int tempargname = 0;
- if (!argname) {
-
- argname = NewStringf("arg%d", argnum);
- tempargname = 1;
- } else if (Strcmp(argname, "t") == 0 || Strcmp(argname, "T") == 0) {
- argname = NewStringf("t_arg%d", argnum);
- tempargname = 1;
- }
-
- Printf(f_cl, "\n (%s %s)", argname, ffitype);
-
- Delete(ffitype);
-
- if (tempargname)
- Delete(argname);
- }
- Printf(f_cl, ")\n"); /* finish arg list */
-
- emit_export(n, func_name);
-}
-
-
-int CFFI::constantWrapper(Node *n) {
- String *type = Getattr(n, "type");
- String *converted_value;
- if (SwigType_type(type) == T_STRING) {
- converted_value = NewString(Getattr(n, "rawval"));
- } else {
- converted_value = convert_literal(Getattr(n, "value"), type);
- }
-
- String *name = lispify_name(n, Getattr(n, "sym:name"), "'constant");
-
- if (Strcmp(name, "t") == 0 || Strcmp(name, "T") == 0)
- name = NewStringf("t_var");
-
- Printf(f_cl, "\n(cl:defconstant %s %s)\n", name, converted_value);
- Delete(converted_value);
-
- emit_export(n, name);
- return SWIG_OK;
-}
-
-int CFFI::variableWrapper(Node *n) {
- String *var_name = Getattr(n, "sym:name");
- String *lisp_type = Swig_typemap_lookup("cin", n, "", 0);
- String *lisp_name = lispify_name(n, var_name, "'variable");
-
- if (Strcmp(lisp_name, "t") == 0 || Strcmp(lisp_name, "T") == 0)
- lisp_name = NewStringf("t_var");
-
- Printf(f_cl, "\n(cffi:defcvar (\"%s\" %s)\n %s)\n", var_name, lisp_name, lisp_type);
-
- Delete(lisp_type);
-
- emit_export(n, lisp_name);
- return SWIG_OK;
-}
-
-int CFFI::typedefHandler(Node *n) {
- if (generate_typedef_flag && strncmp(Char(Getattr(n, "type")), "enum", 4)) {
- String *lisp_name = lispify_name(n, Getattr(n, "name"), "'typename");
- Printf(f_cl, "\n(cffi:defctype %s %s)\n", lisp_name, Swig_typemap_lookup("cin", n, "", 0));
- emit_export(n, lisp_name);
- }
- return Language::typedefHandler(n);
-}
-
-int CFFI::enumDeclaration(Node *n) {
- if (getCurrentClass() && (cplus_mode != PUBLIC))
- return SWIG_NOWRAP;
-
- String *name = Getattr(n, "sym:name");
- bool slot_name_keywords;
- String *lisp_name = 0;
- if (name && Len(name) != 0) {
- lisp_name = lispify_name(n, name, "'enumname");
- if (GetFlag(n, "feature:bitfield")) {
- Printf(f_cl, "\n(cffi:defbitfield %s", lisp_name);
- } else {
- Printf(f_cl, "\n(cffi:defcenum %s", lisp_name);
- }
- slot_name_keywords = true;
-
- //Registering the enum name to the cin and cout typemaps
- Parm *pattern = NewParm(name, NULL, n);
- Swig_typemap_register("cin", pattern, lisp_name, NULL, NULL);
- Swig_typemap_register("cout", pattern, lisp_name, NULL, NULL);
- Delete(pattern);
- //Registering with the kind, i.e., enum
- pattern = NewParm(NewStringf("enum %s", name), NULL, n);
- Swig_typemap_register("cin", pattern, lisp_name, NULL, NULL);
- Swig_typemap_register("cout", pattern, lisp_name, NULL, NULL);
- Delete(pattern);
-
- } else {
- Printf(f_cl, "\n(defanonenum %s", name);
- slot_name_keywords = false;
- }
-
- for (Node *c = firstChild(n); c; c = nextSibling(c)) {
-
- String *slot_name = lispify_name(c, Getattr(c, "name"), "'enumvalue", slot_name_keywords);
- String *value = Getattr(c, "enumvalue");
-
- if (!value || GetFlag(n, "feature:bitfield:ignore_values"))
- Printf(f_cl, "\n\t%s", slot_name);
- else {
- String *type = Getattr(c, "type");
- String *converted_value = convert_literal(value, type);
- Printf(f_cl, "\n\t(%s #.%s)", slot_name, converted_value);
- Delete(converted_value);
- }
- Delete(value);
- }
-
- Printf(f_cl, ")\n");
-
- // No need to export keywords
- if (lisp_name && Len(lisp_name) != 0) {
- emit_export(n, lisp_name);
- } else {
- for (Node *c = firstChild(n); c; c = nextSibling(c))
- emit_export(c, lispify_name(c, Getattr(c, "name"), "'enumvalue"));
- }
-
- return SWIG_OK;
-}
-void CFFI::emit_class(Node *n) {
-
-#ifdef CFFI_WRAP_DEBUG
- Printf(stderr, "emit_class: ENTER... '%s'(%p)\n", Getattr(n, "sym:name"), n);
-#endif
-
- String *name = Getattr(n, "sym:name");
- String *lisp_name = lispify_name(n, lispy_name(Char(name)), "'classname");
-
- String *bases = Getattr(n, "bases");
- String *supers = NewString("(");
- if (bases) {
- int first = 1;
- for (Iterator i = First(bases); i.item; i = Next(i)) {
- if (!first)
- Printf(supers, " ");
- String *s = Getattr(i.item, "name");
- Printf(supers, "%s", lispify_name(i.item, lispy_name(Char(s)), "'classname"));
- }
- } else {
- // Printf(supers,"ff:foreign-pointer");
- }
-
- Printf(supers, ")");
- Printf(f_clos, "\n(cl:defclass %s%s", lisp_name, supers);
- Printf(f_clos, "\n ((ff-pointer :reader ff-pointer)))\n\n");
-
- Parm *pattern = NewParm(Getattr(n, "name"), NULL, n);
-
- Swig_typemap_register("lispclass", pattern, lisp_name, NULL, NULL);
- SwigType_add_pointer(Getattr(pattern, "type"));
- Swig_typemap_register("lispclass", pattern, lisp_name, NULL, NULL);
- SwigType_add_qualifier(Getattr(pattern, "type"), "const");
- Swig_typemap_register("lispclass", pattern, lisp_name, NULL, NULL);
- SwigType_del_pointer(Getattr(pattern, "type"));
- SwigType_add_reference(Getattr(pattern, "type"));
- Swig_typemap_register("lispclass", pattern, lisp_name, NULL, NULL);
-
-#ifdef CFFI_WRAP_DEBUG
- Printf(stderr, " pattern %s name %s .. ... %s .\n", pattern, lisp_name);
-#endif
-
- Delete(pattern);
-
- // Walk children to generate type definition.
- String *slotdefs = NewString(" ");
-
-#ifdef CFFI_WRAP_DEBUG
- Printf(stderr, " walking children...\n");
-#endif
-
- Node *c;
- for (c = firstChild(n); c; c = nextSibling(c)) {
- String *storage_type = Getattr(c, "storage");
- if ((!Strcmp(nodeType(c), "cdecl") && (!storage_type || Strcmp(storage_type, "typedef")))) {
- String *access = Getattr(c, "access");
-
- // hack. why would decl have a value of "variableHandler" and now "0"?
- String *childDecl = Getattr(c, "decl");
- // Printf(stderr,"childDecl = '%s' (%s)\n", childDecl, Getattr(c,"view"));
- if (!Strcmp(childDecl, "0"))
- childDecl = NewString("");
-
- SwigType *childType = NewStringf("%s%s", childDecl,
- Getattr(c, "type"));
- String *cname = (access && Strcmp(access, "public")) ? NewString("nil") : Copy(Getattr(c, "name"));
-
- if (!SwigType_isfunction(childType)) {
- // Printf(slotdefs, ";;; member functions don't appear as slots.\n ");
- // Printf(slotdefs, ";; ");
- // String *ns = listify_namespace(Getattr(n, "cffi:package"));
- String *ns = NewString("");
-#ifdef CFFI_WRAP_DEBUG
- Printf(stderr, "slot name = '%s' ns = '%s' class-of '%s' and type = '%s'\n", cname, ns, name, childType);
-#endif
- Printf(slotdefs, "(#.(swig-insert-id \"%s\" %s :type :slot :class \"%s\") %s)", cname, ns, name, childType); //compose_foreign_type(childType)
- Delete(ns);
- if (access && Strcmp(access, "public"))
- Printf(slotdefs, " ;; %s member", access);
-
- Printf(slotdefs, "\n ");
- }
- Delete(childType);
- Delete(cname);
- }
- }
-
-
- // String *ns_list = listify_namespace(Getattr(n,"cffi:namespace"));
- // update_package_if_needed(n,f_clhead);
- // Printf(f_clos,
- // "(swig-def-foreign-class \"%s\"\n %s\n (:%s\n%s))\n\n",
- // name, supers, kind, slotdefs);
-
- Delete(supers);
- // Delete(ns_list);
-
- // Parm *pattern = NewParm(name, NULL, n);
- // Swig_typemap_register("cin",pattern,lisp_name,NULL,NULL);
- //Swig_typemap_register("cout",pattern,lisp_name,NULL,NULL);
- //Delete(pattern);
-
-#ifdef CFFI_WRAP_DEBUG
- Printf(stderr, "emit_class: EXIT\n");
-#endif
-}
-
-// Includes structs
-void CFFI::emit_struct_union(Node *n, bool un = false) {
-#ifdef CFFI_DEBUG
- Printf(stderr, "struct/union %s\n", Getattr(n, "name"));
- Printf(stderr, "struct/union %s\n and %s", Getattr(n, "kind"), Getattr(n, "sym:name"));
-#endif
-
- String *name = Getattr(n, "sym:name");
- String *kind = Getattr(n, "kind");
-
- if (Strcmp(kind, "struct") != 0 && Strcmp(kind, "union") != 0) {
- Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind);
- Printf(stderr, " (name: %s)\n", name);
- Exit(EXIT_FAILURE);
- }
- String *lisp_name = lispify_name(n, name, "'classname");
-
- //Register the struct/union name to the cin and cout typemaps
-
- Parm *pattern = NewParm(name, NULL, n);
- Swig_typemap_register("cin", pattern, lisp_name, NULL, NULL);
- Swig_typemap_register("cout", pattern, lisp_name, NULL, NULL);
- Delete(pattern);
- //Registering with the kind, i.e., struct or union
- pattern = NewParm(NewStringf("%s %s", kind, name), NULL, n);
- Swig_typemap_register("cin", pattern, lisp_name, NULL, NULL);
- Swig_typemap_register("cout", pattern, lisp_name, NULL, NULL);
- Delete(pattern);
-
- if (un) {
- Printf(f_cl, "\n(cffi:defcunion %s", lisp_name);
- } else
- Printf(f_cl, "\n(cffi:defcstruct %s", lisp_name);
-
-
- for (Node *c = firstChild(n); c; c = nextSibling(c)) {
-#ifdef CFFI_DEBUG
- Printf(stderr, "struct/union %s\n", Getattr(c, "name"));
- Printf(stderr, "struct/union %s and %s \n", Getattr(c, "kind"), Getattr(c, "sym:name"));
-#endif
-
- if (Strcmp(nodeType(c), "cdecl")) {
- //C declaration ignore
- // Printf(stderr, "Structure %s has a slot that we can't deal with.\n",
- // name);
- // Printf(stderr, "nodeType: %s, name: %s, type: %s\n",
- // nodeType(c),
- // Getattr(c, "name"),
- // Getattr(c, "type"));
- // Exit(EXIT_FAILURE);
- } else {
- SwigType *childType = NewStringf("%s%s", Getattr(c, "decl"), Getattr(c, "type"));
-
- Node *node = NewHash();
- Setattr(node, "type", childType);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *tm = Swig_typemap_lookup("cin", node, "", 0);
-
- String *typespec = tm ? NewString(tm) : NewString("");
-
- String *slot_name = lispify_name(c, Getattr(c, "sym:name"), "'slotname");
- if (slot_name && (Strcmp(slot_name, "t") == 0 || Strcmp(slot_name, "T") == 0))
- slot_name = NewStringf("t_var");
-
- if (SwigType_isarray(childType) && SwigType_array_ndim(childType) == 1) {
- String *dim = SwigType_array_getdim(childType, 0);
- Printf(f_cl, "\n\t(%s %s :count %s)", slot_name, typespec, dim);
- Delete(dim);
- } else
- Printf(f_cl, "\n\t(%s %s)", slot_name, typespec);
-
- Delete(node);
- Delete(childType);
- Delete(typespec);
- }
- }
-
- Printf(f_cl, ")\n");
-
- emit_export(n, lisp_name);
- for (Node *child = firstChild(n); child; child = nextSibling(child)) {
- if (!Strcmp(nodeType(child), "cdecl")) {
- emit_export(child, lispify_name(child, Getattr(child, "sym:name"), "'slotname"));
- }
- }
-
- /* Add this structure to the known lisp types */
- //Printf(stdout, "Adding %s foreign type\n", name);
- // add_defined_foreign_type(name);
-
-}
-
-void CFFI::emit_export(Node *n, String *name) {
- if (GetInt(n, "feature:export")) {
- String* package = Getattr(n, "feature:export:package");
- Printf(f_cl, "\n(cl:export '%s%s%s)\n", name, package ? " " : "",
- package ? package : "");
- }
-}
-
-void CFFI::emit_inline(Node *n, String *name) {
- if (GetInt(n, "feature:inline"))
- Printf(f_cl, "\n(cl:declaim (cl:inline %s))\n", name);
-}
-
-String *CFFI::lispify_name(Node *n, String *ty, const char *flag, bool kw) {
- String *intern_func = Getattr(n, "feature:intern_function");
- if (intern_func) {
- if (Strcmp(intern_func, "1") == 0)
- intern_func = NewStringf("swig-lispify");
- return NewStringf("#.(%s \"%s\" %s%s)", intern_func, ty, flag, kw ? " :keyword" : "");
- } else if (kw)
- return NewStringf(":%s", ty);
- else
- return ty;
-}
-
-/* utilities */
-/* returns new string w/ parens stripped */
-String *CFFI::strip_parens(String *string) {
- char *s = Char(string);
- int len = Len(string);
-
- if (len == 0 || s[0] != '(' || s[len - 1] != ')') {
- return NewString(string);
- }
-
- return NewStringWithSize(s + 1, len - 2);
-}
-
-String *CFFI::trim(String *str) {
- char *c = Char(str);
- while (*c != '\0' && isspace((int) *c))
- ++c;
- String *result = NewString(c);
- Chop(result);
- return result;
-}
-
-String *CFFI::infix_to_prefix(String *val, char split_op, const String *op, String *type) {
- List *ored = Split(val, split_op, -1);
-
- // some float hackery
- //i don't understand it, if you do then please explain
- // if ( ((split_op == '+') || (split_op == '-')) && Len(ored) == 2 &&
- // (SwigType_type(type) == T_FLOAT || SwigType_type(type) == T_DOUBLE ||
- // SwigType_type(type) == T_LONGDOUBLE) ) {
- // // check that we're not splitting a float
- // String *possible_result = convert_literal(val, type, false);
- // if (possible_result) return possible_result;
-
- // }
-
- // try parsing the split results. if any part fails, kick out.
- bool part_failed = false;
- if (Len(ored) > 1) {
- String *result = NewStringf("(%s", op);
- for (Iterator i = First(ored); i.item; i = Next(i)) {
- String *converted = convert_literal(i.item, type);
- if (converted) {
- Printf(result, " %s", converted);
- Delete(converted);
- } else {
- part_failed = true;
- break;
- }
- }
- Printf(result, ")");
- Delete(ored);
- return part_failed ? 0 : result;
- } else {
- Delete(ored);
- }
- return 0;
-}
-
-/* To be called by code generating the lisp interface
- Will return a String containing the literal based on type.
- Will return null if there are problems.
-
- try_to_split defaults to true (see stub above).
-*/
-String *CFFI::convert_literal(String *literal, String *type, bool try_to_split) {
- String *num_param = Copy(literal);
- String *trimmed = trim(num_param);
- String *num = strip_parens(trimmed), *res = 0;
- Delete(trimmed);
- char *s = Char(num);
-
- // very basic parsing of infix expressions.
- if (try_to_split) {
- if ((res = infix_to_prefix(num, '|', "cl:logior", type)))
- return res;
- if ((res = infix_to_prefix(num, '&', "cl:logand", type)))
- return res;
- if ((res = infix_to_prefix(num, '^', "cl:logxor", type)))
- return res;
- if ((res = infix_to_prefix(num, '*', "cl:*", type)))
- return res;
- if ((res = infix_to_prefix(num, '/', "cl:/", type)))
- return res;
- if ((res = infix_to_prefix(num, '+', "cl:+", type)))
- return res;
- if ((res = infix_to_prefix(num, '-', "cl:-", type)))
- return res;
- }
-
- if (SwigType_type(type) == T_FLOAT || SwigType_type(type) == T_DOUBLE || SwigType_type(type) == T_LONGDOUBLE) {
- // Use CL syntax for float literals
-
- // careful. may be a float identifier or float constant.
- char *num_start = Char(num);
- char *num_end = num_start + strlen(num_start) - 1;
-
- bool is_literal = isdigit(*num_start) || (*num_start == '.') || (*num_start == '+') || (*num_start == '-');
-
- String *lisp_exp = 0;
- if (is_literal) {
- if (*num_end == 'f' || *num_end == 'F') {
- lisp_exp = NewString("f");
- } else {
- lisp_exp = NewString("d");
- }
-
- if (*num_end == 'l' || *num_end == 'L' || *num_end == 'f' || *num_end == 'F') {
- *num_end = '\0';
- num_end--;
- }
-
- int exponents = Replaceall(num, "e", lisp_exp) + Replaceall(num, "E", lisp_exp);
-
- if (!exponents)
- Printf(num, "%s0", lisp_exp);
-
- if (exponents > 1 || (exponents + Replaceall(num, ".", ".") == 0)) {
- Delete(num);
- num = 0;
- }
- }
- return num;
- } else if (SwigType_type(type) == T_CHAR) {
- /* Use CL syntax for character literals */
- String* result = NewStringf("#\\%s", s);
- Delete(num);
- return result;
- } else if (SwigType_type(type) == T_STRING) {
- /* Use CL syntax for string literals */
- String* result = NewStringf("\"%s\"", num_param);
- Delete(num);
- return result;
- } else if (SwigType_type(type) == T_INT || SwigType_type(type) == T_UINT) {
- // Printf(stderr, "Is a T_INT or T_UINT %s, before replaceall\n", s);
- const char *num_start = Char(num);
- bool is_literal = isdigit(*num_start) || (*num_start == '.') || (*num_start == '+') || (*num_start == '-');
- if (is_literal) {
- Replaceall(num, "u", "");
- Replaceall(num, "U", "");
- Replaceall(num, "l", "");
- Replaceall(num, "L", "");
- }
-
- int i, j;
- if (sscanf(s, "%d >> %d", &i, &j) == 2) {
- String* result = NewStringf("(cl:ash %d -%d)", i, j);
- Delete(num);
- return result;
- } else if (sscanf(s, "%d << %d", &i, &j) == 2) {
- String* result = NewStringf("(cl:ash %d %d)", i, j);
- Delete(num);
- return result;
- }
- }
-
- if (Len(num) >= 2 && s[0] == '0') { /* octal or hex */
- if (s[1] == 'x'){
- Replace(num,"0","#",DOH_REPLACE_FIRST);
- }
- else{
- Replace(num,"0","#o",DOH_REPLACE_FIRST);
- }
- }
- return num;
-}
-
-//less flexible as it does the conversion in C, the lispify name does the conversion in lisp
-String *CFFI::lispy_name(char *name) {
- bool helper = false;
- String *new_name = NewString("");
- for (unsigned int i = 0; i < strlen(name); i++) {
- if (name[i] == '_' || name[i] == '-') {
- Printf(new_name, "%c", '-');
- helper = false;
- } else if (name[i] >= 'A' && name[i] <= 'Z') {
- if (helper)
- Printf(new_name, "%c", '-');
- Printf(new_name, "%c", ('a' + (name[i] - 'A')));
- helper = false;
- } else {
- helper = true;
- Printf(new_name, "%c", name[i]);
- }
- }
- return new_name;
-}
-
-extern "C" Language *swig_cffi(void) {
- return new CFFI();
-}
View Lorry Controller Status