diff --git a/CHANGES.current b/CHANGES.current
index 8306b17e2..de9af55f2 100644
--- a/CHANGES.current
+++ b/CHANGES.current
@@ -7,6 +7,11 @@ the issue number to the end of the URL: https://github.com/swig/swig/issues/
Version 4.1.0 (in progress)
===========================
+2021-05-13: olly
+ [Allegrocl] #2009 Remove code for Allegro Common Lisp. We dropped
+ support for it in SWIG 4.0.0 and nobody has stepped forward to
+ revive it in over 2 years.
+
2021-05-04: olly
[PHP] #1982 #1457 https://sourceforge.net/p/swig/bugs/1339/
SWIG now only use PHP's C API to implement its wrappers, and no
diff --git a/Doc/Manual/Allegrocl.html b/Doc/Manual/Allegrocl.html
deleted file mode 100644
index 4069ecd8b..000000000
--- a/Doc/Manual/Allegrocl.html
+++ /dev/null
@@ -1,2150 +0,0 @@
-
-
-
-SWIG and Allegro Common Lisp
-
-This chapter describes SWIG's support of Allegro Common Lisp. Allegro
-CL is a full-featured implementation of the Common Lisp language
-standard that includes many vendor-specific enhancements and add-on
-modules for increased usability.
-
-
-
-One such module included in Allegro CL is the Foreign Functions
-Interface (FFI). This module, tailored primarily toward interfacing
-with C/C++ and, historically, Fortran, provides a means by which
-compiled foreign code can be loaded into a running lisp
-environment and executed. The interface supports the calling of
-foreign functions and methods, allows for executing lisp routines
-from foreign code (callbacks), and the passing of data between foreign
-and lisp code.
-
-
-
-The goal of this module is to make it possible to quickly generate the
-necessary foreign function definitions so one can make use of C/C++
-foreign libraries directly from lisp without the tedium of having to
-code them by hand. When necessary, it will also generate further C/C++
-code that will need to be linked with the intended library for proper
-interfacing from lisp. It has been designed with an eye toward
-flexibility. Some foreign function calls may release the heap, while
-other should not. Some foreign functions should automatically convert
-lisp strings into native strings, while others should not. These
-adjustments and many more are possible with the current module.
-
-
-
-It is significant to note that, while this is a vendor-specific
-module, we would like to acknowledge the current and ongoing
-work by developers in the open source lisp community that are
-working on similar interfaces to implementation-independent
-foreign function interfaces (CFFI, for example). Such
-work can only benefit the lisp community, and we would not
-be unhappy to see some enterprising folk use this work to add
-to it.
-
-
-
-
-
-
-
-
-
-If you're reading this, you must have some library you need to
-generate an interface for. In order for SWIG to do this work, however,
-it needs a bit of information about how it should go about creating
-your interface, and what you are interfacing to.
-
-
-
-SWIG expects a description of what in the foreign interface you wish
-to connect to. It must consisting of C/C++ declarations and special
-SWIG directives. SWIG can be furnished with a header file, but an
-interface can also be generated without library headers by supplying a
-simple text file--called the interface file, which is typically named
-with a .i extension--containing any foreign declarations of
-identifiers you wish to use. The most common approach is to use an
-interface file with directives to parse the needed headers. A straight
-parse of library headers will result in usable code, but SWIG
-directives provides much freedom in how a user might tailor the
-generated code to their needs or style of coding.
-
-
-
-Note that SWIG does not require any function definitions; the
-declarations of those functions is all that is necessary. Be careful
-when tuning the interface as it is quite possible to generate code
-that will not load or compile.
-
-
-
-An example interface file is shown below. It makes use of two SWIG
-directives, one of which requests that the declarations in a header
-file be used to generate part of the interface, and also includes an
-additional declaration to be added.
-
-example.i
-
-%module example
-
-%include "header.h"
-
-int fact(int n);
-
-
The contents of header.h are very simple:
-header.h
-
-int fact(char *statement); // pass it a fact, and it will rate it.
-
-
The contents of example.cl will look like this:
-
-example.cl
-
-(defpackage :example
- (:use :common-lisp :swig :ff :excl))
-
- ... helper routines for defining the interface ...
-
-(swig-in-package ())
-
-(swig-defun ("fact")
- ((PARM0_statement cl:string (* :char) ))
- (:returning (:int )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_statement))
- (swig-ff-call SWIG_arg0)))
-
-(swig-defun ("fact")
- ((PARM0_n cl:integer :int ))
- (:returning (:int )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_n))
- (swig-ff-call SWIG_arg0)))
-
-(swig-dispatcher ("fact" :type :function :arities (1)))
-
-
-The generated file contains calls to internal swig helper
-functions. In this case there are two calls to swig-defun.
-These calls will expand into code that will make the appropriate
-definitions using the Allegro FFI. Note also, that this code is
-erroneous . Function overloading is not supported in C, and this
-code will not compile even though SWIG did not complain.
-
-
-
-In order to generate a C interface to Allegro CL using this code run
-swig using the -allegrocl option, as below:
-
-
-
-
-% swig -allegrocl example.i
-
-
-When building an interface to C++ code, include the -c++ option:
-
-
-
-
-% swig -allegrocl -c++ example.i
-
-
-As a result of running one of the above commands, a file named example.cl
-will be generated containing the lisp side of the interface. As well, a file
-example_wrap.cxx is also generated, containing C/C++ wrapper code to
-facilitate access to C++ methods, enumeration values, and constant values.
-Wrapper functions are necessary in C++ due to the lack of a standard for mangling
-the names of symbols across all C++ compilers. These wrapper functions are
-exported from the shared library as appropriate, using the C name mangling
-convention. The lisp code that is generated will interface to your foreign
-library through these wrappers.
-
-
-
-It is possible to disable the creation of the .cxx file when generating a C
-interface by using the -nocwrap command-line argument. For interfaces that
-don't contain complex enum or constant expressions, contain nested struct/union
-declarations, or doesn't need to use many of the SWIG customization featuers,
-this will result in a more streamlined, direct interface to the
-intended module.
-
-
-
-The generated wrapper file is below. It contains very simple
-wrappers by default, that simply pass the arguments to the
-actual function.
-
-
-example_wrap.i
-
- ... lots of SWIG internals ...
-
-EXPORT int ACL___fact__SWIG_0 (char *larg1) {
- int lresult = (int)0 ;
- char *arg1 = (char *) 0 ;
- int result;
-
- arg1 = larg1;
- try {
- result = (int)fact(arg1);
-
- lresult = result;
- return lresult;
- } catch (...) {
- return (int)0;
- }
-}
-
-
-EXPORT int ACL___fact__SWIG_1 (int larg1) {
- int lresult = (int)0 ;
- int arg1 ;
- int result;
-
- arg1 = larg1;
- try {
- result = (int)fact(arg1);
-
- lresult = result;
- return lresult;
- } catch (...) {
- return (int)0;
- }
-}
-
-
-And again, the generated lisp code. Note that it differs from
-what is generated when parsing C code:
-
-
-
-
- ...
-
-(swig-in-package ())
-
-(swig-defmethod ("fact" "ACL___fact__SWIG_0" :type :function :arity 1)
- ((PARM0_statement cl:string (* :char) ))
- (:returning (:int )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_statement))
- (swig-ff-call SWIG_arg0)))
-
-(swig-defmethod ("fact" "ACL___fact__SWIG_1" :type :function :arity 1)
- ((PARM0_n cl:integer :int ))
- (:returning (:int )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_n))
- (swig-ff-call SWIG_arg0)))
-
-(swig-dispatcher ("fact" :type :function :arities (1)))
-
-
In this case, the interface generates two swig-defmethod forms and
-a swig-dispatcher form. This provides a single functional interface for
-all overloaded routines. A more detailed description of this features
-is to be found in the section titled Function overloading/Parameter defaulting .
-
-
-In order to load a C++ interface, you will need to build a shared library
-from example_wrap.cxx. Be sure to link in the actual library you created
-the interface for, as well as any other dependent shared libraries. For
-example, if you intend to be able to call back into lisp, you will also
-need to link in the Allegro shared library. The library you create from
-the C++ wrapper will be what you then load into Allegro CL.
-
-
-
-
-
-
-There are three Allegro CL specific command-line option:
-
-
-
-
-swig -allegrocl [ options ] filename
-
- -identifier-converter [name] - Binds the variable swig:*swig-identifier-convert*
- in the generated .cl file to name .
- This function is used to generate symbols
- for the lisp side of the interface.
-
- -cwrap - [default] Generate a .cxx file containing C wrapper function when
- wrapping C code. The interface generated is similar to what is
- done for C++ code.
- -nocwrap - Explicitly turn off generation of .cxx wrappers for C code. Reasonable
- for modules with simple interfaces. Can not handle all legal enum
- and constant constructs, or take advantage of SWIG customization features.
-
- -isolate - With this command-line argument, all lisp helper functions are defined
- in a unique package named swig.<module-name> rather than
- swig . This prevents conflicts when the module is
- intended to be used with other swig generated interfaces that may,
- for instance, make use of different identifier converters.
-
-
-See Section 17.5 Identifier converter
-functions for more details.
-
-
-
-
-
-
-It is often necessary to include user-defined code into the
-automatically generated interface files. For example, when building
-a C++ interface, example_wrap.cxx will likely not compile unless
-you add a #include "header.h" directive. This can be done
-using the SWIG %insert(section) %{ ...code... %} directive:
-
-
-
-
-%module example
-
-%{
-#include "header.h"
-%}
-
-%include "header.h"
-
-int fact(int n);
-
-
-Additional sections have been added for inserting into the
-generated lisp interface file
-
-
- lisphead - inserts before type declarationslisp - inserts after type declarations according to
- where it appears in the .i file
-
-Note that the block %{ ... %} is effectively a shortcut for
-%insert("header") %{ ... %} .
-
-
-
-
-
-
-
-New users to SWIG are encouraged to read
-SWIG Basics , and
-SWIG and C++ , for those
-interested in generating an interface to C++.
-
-
-
-
-
-
- Writing lisp code that directly invokes functions at the foreign
- function interface level can be cumbersome. Data must often be
- translated between lisp and foreign types, data extracted from
- objects, foreign objects allocated and freed upon completion of
- the foreign call. Dealing with pointers can be unwieldy when it
- comes to keeping them distinct from other valid integer values.
-
-
-
- We make an attempt to ease some of these burdens by making the
- interface to foreign code much more lisp-like, rather than C
- like. How this is done is described in later chapters. The
- layers themselves, appear as follows:
-
-
-
-
- ______________
- | | (foreign side)
- | Foreign Code | What we're generating an interface to.
- |______________|
- |
- |
- _______v______
- | | (foreign side)
- | Wrapper code | extern "C" wrappers calling C++
- |______________| functions and methods.
- |
- . . . - - + - - . . .
- _______v______
- | | (lisp side)
- | FFI Layer | Low level lisp interface. ff:def-foreign-call,
- |______________| ff:def-foreign-variable
- |
- +----------------------------
- _______v______ _______v______
- | | | | (lisp side)
- | Defuns | | Defmethods | wrapper for overloaded
- |______________| |______________| functions or those with
- (lisp side) | defaulted arguments
- Wrapper for non-overloaded |
- functions and methods _______v______
- | | (lisp side)
- | Defuns | dispatch function
- |______________| to overloads based
- on arity
-
-
- These wrappers are as generated by SWIG default. The types of
- function parameters can be transformed in place using the CTYPE
- typemap. This is use for converting pass-by-value parameters to
- pass-by-reference where necessary. All wrapper parameters are then
- bound to local variables for possible transformation of values
- (see LIN typemap). Return values can be transformed via the OUT
- typemap.
-
-
-
-
-
-
- These are the generated ff:def-foreign-call forms. No typemaps are
- applicable to this layer, but the %ffargs directive is
- available for use in .i files, to specify which keyword arguments
- should be specified for a given function.
-
-
- ffargs.i:
-
-%module ffargs
-
-%ffargs(strings_convert="nil", call_direct="t") foo;
-%ffargs(strings_convert="nil", release_heap=":never", optimize_for_space="t") bar;
-
-int foo(float f1, float f2);
-int foo(float f1, char c2);
-
-void bar(void *lisp_fn);
-
-char *xxx();
-
-
Generates:
-
- ffargs.cl:
-
-(swig-in-package ())
-
-(swig-defmethod ("foo" "ACL___foo__SWIG_0" :type :function :arity 2)
- ((PARM0_f1 cl:single-float :float )
- (PARM1_f2 cl:single-float :float ))
- (:returning (:int )
- :call-direct t
- :strings-convert nil)
- (let ((SWIG_arg0 PARM0_f1))
- (let ((SWIG_arg1 PARM1_f2))
- (swig-ff-call SWIG_arg0 SWIG_arg1))))
-
-(swig-defmethod ("foo" "ACL___foo__SWIG_1" :type :function :arity 2)
- ((PARM0_f1 cl:single-float :float )
- (PARM1_c2 cl:character :char character))
- (:returning (:int )
- :call-direct t
- :strings-convert nil)
- (let ((SWIG_arg0 PARM0_f1))
- (let ((SWIG_arg1 PARM1_c2))
- (swig-ff-call SWIG_arg0 SWIG_arg1))))
-
-(swig-dispatcher ("foo" :type :function :arities (2)))
-(swig-defun ("bar" "ACL___bar__SWIG_0" :type :function)
- ((PARM0_lisp_fn (* :void) ))
- (:returning (:void )
- :release-heap :never
- :optimize-for-space t
- :strings-convert nil)
- (let ((SWIG_arg0 PARM0_lisp_fn))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("xxx" "ACL___xxx__SWIG_0" :type :function)
- (:void)
- (:returning ((* :char) )
- :strings-convert t)
- (swig-ff-call))
-
-
-
%ffargs(strings_convert="t");
-
- Is the only default value specified in allegrocl.swg to force
- the muffling of warnings about automatic string conversion when defining
- ff:def-foreign-call's.
-
-
-
-
-
-
- These are simple defuns. There is no typechecking of arguments.
- Parameters are bound to local variables for possible
- transformation of values, such as pulling values out of instance
- slots or allocating temporary stack allocated structures, via the
- lin typemap. These arguments are then passed to the
- foreign-call (where typechecking may occur). The return value from
- this function can be manipulated via the lout typemap.
-
-
-
-
-
-
- In the case of overloaded functions, multiple layers are
- generated. First, all the overloads for a given name are separated
- out into groups based on arity, and are wrapped in
- defmethods. Each method calls a distinct wrapper function, but are
- themselves distinguished by the types of their arguments
- (see lispclass typemap). These are further wrapped in a
- dispatching function (defun) which will invoke the appropriate
- generic-function based on arity. This provides a single functional
- interface to all overloads. The return value from this function
- can be manipulated via the lout typemap.
-
-
-
-
-
-
- Along with the described functional layering, when creating a .cxx wrapper,
- this module will generate getter and--if not immutable--setter,
- functions for variables and constants. If the -nocwrap option is used,
- defconstant and ff:def-foreign-variable forms will be
- generated for accessing constants and global variables. These, along with
- the defuns listed above are the intended API for calling
- into the foreign module.
-
-
-
-
-
-
- All non-primitive types (Classes, structs, unions, and typedefs
- involving same) have a corresponding foreign-type defined on the
- lisp side via ff:def-foreign-type.
-
-
-
- All non-primitive types are further represented by a CLOS class,
- created via defclass. An attempt is made to create the same class
- hierarchy, with all classes inheriting directly or indirectly from
- ff:foreign-pointer. Further, wherever it is apparent, all pointers
- returned from foreign code are wrapped in a CLOS instance of the
- appropriate class. For ff:def-foreign-calls that have been defined
- to expect a :foreign-address type as argument, these CLOS instances
- can legally be passed and the pointer to the C++ object
- automatically extracted. This is a natural feature of Allegro's
- foreign function interface.
-
-
-
-
-
-
- In this section is described how particular C/C++ constructs are
- translated into lisp.
-
-
-
-
-
-
- C++ namespaces are translated into Lisp packages by SWIG. The
- Global namespace is mapped to a package named by the %module
- directive or the -module command-line argument. Further
- namespaces are generated by the swig-defpackage utility
- function and given names based on Allegro CLs nested namespace
- convention. For example:
-
-
- foo.i:
-
-%module foo
-
-%{
-#include "foo.h"
-%}
-
-%include "foo.h"
-
-namespace car {
- ...
- namespace tires {
- int do_something(int n);
- }
-}
-
-
Generates the following code.
-
- foo.cl
-
-(defpackage :foo
- (:use :common-lisp :swig :ff :excl))
-
-...
-
-(swig-defpackage ("car"))
-(swig-defpackage ("car" "tires"))
-
-...
-
-(swig-in-package ("car" "tires"))
-(swig-defun ("do_something" "ACL_car_tires__do_something__SWIG_0" :type :function)
- ((PARM0_n :int ))
- (:returning (:int )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_n))
- (swig-ff-call SWIG_arg0)))
-
-
- The above interface file would cause packages foo, foo.car, and
- foo.car.tires to be created. One would find the function wrapper
- for do_something defined in the foo.car.tires package(*).
-
-
- (* ) Except for the package named by the module, all
- namespace names are passed to the identifier-converter-function
- as strings with a :type of :namespace . It is the
- job of this function to generate the desired symbol, accounting for
- case preferences, additional naming cues, etc.
-
-
-
- Note that packages created by swig-defpackage do not
- use the COMMON-LISP or EXCL package. This reduces possible
- conflicts when defining foreign types via the SWIG interface
- in all but the toplevel modules package . This may
- lead to confusion if, for example, the current package is
- foo.car.tires and you attempt to use a common-lisp
- function such as (car '(1 2 3) .
-
-
-
-
-
-
-
- Constants, as declared by the preprocessor #define macro or SWIG
- %constant directive, are included in SWIG's parse tree
- when it can be determined that they are, or could be reduced to,
- a literal value. Such values are translated into defconstant
- forms in the generated lisp wrapper when the -nocwrap command-line
- options is used. Else, wrapper functions are generated as in the
- case of variable access (see section below).
-
-
- Here are examples of simple preprocessor constants when using -nocwrap.
-
-
-
-#define A 1 => (swig-defconstant "A" 1)
-#define B 'c' => (swig-defconstant "B" #\c)
-#define C B => (swig-defconstant "C" #\c)
-#define D 1.0e2 => (swig-defconstant "D" 1.0d2)
-#define E 2222 => (swig-defconstant "E" 2222)
-#define F (unsigned int)2222 => no code generated
-#define G 1.02e2f => (swig-defconstant "G" 1.02f2)
-#define H foo => no code generated
-
-
- Note that where SWIG is unable to determine if a constant is
- a literal, no node is added to the SWIG parse tree, and so
- no values can be generated.
-
-
-
- For preprocessor constants containing expressions which can be
- reduced to literal values, nodes are created, but with no simplification
- of the constant value. A very very simple infix to prefix converter
- has been implemented that tries to do the right thing for simple cases, but
- does not for more complex expressions. If the literal parser determines
- that something is wrong, a warning will be generated and the literal
- expression will be included in the generated code, but commented out.
-
-
-
-
-#define I A + E => (swig-defconstant "I" (+ 1 2222))
-#define J 1|2 => (swig-defconstant "J" (logior 1 2))
-#define Y 1 + 2 * 3 + 4 => (swig-defconstant "Y" (* (+ 1 2) (+ 3 4)))
-#define Y1 (1 + 2) * (3 + 4) => (swig-defconstant "Y1" (* (+ 1 2) (+ 3 4)))
-#define Y2 1 * 2 + 3 * 4 => (swig-defconstant "Y2" (* 1 (+ 2 3) 4)) ;; WRONG
-#define Y3 (1 * 2) + (3 * 4) => (swig-defconstant "Y3" (* 1 (+ 2 3) 4)) ;; WRONG
-#define Z 1 + 2 - 3 + 4 * 5 => (swig-defconstant "Z" (* (+ 1 (- 2 3) 4) 5)) ;; WRONG
-
-
- Users are cautioned to get to know their constants before use, or
- not use the -nocwrap command-line option.
-
-
-
-
-
-
- For C wrapping, a def-foreign-variable call is generated for access
- to global variables.
-
-
- When wrapping C++ code, both global and member variables, getter
- wrappers are generated for accessing their value, and if not immutable,
- setter wrappers as well. In the example below, note the lack of a
- setter wrapper for global_var, defined as const.
-
-
- vars.h
-
-namespace nnn {
- int const global_var = 2;
- float glob_float = 2.0;
-}
-
-
- Generated code:
-
- vars.cl
-
-(swig-in-package ("nnn"))
-(swig-defun ("global_var" "ACL_nnn__global_var_get__SWIG_0" :type :getter)
- (:void)
- (:returning (:int )
- :strings-convert t)
- (swig-ff-call))
-
-
-(swig-defun ("glob_float" "ACL_nnn__glob_float_set__SWIG_0" :type :setter)
- ((PARM0_glob_float :float ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_glob_float))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("glob_float" "ACL_nnn__glob_float_get__SWIG_0" :type :getter)
- (:void)
- (:returning (:float )
- :strings-convert t)
- (swig-ff-call))
-
-
- Note also, that where applicable, setter wrappers are implemented
- as setf methods on the getter function, providing a lispy interface
- to the foreign code.
-
-
-
-
-user> (load "globalvar.dll")
-; Foreign loading globalvar.dll.
-t
-user> (load "globalvar.cl")
-; Loading c:\mikel\src\swig\test\globalvar.cl
-t
-user>
-globalvar> (globalvar.nnn::global_var)
-2
-globalvar> (globalvar.nnn::glob_float)
-2.0
-globalvar> (setf (globalvar.nnn::glob_float) 3.0)
-3.0
-globalvar> (globalvar.nnn::glob_float)
-3.0
-
-
- In C, an enumeration value is an integer value, while in C++ an
- enumeration value is implicitly convertible to an integer value,
- but can also be distinguished by its enum type. For each enum
- declaration a def-foreign-type is generated, assigning the enum
- a default type of :int. Users may adjust the foreign type of
- enums via SWIG typemaps .
-
-
-
- Enum values are a bit trickier as they can be initialized using
- any valid C/C++ expression. In C with the -nocwrap command-line option,
- we handle the typical cases (simple integer initialization) and
- generate a defconstant form for each enum value. This has the advantage
- of it not being necessary to probe into foreign space to retrieve enum
- values. When generating a .cxx wrapper file, a more general solution is
- employed. A wrapper variable is created in the module_wrap.cxx file, and
- a ff:def-foreign-variable call is generated to retrieve its value into lisp.
-
-
- For example, the following header file
-
enum.h:
-
-enum COL { RED, GREEN, BLUE };
-enum FOO { FOO1 = 10, FOO2, FOO3 };
-
-
- In -nocwrap mode, generates
-
- enum.cl:
-
-(swig-def-foreign-type "COL" :int)
-(swig-defconstant "RED" 0)
-(swig-defconstant "GREEN" (+ #.(swig-insert-id "RED" () :type :constant) 1))
-(swig-defconstant "BLUE" (+ #.(swig-insert-id "GREEN" () :type :constant) 1))
-
-(swig-def-foreign-type "FOO" :int)
-(swig-defconstant "FOO1" 10)
-(swig-defconstant "FOO2" (+ #.(swig-insert-id "FOO1" () :type :constant) 1))
-(swig-defconstant "FOO3" (+ #.(swig-insert-id "FOO2" () :type :constant) 1))
-
-
And when generating a .cxx wrapper
-
enum_wrap.cxx:
-
-EXPORT const int ACL_ENUM___RED__SWIG_0 = RED;
-EXPORT const int ACL_ENUM___GREEN__SWIG_0 = GREEN;
-EXPORT const int ACL_ENUM___BLUE__SWIG_0 = BLUE;
-EXPORT const int ACL_ENUM___FOO1__SWIG_0 = FOO1;
-EXPORT const int ACL_ENUM___FOO2__SWIG_0 = FOO2;
-EXPORT const int ACL_ENUM___FOO3__SWIG_0 = FOO3;
-
-
- and
-
- enum.cl:
-
-(swig-def-foreign-type "COL" :int)
-(swig-defvar "RED" "ACL_ENUM___RED__SWIG_0" :type :constant)
-(swig-defvar "GREEN" "ACL_ENUM___GREEN__SWIG_0" :type :constant)
-(swig-defvar "BLUE" "ACL_ENUM___BLUE__SWIG_0" :type :constant)
-
-(swig-def-foreign-type "FOO" :int)
-(swig-defvar "FOO1" "ACL_ENUM___FOO1__SWIG_0" :type :constant)
-(swig-defvar "FOO2" "ACL_ENUM___FOO2__SWIG_0" :type :constant)
-(swig-defvar "FOO3" "ACL_ENUM___FOO3__SWIG_0" :type :constant)
-
-
-
- One limitation in the Allegro CL foreign-types module, is that,
- without macrology, expressions may not be used to specify the
- dimensions of an array declaration. This is not a horrible
- drawback unless it is necessary to allocate foreign structures
- based on the array declaration using ff:allocate-fobject. When it
- can be determined that an array bound is a valid numeric value,
- SWIG will include this in the generated array declaration on the
- lisp side, otherwise the value will be included, but commented out.
-
-
-
- Below is a comprehensive example, showing a number of legal
- C/C++ array declarations and how they are translated
- into foreign-type specifications in the generated lisp code.
-
- array.h
-
-#define MAX_BUF_SIZE 1024
-
-namespace FOO {
- int global_var1[13];
- float global_var2[MAX_BUF_SIZE];
-
-}
-
-enum COLOR { RED = 10, GREEN = 20, BLUE, PURPLE = 50, CYAN };
-
-namespace BAR {
- char global_var3[MAX_BUF_SIZE + 1];
- float global_var4[MAX_BUF_SIZE][13];
- signed short global_var5[MAX_BUF_SIZE + MAX_BUF_SIZE];
-
- int enum_var5[GREEN];
- int enum_var6[CYAN];
-
- COLOR enum_var7[CYAN][MAX_BUF_SIZE];
-}
-
-
- Generates:
-
-
- array.cl
-
-(in-package #.*swig-module-name*)
-
-(swig-defpackage ("FOO"))
-(swig-defpackage ("BAR"))
-
-(swig-in-package ())
-(swig-def-foreign-type "COLOR" :int)
-(swig-defvar "RED" "ACL_ENUM___RED__SWIG_0" :type :constant)
-(swig-defvar "GREEN" "ACL_ENUM___GREEN__SWIG_0" :type :constant)
-(swig-defvar "BLUE" "ACL_ENUM___BLUE__SWIG_0" :type :constant)
-(swig-defvar "PURPLE" "ACL_ENUM___PURPLE__SWIG_0" :type :constant)
-(swig-defvar "CYAN" "ACL_ENUM___CYAN__SWIG_0" :type :constant)
-
-(swig-in-package ())
-
-(swig-defconstant "MAX_BUF_SIZE" 1024)
-(swig-in-package ("FOO"))
-
-(swig-defun ("global_var1" "ACL_FOO__global_var1_get__SWIG_0" :type :getter)
- (:void)
- (:returning ((* :int) )
- :strings-convert t)
- (make-instance 'ff:foreign-pointer :foreign-address (swig-ff-call)))
-
-
-(swig-defun ("global_var2" "ACL_FOO__global_var2_set__SWIG_0" :type :setter)
- ((global_var2 (:array :float 1024) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 global_var2))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-in-package ())
-(swig-in-package ("BAR"))
-(swig-defun ("global_var3" "ACL_BAR__global_var3_set__SWIG_0" :type :setter)
- ((global_var3 (:array :char #|1024+1|#) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 global_var3))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("global_var4" "ACL_BAR__global_var4_set__SWIG_0" :type :setter)
- ((global_var4 (:array (:array :float 13) 1024) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 global_var4))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("global_var4" "ACL_BAR__global_var4_get__SWIG_0" :type :getter)
- (:void)
- (:returning ((* (:array :float 13)) )
- :strings-convert t)
- (make-instance 'ff:foreign-pointer :foreign-address (swig-ff-call)))
-
-
-(swig-defun ("global_var5" "ACL_BAR__global_var5_set__SWIG_0" :type :setter)
- ((global_var5 (:array :short #|1024+1024|#) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 global_var5))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("enum_var5" "ACL_BAR__enum_var5_set__SWIG_0" :type :setter)
- ((enum_var5 (:array :int #|GREEN|#) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 enum_var5))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("enum_var6" "ACL_BAR__enum_var6_set__SWIG_0" :type :setter)
- ((enum_var6 (:array :int #|CYAN|#) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 enum_var6))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("enum_var7" "ACL_BAR__enum_var7_set__SWIG_0" :type :setter)
- ((enum_var7 (:array (:array #.(swig-insert-id "COLOR" ()) 1024) #|CYAN|#) ))
- (:returning (:void )
- :strings-convert t)
- (let ((SWIG_arg0 enum_var7))
- (swig-ff-call SWIG_arg0)))
-
-
-(swig-defun ("enum_var7" "ACL_BAR__enum_var7_get__SWIG_0" :type :getter)
- (:void)
- (:returning ((* (:array #.(swig-insert-id "COLOR" ()) 1024)) )
- :strings-convert t)
- (make-instance 'ff:foreign-pointer :foreign-address (swig-ff-call)))
-
-
- Classes, unions, and structs are all treated the same way by the
- interface generator. For any of these objects, a
- def-foreign-type and a defclass form are generated. For every
- function that returns an object (or pointer/reference) of C/C++
- type X , the wrapping defun (or defmethod) on the Lisp
- side will automatically wrap the pointer returned in an instance
- of the appropriate class. This makes it much easier to write and
- debug code than if pointers were passed around as a jumble of
- integer values.
-
-
-
-
-
-
- The CLOS class schema generated by the interface mirrors the
- inheritance of the classes in foreign code, with the
- ff:foreign-pointer class at its root. ff:foreign-pointer is a thin
- wrapper for pointers that is made available by the foreign function
- interface. Its key benefit is that it may be passed as an argument
- to any ff:def-foreign-call that is expecting a pointer as the
- parameter.
-
-
-
-
-
-
- All public fields will have accessor getter/setter functions
- generated for them, as appropriate. All public member functions
- will have wrapper functions generated.
-
-
-
- We currently ignore anything that isn't public (i.e.
- private or protected ), because the C++ compiler
- won't allow the wrapper functions to access such fields. Likewise,
- the interface does nothing for friend directives,
-
-
-
-
-
-
- The def-foreign-type generated by the SWIG interface is
- currently incomplete. We can reliably generate the object layout
- of simple structs and unions; they can be allocated via
- ff:allocate-fobject, and their member variables accessed
- directly using the various ff:fslot-value-* functions. However,
- the layout of C++ classes is more complicated. Different
- compilers adjust class layout based on inheritance patterns, and
- the presence of virtual member functions. The size of member
- function pointers vary across compilers as well. As a result, it
- is recommended that users of any generated interface not attempt
- to access C++ instances via the foreign type system, but instead
- use the more robust wrapper functions.
-
-
-
-
-
-
-
-
-
-
-SWIG provides support for dealing with templates, but by
-default, it will not generate any member variable or function
-wrappers for templated classes. In order to create these
-wrappers, you need to explicitly tell SWIG to instantiate
-them. This is done via the
-%template
-
-
-
-
-
-While no wrapper code is generated for accessing member
-variables, or calling member functions, type code is generated
-to include these templated classes in the foreign-type and CLOS
-class schema.
-
-
-
-
-
-
- In C/C++ it is possible, via typedef, to have many names refer to
- the same type . In general, this is not a problem, though
- it can lead to confusion. Assume the below C++ header file:
-
-
- synonyms.h
-
-class A {
- int x;
- int y;
-};
-
-typedef A Foo;
-
-A *xxx(int i); /* sets A->x = A->y = i */
-Foo *yyy(int i); /* sets Foo->x = Foo->y = i */
-
-int zzz(A *inst = 0); /* return inst->x + inst->y */
-
-
- The function zzz is an overloaded functions; the
- foreign function call to it will be wrapped in a
- generic-function whose argument will be checked against a type
- of A . Assuming a simple implementation, a call
- to xxx(1) will return a pointer to an A object, which
- will be wrapped in a CLOS instance of class A , and a
- call to yyy(1) will result in a CLOS instance of
- type Foo being returned. Without establishing a clear
- type relationship between Foo and A , an
- attempt to call zzz(yyy(1)) will result in an error.
-
-
-
- We resolve this issue, by noting synonym relationships between
- types while generating the interface. A Primary type is selected
- (more on this below) from the candidate list of synonyms. For
- all other synonyms, instead of generating a distinct CLOS class
- definition, we generate a form that expands to:
-
-
- (setf (find-class <synonym>) <primary>)
-
-
- The result is that all references to synonym types in foreign
- code, are wrapped in the same CLOS wrapper, and, in particular,
- method specialization in wrapping generic functions works as
- expected.
-
-
-
- Given the above header file, synonym.h, a Lisp session would
- appear as follows:
-
-
-
-CL-USER> (load "synonym.dll")
-; Foreign loading synonym.dll.
-t
-CL-USER> (load "synonym.cl")
-; Loading c:\mikel\src\swig\test\synonym.cl
-t
-CL-USER>
-synonym> (setf a (xxx 3))
-#<A nil #x3261a0 @ #x207299da>
-synonym> (setf foo (yyy 10))
-#<A nil #x3291d0 @ #x2072e982>
-synonym> (zzz a)
-6
-synonym> (zzz foo)
-20
-synonym>
-
-
- The choice of a primary type is selected by the following
- criteria from a set of synonym types.
-
-
-
- If a synonym type has a class definition, it is the primary type.
-
-
- If a synonym type is a class template and has been explicitly
- instantiated via %template , it is the primary type.
-
-
- For all other sets of synonymous types, the synonym which is
- parsed first becomes the primary type.
-
-
-
-
-
-
-
- For each possible argument combination, a distinct wrapper
- function is created in the .cxx file. On the Lisp side, a
- generic functions is defined for each possible arity the
- overloaded/defaulted call may have. Each distinct wrapper is
- then called from within a defmethod on the appropriate generic
- function. These are further wrapped inside a dispatch function
- that checks the number of arguments it is called with and passes
- them via apply to the appropriate generic-function. This allows
- for a single entry point to overloaded functions on the lisp
- side.
-
-
- Example:
-
- overload.h:
-
-
-class A {
- public:
- int x;
- int y;
-};
-
-float xxx(int i, int x = 0); /* return i * x */
-float xxx(A *inst, int x); /* return x + A->x + A->y */
-
-
Creates the following three wrappers, for each of the possible argument
- combinations
-
- overload_wrap.cxx
-
-EXPORT void ACL___delete_A__SWIG_0 (A *larg1) {
- A *arg1 = (A *) 0 ;
-
- arg1 = larg1;
- try {
- delete arg1;
-
- } catch (...) {
-
- }
-}
-
-
-EXPORT float ACL___xxx__SWIG_0 (int larg1, int larg2) {
- float lresult = (float)0 ;
- int arg1 ;
- int arg2 ;
- float result;
-
- arg1 = larg1;
- arg2 = larg2;
- try {
- result = (float)xxx(arg1, arg2);
-
- lresult = result;
- return lresult;
- } catch (...) {
- return (float)0;
- }
-}
-
-
-EXPORT float ACL___xxx__SWIG_1 (int larg1) {
- float lresult = (float)0 ;
- int arg1 ;
- float result;
-
- arg1 = larg1;
- try {
- result = (float)xxx(arg1);
-
- lresult = result;
- return lresult;
- } catch (...) {
- return (float)0;
- }
-}
-
-
-EXPORT float ACL___xxx__SWIG_2 (A *larg1, int larg2) {
- float lresult = (float)0 ;
- A *arg1 = (A *) 0 ;
- int arg2 ;
- float result;
-
- arg1 = larg1;
- arg2 = larg2;
- try {
- result = (float)xxx(arg1, arg2);
-
- lresult = result;
- return lresult;
- } catch (...) {
- return (float)0;
- }
-}
-
-
- And the following foreign-function-call and method definitions on the
- lisp side:
-
- overload.cl
-
-(swig-defmethod ("xxx" "ACL___xxx__SWIG_0" :type :function :arity 2)
- ((PARM0_i cl:integer :int )
- (PARM1_x cl:integer :int ))
- (:returning (:float )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_i))
- (let ((SWIG_arg1 PARM1_x))
- (swig-ff-call SWIG_arg0 SWIG_arg1))))
-
-(swig-defmethod ("xxx" "ACL___xxx__SWIG_1" :type :function :arity 1)
- ((PARM0_i cl:integer :int ))
- (:returning (:float )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_i))
- (swig-ff-call SWIG_arg0)))
-
-(swig-defmethod ("xxx" "ACL___xxx__SWIG_2" :type :function :arity 2)
- ((PARM0_inst #.(swig-insert-id "A" () :type :class) (* #.(swig-insert-id "A" ())) )
- (PARM1_x cl:integer :int ))
- (:returning (:float )
- :strings-convert t)
- (let ((SWIG_arg0 PARM0_inst))
- (let ((SWIG_arg1 PARM1_x))
- (swig-ff-call SWIG_arg0 SWIG_arg1))))
-
-(swig-dispatcher ("xxx" :type :function :arities (1 2)))
-
-
And their usage in a sample lisp session:
-
-
-
-overload> (setf a (new_A))
-#<A nil #x329268 @ #x206cf612>
-overload> (setf (A_x a) 10)
-10
-overload> (setf (A_y a) 20)
-20
-overload> (xxx 1)
-0.0
-overload> (xxx 3 10)
-30.0
-overload> (xxx a 1)
-31.0
-overload> (xxx a 2)
-32.0
-overload>
-
-
- Wrappers to defined C++ Operators are automatically renamed, using
- %rename , to the following defaults:
-
-
-
-/* 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[];
-
-
- Name mangling occurs on all such renamed identifiers, so that wrapper name
- generated by B::operator= will be B___eq__ , i.e.
- <class-or-namespace>_ has been added. Users may modify
- these default names by adding %rename directives in their own .i files.
-
-
-
- Operator overloading can be achieved by adding functions based
- on the mangled names of the function. In the following example,
- a class B is defined with a Operator== method defined. The
- swig %extend directive is used to add an overload method
- on Operator==.
-
-
- opoverload.h
-
-class B {
- public:
- int x;
- int y;
- bool operator==(B const& other) const;
-};
-
-
- and
-
- opoverload.i
-
-%module opoverload
-
-%{
-#include <fstream>
-#include "opoverload.h"
-%}
-
-%{
-bool B___eq__(B const *inst, int const x)
-{
- // insert the function definition into the wrapper code before
- // the wrapper for it.
- // ... do stuff ...
-}
-%}
-
-%include "opoverload.h"
-
-%extend B {
- public:
- bool __eq__(int const x) const;
-};
-
-
- Either operator can be called via a single call
- to the dispatch function:
-
-
-
-opoverload> (B___eq__ x1 x2)
-nil
-opoverload> (B___eq__ x1 3)
-nil
-opoverload>
-
-
- Variable length argument lists are not supported, by default. If
- such a function is encountered, a warning will generated to
- stderr. Varargs are supported via the SWIG %varargs
- directive. This directive allows you to specify a (finite)
- argument list which will be inserted into the wrapper in place
- of the variable length argument indicator. As an example,
- consider the function printf() . Its declaration would
- appear as follows:
-
-
-
- See the following section
- on Variable Length arguments
- provides examples on how %varargs can be used, along
- with other ways such functions can be wrapped.
-
-
-
-
-
-
- Each C++ wrapper includes a handler to catch any exceptions that may
- be thrown while in foreign code. This helps prevent simple C++ errors
- from killing the entire lisp process. There is currently no mechanism
- to have these exceptions forwarded to the lisp condition system, nor
- has any explicit support of the exception related SWIG typemaps been
- implemented.
-
-
-
-
-
-
- Allegro CL does not support the passing of non-primitive foreign
- structures by value. As a result, SWIG must automatically detect
- and convert function parameters and return values to pointers
- whenever necessary. This is done via the use of typemaps ,
- and should not require any fine tuning by the user, even for
- newly defined types.
-
-
-
-
-
-
- SWIG Typemaps provide a powerful tool for automatically generating
- code to handle various menial tasks required of writing an interface
- to foreign code. The purpose of this section is to describe each of
- the typemaps used by the Allegro CL module. Please read the chapter
- on Typemaps for more information.
-
-
-
-
-
-
-
- Every C++ wrapper generated by SWIG takes the following form:
-
-
-
-
-return-val wrapper-name(parm0, parm1, ..., parmN)
-{
- return-val lresult; /* return value from wrapper */
- <local-declaration>
- ... results; /* return value from function call */
-
- <binding locals to parameters>
-
- try {
- result = function-name(local0, local1, ..., localN);
-
- <convert and bind result to lresult>
-
- return lresult;
- catch (...) {
- return (int)0;
- }
-
-
- the in typemap is used to generate code to convert parameters
- passed to C++ wrapper functions into the arguments desired for the
- call being wrapped. That is, it fills in the code for the
- <binding locals to parameters> section above. We
- use this map to automatically convert parameters passed by
- reference to the wrapper function into by-value arguments for
- the wrapped call, and also to convert boolean values, which are
- passed as integers from lisp (by default), into the appropriate
- type for the language of code being wrapped.
-
-
- These are the default specifications for the IN typemap. Here,
- $input refers to the parameter code is being generated
- for, and $1 is the local variable to which it is
- being assigned. The default settings of this typemap are as follows:
-
-
-
-
-%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 & "$1 = $input;";
-%typemap(in) SWIGTYPE "$1 = *$input;";
-
-
- The out typemap is used to generate code to form the
- return value of the wrapper from the return value of the wrapped
- function. This code is placed in the <convert and bind result to lresult>
- section of the above code diagram. Its default mapping is as follows:
-
-
-
-
-%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 *, void,
- enum SWIGTYPE, SWIGTYPE *,
- SWIGTYPE[ANY], SWIGTYPE & "$result = $1;";
-%typemap(out) SWIGTYPE "$result = new $1_type($1);";
-
-
- This typemap is not used for code generation, but purely for the
- transformation of types in the parameter list of the wrapper function.
- Its primary use is to handle by-value to by-reference conversion in the
- wrappers parameter list. Its default settings are:
-
-
-
-
-%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 & "$1_ltype";
-%typemap(ctype) SWIGTYPE "$&1_type";
-
-
- These three typemaps are specifically employed by the
- Allegro CL interface generator. SWIG also implements a number of
- other typemaps that can be used for generating code in the C/C++
- wrappers. You can read about
- these common typemaps here.
-
-
-
-
-
-
- A number of custom typemaps have also been added to facilitate
- the generation of code in the lisp side of the interface. These
- are described below. The basic code generation structure is
- applied as a series of nested expressions, one for each
- parameter, then one for manipulating the return value, and last,
- the foreign function call itself.
-
-
-
- Note that the typemaps below use fully qualified symbols where
- necessary. Users writing their own typemaps should do likewise.
- See the explanation in the last paragraph of
- 16.3.1 Namespaces for details.
-
-
-
-
-
-
- The LIN typemap allows for the manipulating the lisp objects
- passed as arguments to the wrapping defun before passing them to
- the foreign function call. For example, when passing lisp
- strings to foreign code, it is often necessary to copy the
- string into a foreign structure of type (:char *) of appropriate
- size, and pass this copy to the foreign call. Using the LIN
- typemap, one could arrange for the stack-allocation of a foreign
- char array, copy your string into it, and not have to worry
- about freeing the copy after the function returns.
-
-
- The LIN typemap accepts the following $variable references.
-
-
- $in - expands to the name of the parameter being
- applied to this typemap
- $out - expands to the name of the local variable
- assigned to this typemap
- $in_fftype - the foreign function type of the C type.$*in_fftype - the foreign function type of the C type
- with one pointer removed. If there is no pointer, then $*in_fftype
- is the same as $in_fftype.
- $body - very important. Instructs SWIG where
- subsequent code generation steps should be inserted into the
- current typemap. Leaving out a $body reference
- will result in lisp wrappers that do very little by way of
- calling into foreign code. Not recommended.
-
-
-
-
-%typemap(lin) SWIGTYPE "(cl:let (($out $in))\n $body)";
-
-
- The LOUT typemap is the means by which we effect the wrapping of
- foreign pointers in CLOS instances. It is applied after all LIN
- typemaps, and immediately before the actual foreign-call.
-
-
- The LOUT typemap uses the following $variable
-
-
- $lclass - Expands to the CLOS class that
- represents foreign-objects of the return type matching this
- typemap.
- $body - Same as for the LIN map. Place this
- variable where you want the foreign-function call to occur.
- $ldestructor - Expands to the symbol naming the destructor for this
- class ($lclass) of object. Allows you to insert finalization or automatic garbage
- collection into the wrapper code (see default mappings below).
-
-
-
-
-%typemap(lout) bool, 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 "$body";
-%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *,
- SWIGTYPE & "(cl:make-instance '$lclass :foreign-address $body)";
-%typemap(lout) SWIGTYPE "(cl:let* ((address $body)\n
- (ACL_result (cl:make-instance '$lclass :foreign-address address)))\n
- (cl:unless (cl::zerop address)\n
- (excl:schedule-finalization ACL_result #'$ldestructor))\n
- ACL_result)";
-
-
- The FFITYPE typemap works as a helper for a body of code that
- converts C/C++ type specifications into Allegro CL foreign-type
- specifications. These foreign-type specifications appear in
- ff:def-foreing-type declarations, and in the argument list and
- return values of ff:def-foreign-calls. You would modify this
- typemap if you want to change how the FFI passes through
- arguments of a given type. For example, if you know that a
- particular compiler represents booleans as a single byte, you
- might add an entry for:
-
-
-
-
-%typemap(ffitype) bool ":unsigned-char";
-
-
- Note that this typemap is pure type transformation, and is not
- used in any code generations step the way the LIN and LOUT
- typemaps are. The default mappings for this typemap are:
-
-
-
-
-%typemap(ffitype) bool ":int";
-%typemap(ffitype) char ":char";
-%typemap(ffitype) unsigned char ":unsigned-char";
-%typemap(ffitype) signed char ":char";
-%typemap(ffitype) short, signed short ":short";
-%typemap(ffitype) unsigned short ":unsigned-short";
-%typemap(ffitype) int, signed int ":int";
-%typemap(ffitype) unsigned int ":unsigned-int";
-%typemap(ffitype) long, signed long ":long";
-%typemap(ffitype) unsigned long ":unsigned-long";
-%typemap(ffitype) float ":float";
-%typemap(ffitype) double ":double";
-%typemap(ffitype) char * "(* :char)";
-%typemap(ffitype) void * "(* :void)";
-%typemap(ffitype) void ":void";
-%typemap(ffitype) enum SWIGTYPE ":int";
-%typemap(ffitype) SWIGTYPE & "(* :void)";
-
-
- This is another type only transformation map, and is used to
- provide the lisp-type, which is the optional third argument in
- argument specifier in a ff:def-foreign-call form. Specifying a
- lisp-type allows the foreign call to perform type checking on
- the arguments passed in. The default entries in this typemap are:
-
-
-
-
-%typemap(lisptype) bool "cl:boolean";
-%typemap(lisptype) char "cl:character";
-%typemap(lisptype) unsigned char "cl:integer";
-%typemap(lisptype) signed char "cl:integer";
-
-
- The LISPCLASS typemap is used to generate the method signatures
- for the generic-functions which wrap overloaded functions and
- functions with defaulted arguments. The default entries are:
-
-
-
-
-%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";
-%typemap(lispclass) float "cl:single-float";
-%typemap(lispclass) double "cl:double-float";
-%typemap(lispclass) char * "cl:string";
-
-
- The following example shows how we made use of the above
- typemaps to add support for the wchar_t type.
-
-
-
-
-%typecheck(SWIG_TYPECHECK_UNICHAR) wchar_t { $1 = 1; };
-
-%typemap(in) wchar_t "$1 = $input;";
-%typemap(lin) wchar_t "(cl:let (($out (cl:char-code $in)))\n $body)";
-%typemap(lin) wchar_t* "(excl:with-native-string
- ($out $in
- :external-format #+little-endian :fat-le
- #-little-endian :fat)\n
- $body)"
-
-%typemap(out) wchar_t "$result = $1;";
-%typemap(lout) wchar_t "(cl:code-char $body)";
-%typemap(lout) wchar_t* "(excl:native-to-string $body
- :external-format #+little-endian :fat-le
- #-little-endian :fat)";
-
-%typemap(ffitype) wchar_t ":unsigned-short";
-%typemap(lisptype) wchar_t "";
-%typemap(ctype) wchar_t "wchar_t";
-%typemap(lispclass) wchar_t "cl:character";
-%typemap(lispclass) wchar_t* "cl:string";
-
-
- Various symbols must be generated in the lisp environment to which
- class definitions, functions, constants, variables, etc. must be
- bound. Rather than force a particular convention for naming these
- symbols, an identifier (to symbol) conversion function is used. A
- user-defined identifier-converter can then implement any symbol
- naming, case-modifying, scheme desired.
-
-
-
- In generated SWIG code, whenever some interface object must be
- referenced by its lisp symbol, a macro is inserted that calls the
- identifier-converter function to generate the appropriate symbol
- reference. It is therefore expected that the identifier-converter
- function reliably return the same (eq) symbol given the same set
- of arguments.
-
-
-
-
-
- Two basic identifier routines have been defined.
-
-
-
-
- No modification of the identifier string is performed. Based on
- other arguments, the identifier may be concatenated with other
- strings, from which a symbol will be created.
-
-
-
-
-
-
- All underscores in the identifier string are converted to
- hyphens. Otherwise, identifier-convert-lispify performs the
- same symbol transformations.
-
-
-
-
-
-
- Check the definitions of the above two default
- identifier-converters in Lib/allegrocl/allegrocl.swg for
- default naming conventions.
-
-
-
-
-
-
- A user-defined identifier-converter function should conform to the following
- specification:
-
-
-
-
-(defun identifier-convert-fn (id &key type class arity) ...body...)
-result ==> symbol or (setf symbol)
-
-
The ID argument is a string representing an identifier in the
-foreign environment.
-
-
-
-The :type keyword argument provides more information on the type of
-identifier. Its value is a symbol. This allows the
-identifier-converter to apply different heuristics when mapping
-different types of identifiers to symbols. SWIG will generate calls
-to your identifier-converter using the following types.
-
-
-
- :class - names a CLOS class.
- :constant - names a defconstant
- :constructor - names a function for creating a foreign object
- :destructor - names a function for freeing a foreign object
- :function - names a CLOS wrapping defmethod or defun.
- :ff-operator - names a foreign call defined via ff:def-foreign-call
- :getter - getter function
- :namespace - names a C++ namespace
- :setter - names a setter function. May return a (setf symbol) reference
- :operator - names a C++ operator, such as Operator=, Operator*.
- :slot - names a slot in a struct/class/union declaration.
- :type - names a foreign-type defined via ff:def-foreign-type.
- :variable - names a variable defined via ff:def-foreign-variable.
-
-
-
-The :class keyword argument is a string naming a foreign
-class. When non-nil, it indicates that the current identifier has
-scope in the specified class.
-
-
-
-The :arity keyword argument only appears in swig:swig-defmethod forms
-generated for overloaded functions. Its value is an integer
-indicating the number of arguments passed to the routine indicated by
-this identifier.
-
-
-
-
-
-
- By default, SWIG will use identifier-converter-null. To specify
- another convert function, use the -identifier-converter
- command-line argument. The value should be a string naming the
- function you wish the interface to use instead, when generating
- symbols. ex:
-
-
-
-
-% swig -allegrocl -c++ -module mymodule -identifier-converter my-identifier-converter
-
-
-#include
-%}
diff --git a/Lib/allegrocl/inout_typemaps.i b/Lib/allegrocl/inout_typemaps.i
deleted file mode 100644
index d8d61feed..000000000
--- a/Lib/allegrocl/inout_typemaps.i
+++ /dev/null
@@ -1,111 +0,0 @@
-/* inout_typemaps.i
-
- Support for INPUT, OUTPUT, and INOUT typemaps. OUTPUT variables are returned
- as multiple values.
-
-*/
-
-
-/* Note that this macro automatically adds a pointer to the type passed in.
- As a result, INOUT typemaps for char are for 'char *'. The definition
- of typemaps for 'char' takes advantage of this, believing that it's more
- likely to see an INOUT argument for strings, than a single char. */
-%define INOUT_TYPEMAP(type_, OUTresult_, INbind_)
-// OUTPUT map.
-%typemap(lin,numinputs=0) type_ *OUTPUT, type_ &OUTPUT
-%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
- $body
- OUTresult_
- (ff:free-fobject $out)) %}
-
-// INPUT map.
-%typemap(in) type_ *INPUT, type_ &INPUT
-%{ $1 = &$input; %}
-
-%typemap(ctype) type_ *INPUT, type_ &INPUT "$*1_ltype";
-
-
-// INOUT map.
-// careful here. the input string is converted to a C string
-// with length equal to the input string. This should be large
-// enough to contain whatever OUTPUT value will be stored in it.
-%typemap(lin,numinputs=1) type_ *INOUT, type_ &INOUT
-%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
- INbind_
- $body
- OUTresult_
- (ff:free-fobject $out)) %}
-
-%enddef
-
-// $in, $out, $lclass,
-// $in_fftype, $*in_fftype
-
-INOUT_TYPEMAP(int,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(short,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(long,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(unsigned int,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(unsigned short,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(unsigned long,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-// char * mapping for passing strings. didn't quite work
-// INOUT_TYPEMAP(char,
-// (cl::push (excl:native-to-string $out) ACL_result),
-// (cl::setf (ff:fslot-value-typed (cl::quote $in_fftype) :c $out)
-// (excl:string-to-native $in)))
-INOUT_TYPEMAP(float,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(double,
- (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(bool,
- (cl::push (not (zerop (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out)))
- ACL_result),
- (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) (if $in 1 0)));
-
-%typemap(lisptype) bool *INPUT, bool &INPUT "boolean";
-
-// long long support not yet complete
-// INOUT_TYPEMAP(long long);
-// INOUT_TYPEMAP(unsigned long long);
-
-// char *OUTPUT map.
-// for this to work, swig needs to know how large an array to allocate.
-// you can fake this by
-// %typemap(ffitype) char *myarg "(:array :char 30)";
-// %apply char *OUTPUT { char *myarg };
-%typemap(lin,numinputs=0) char *OUTPUT, char &OUTPUT
-%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
- $body
- (cl::push (excl:native-to-string $out) ACL_result)
- (ff:free-fobject $out)) %}
-
-// char *INPUT map.
-%typemap(in) char *INPUT, char &INPUT
-%{ $1 = &$input; %}
-%typemap(ctype) char *INPUT, char &INPUT "$*1_ltype";
-
-// char *INOUT map.
-%typemap(lin,numinputs=1) char *INOUT, char &INOUT
-%{(cl::let (($out (excl:string-to-native $in)))
- $body
- (cl::push (excl:native-to-string $out) ACL_result)
- (ff:free-fobject $out)) %}
-
-// uncomment this if you want INOUT mappings for chars instead of strings.
-// INOUT_TYPEMAP(char,
-// (cl::push (code-char (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out))
-// ACL_result),
-// (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
diff --git a/Lib/allegrocl/longlongs.i b/Lib/allegrocl/longlongs.i
deleted file mode 100644
index a15adcdda..000000000
--- a/Lib/allegrocl/longlongs.i
+++ /dev/null
@@ -1,49 +0,0 @@
-/* -----------------------------------------------------------------------------
- * longlongs.i
- *
- * Typemap addition for support of 'long long' type and 'unsigned long long
- * Makes use of swig-def-foreign-class, so this header should be loaded
- * after allegrocl.swg and after any custom user identifier-conversion
- * functions have been defined.
- * ----------------------------------------------------------------------------- */
-
-#ifdef Acl64Bit
-%typemap(ctype) long long, unsigned long long "$1_ltype";
-%typemap(out) long long, unsigned long long "$result = $1;";
-
-%typemap(ffitype) long long ":nat";
-%typemap(ffitype) unsigned long long ":unsigned-nat";
-
-%typemap(lout) long long, unsigned long long " #+64bit (cl::setq ACL_ffresult $body)";
-
-#else
-%typemap(out) long long, unsigned long long "$result = &$1;";
-%typemap(ffitype) long long "(:struct (l1 :long) (l2 :long))";
-
-%typemap(ffitype) unsigned long long "(:struct (l1 :unsigned-long) (l2 :unsigned-long))";
-
-%typemap(lout) long long
-" (cl::setq ACL_ffresult (make-instance '#.(swig-insert-id \"longlong\" () :type :class)
- :foreign-address $body))";
-
-%typemap(lout) unsigned long long
-" (cl:setq ACL_ffresult (make-instance '#.(swig-insert-id \"ulonglong\" () :type :class)
- :foreign-address $body))";
-
-#endif
-
-%typemap(in) long long, unsigned long long "$1 = $input;";
-
-
-%insert("lisphead") %{
-
-#-64bit
-(swig-def-foreign-class "longlong"
- (ff:foreign-pointer)
- (:struct (l1 :long) (l2 :long)))
-
-#-64bit
-(swig-def-foreign-class "ulonglong"
- (ff:foreign-pointer)
- (:struct (l1 :unsigned-long) (l2 :unsigned-long)))
-%}
diff --git a/Lib/allegrocl/std_list.i b/Lib/allegrocl/std_list.i
deleted file mode 100644
index a3660c9f7..000000000
--- a/Lib/allegrocl/std_list.i
+++ /dev/null
@@ -1,230 +0,0 @@
-/* -----------------------------------------------------------------------------
- * std_list.i
- *
- * SWIG typemaps for std::list types
- *
- * To use, add:
- *
- * %include "std_list.i"
- *
- * to your interface file. You will also need to include a template directive
- * for each instance of the list container you want to use in your application.
- * e.g.
- *
- * %template (intlist) std::list;
- * %template (floatlist) std::list;
- * ----------------------------------------------------------------------------- */
-
-%module std_list
-%warnfilter(468) std::list;
-
-%{
-#include
-#include
-%}
-
-
-namespace std{
- template class list
- {
- public:
- typedef size_t size_type;
- typedef ptrdiff_t difference_type;
- typedef T value_type;
- typedef value_type* pointer;
- typedef const value_type* const_pointer;
- typedef value_type& reference;
- typedef const value_type& const_reference;
- typedef T &iterator;
- typedef const T& const_iterator;
-
- list();
- list(unsigned int size, const T& value = T());
- list(const list& other);
-
- void assign(unsigned int n, const T& value);
- void swap(list &x);
-
- const_reference front();
- const_reference back();
- const_iterator begin();
- const_iterator end();
-
- void resize(unsigned int n, T c = T());
- bool empty() const;
-
- void push_front(const T& INPUT);
- void push_back(const T& INPUT);
-
- void pop_front();
- void pop_back();
- void clear();
- unsigned int size() const;
- unsigned int max_size() const;
- void resize(unsigned int n, const T& INPUT);
-
- void remove(const T& INPUT);
- void unique();
- void reverse();
- void sort();
-
- %extend
- {
- %typemap(lout) T &__getitem__ "(cl::setq ACL_ffresult (ff:fslot-value-typed '$*out_fftype :c $body))";
- %typemap(lout) T *__getitem__ "(cl::setq ACL_ffresult (make-instance '$lclass :foreign-address $body))";
-
- const_reference __getitem__(int i) throw (std::out_of_range)
- {
- std::list::iterator first = self->begin();
- int size = int(self->size());
- if (i<0) i += size;
- if (i>=0 && i::iterator first = self->begin();
- int size = int(self->size());
- if (i<0) i += size;
- if (i>=0 && i::iterator first = self->begin();
- int size = int(self->size());
- if (i<0) i += size;
- if (i>=0 && ierase(first);
- }
- else throw std::out_of_range("list index out of range");
- }
- std::list __getslice__(int i,int j)
- {
- std::list::iterator first = self->begin();
- std::list::iterator end = self->end();
-
- int size = int(self->size());
- if (i<0) i += size;
- if (j<0) j += size;
- if (i<0) i = 0;
- if (j>size) j = size;
- if (i>=j) i=j;
- if (i>=0 && i=0)
- {
- for (int k=0;k tmp(j-i);
- if (j>i) std::copy(first,end,tmp.begin());
- return tmp;
- }
- else throw std::out_of_range("list index out of range");
- }
- void __delslice__(int i,int j)
- {
- std::list::iterator first = self->begin();
- std::list::iterator end = self->end();
-
- int size = int(self->size());
- if (i<0) i += size;
- if (j<0) j += size;
- if (i<0) i = 0;
- if (j>size) j = size;
-
- for (int k=0;kerase(first,end);
- }
- void __setslice__(int i,int j, const std::list& v)
- {
- std::list::iterator first = self->begin();
- std::list::iterator end = self->end();
-
- int size = int(self->size());
- if (i<0) i += size;
- if (j<0) j += size;
- if (i<0) i = 0;
- if (j>size) j = size;
-
- for (int k=0;kerase(first,end);
- if (i+1 <= int(self->size()))
- {
- first = self->begin();
- for (int k=0;kinsert(first,v.begin(),v.end());
- }
- else self->insert(self->end(),v.begin(),v.end());
- }
- }
- unsigned int __len__()
- {
- return self->size();
- }
- bool __nonzero__()
- {
- return !(self->empty());
- }
- void append(const T& INPUT)
- {
- self->push_back(INPUT);
- }
- void pop()
- {
- self->pop_back();
- }
- }
- };
-}
-
-
-
-
-
-
diff --git a/Lib/allegrocl/std_string.i b/Lib/allegrocl/std_string.i
deleted file mode 100644
index cbcd250a9..000000000
--- a/Lib/allegrocl/std_string.i
+++ /dev/null
@@ -1,209 +0,0 @@
-/* -----------------------------------------------------------------------------
- * std_string.i
- *
- * SWIG typemaps for std::string
- * ----------------------------------------------------------------------------- */
-
-// ------------------------------------------------------------------------
-// std::string is typemapped by value
-// This can prevent exporting methods which return a string
-// in order for the user to modify it.
-// However, I think I'll wait until someone asks for it...
-// ------------------------------------------------------------------------
-
-// %include
-%warnfilter(404) std::string;
-%warnfilter(404) std::wstring;
-
-%{
-#include
-%}
-
-// %include
-
-// %naturalvar std::string;
-// %naturalvar std::wstring;
-
-namespace std {
- typedef unsigned long size_t;
- typedef signed long ptrdiff_t;
-
- template class basic_string {
- public:
- typedef charT *pointer;
- typedef charT &reference;
- typedef const charT &const_reference;
- typedef size_t size_type;
- typedef ptrdiff_t difference_type;
- basic_string();
- basic_string( charT *str );
- size_type size();
- charT operator []( int pos ) const;
- charT *c_str() const;
- basic_string &operator = ( const basic_string &ws );
- basic_string &operator = ( const charT *str );
- basic_string &append( const basic_string &other );
- basic_string &append( const charT *str );
- void push_back( charT c );
- void clear();
- void reserve( size_type t );
- void resize( size_type n, charT c = charT() );
- int compare( const basic_string &other ) const;
- int compare( const charT *str ) const;
- basic_string &insert( size_type pos,
- const basic_string &str );
- size_type find( const basic_string &other, int pos = 0 ) const;
- size_type find( charT c, int pos = 0 ) const;
- %extend {
- bool operator == ( const basic_string &other ) const {
- return self->compare( other ) == 0;
- }
- bool operator != ( const basic_string &other ) const {
- return self->compare( other ) != 0;
- }
- bool operator < ( const basic_string &other ) const {
- return self->compare( other ) == -1;
- }
- bool operator > ( const basic_string &other ) const {
- return self->compare( other ) == 1;
- }
- bool operator <= ( const basic_string &other ) const {
- return self->compare( other ) != 1;
- }
- bool operator >= ( const basic_string &other ) const {
- return self->compare( other ) != -1;
- }
-
- }
- };
-
- %template(string) basic_string;
- %template(wstring) basic_string;
-
- %apply char * { string };
- %apply wchar_t * { wstring };
-
- typedef basic_string string;
- typedef basic_string wstring;
-
- // automatically convert constant std::strings to cl:strings
- %typemap(ctype) string "char *";
- %typemap(in) string "$1.assign($input);";
- %typemap(out) string "$result = (char *)(&$1)->c_str();";
- %typemap(lisptype) string "cl:string";
- %typemap(lout) string "(cl::setq ACL_ffresult $body)";
-
- %typemap(ctype) const string *"char *";
- %typemap(in) const string * "$1.assign($input);";
- %typemap(out) const string * "$result = (char *)($1)->c_str();";
- %typemap(lisptype) const string * "cl:string";
- %typemap(lout) const string * "(cl::setq ACL_ffresult $body)";
-
- %typemap(ctype) wstring "wchar_t *";
- %typemap(in) wstring "$1.assign($input);";
- %typemap(out) wstring "$result = (wchar_t *)(&$1)->c_str();";
- %typemap(lisptype) wstring "cl:string";
- %typemap(lout) wstring "(cl::setq ACL_ffresult (excl:native-to-string $body
-:external-format #+little-endian :fat-le #-little-endian :fat))";
-
- %typemap(ctype) const wstring *"char *";
- %typemap(in) const wstring * "$1.assign($input);";
- %typemap(out) const wstring * "$result = (char *)($1)->c_str();";
- %typemap(lisptype) const wstring * "cl:string";
- %typemap(lout) const wstring * "(cl::setq ACL_ffresult $body)";
-
- /* Overloading check */
-// %typemap(in) string {
-// if (caml_ptr_check($input))
-// $1.assign((char *)caml_ptr_val($input,0),
-// caml_string_len($input));
-// else
-// SWIG_exception(SWIG_TypeError, "string expected");
-// }
-
-// %typemap(in) const string & ($*1_ltype temp) {
-// if (caml_ptr_check($input)) {
-// temp.assign((char *)caml_ptr_val($input,0),
-// caml_string_len($input));
-// $1 = &temp;
-// } else {
-// SWIG_exception(SWIG_TypeError, "string expected");
-// }
-// }
-
-// %typemap(in) string & ($*1_ltype temp) {
-// if (caml_ptr_check($input)) {
-// temp.assign((char *)caml_ptr_val($input,0),
-// caml_string_len($input));
-// $1 = &temp;
-// } else {
-// SWIG_exception(SWIG_TypeError, "string expected");
-// }
-// }
-
-// %typemap(in) string * ($*1_ltype *temp) {
-// if (caml_ptr_check($input)) {
-// temp = new $*1_ltype((char *)caml_ptr_val($input,0),
-// caml_string_len($input));
-// $1 = temp;
-// } else {
-// SWIG_exception(SWIG_TypeError, "string expected");
-// }
-// }
-
-// %typemap(free) string * ($*1_ltype *temp) {
-// delete temp;
-// }
-
-// %typemap(argout) string & {
-// caml_list_append(swig_result,caml_val_string_len((*$1).c_str(),
-// (*$1).size()));
-// }
-
-// %typemap(directorout) string {
-// $result.assign((char *)caml_ptr_val($input,0),
-// caml_string_len($input));
-// }
-
-// %typemap(out) string {
-// $result = caml_val_string_len($1.c_str(),$1.size());
-// }
-
-// %typemap(out) string * {
-// $result = caml_val_string_len((*$1).c_str(),(*$1).size());
-// }
-}
-
-// #ifdef ENABLE_CHARPTR_ARRAY
-// char **c_charptr_array( const std::vector &str_v );
-
-// %{
-// SWIGEXT char **c_charptr_array( const std::vector &str_v ) {
-// char **out = new char *[str_v.size() + 1];
-// out[str_v.size()] = 0;
-// for( int i = 0; i < str_v.size(); i++ ) {
-// out[i] = (char *)str_v[i].c_str();
-// }
-// return out;
-// }
-// %}
-// #endif
-
-// #ifdef ENABLE_STRING_VECTOR
-// %template (StringVector) std::vector;
-
-// %insert(ml) %{
-// (* Some STL convenience items *)
-
-// let string_array_to_vector sa =
-// let nv = _new_StringVector C_void in
-// array_to_vector nv (fun x -> C_string x) sa ; nv
-
-// let c_string_array ar =
-// _c_charptr_array (string_array_to_vector ar)
-// %}
-
-// %insert(mli) %{
-// val c_string_array: string array -> c_obj
-// %}
-// #endif
diff --git a/Lib/allegrocl/typemaps.i b/Lib/allegrocl/typemaps.i
deleted file mode 100644
index 293d1cd34..000000000
--- a/Lib/allegrocl/typemaps.i
+++ /dev/null
@@ -1,4 +0,0 @@
-/* Unused for Allegro CL module */
-
-%include "inout_typemaps.i"
-%include "longlongs.i"
diff --git a/Source/Modules/allegrocl.cxx b/Source/Modules/allegrocl.cxx
deleted file mode 100644
index e39abed2f..000000000
--- a/Source/Modules/allegrocl.cxx
+++ /dev/null
@@ -1,2962 +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 http://www.swig.org/legal.html.
- *
- * allegrocl.cxx
- *
- * ALLEGROCL language module for SWIG.
- * ----------------------------------------------------------------------------- */
-
-#include "swigmod.h"
-#include "cparse.h"
-#include
-
-// #define ALLEGROCL_DEBUG
-// #define ALLEGROCL_WRAP_DEBUG
-// #define ALLEGROCL_TYPE_DEBUG
-// #define ALLEGROCL_CLASS_DEBUG
-
-static const char *usage = "\
-Allegro CL Options (available with -allegrocl)\n\
- -identifier-converter - \n\
- Specifies the type of conversion to do on C identifiers to convert\n\
- them to symbols. There are two built-in converters: 'null' and\n\
- 'lispify'. The default is 'null'. If you supply a name other\n\
- than one of the built-ins, then a function by that name will be\n\
- called to convert identifiers to symbols.\n\
- -[no]cwrap - Turn on or turn off generation of an intermediate C file when\n\
- creating a C interface. By default this is only done for C++ code.\n\
- -isolate - Define all SWIG helper functions in a package unique to this\n\
- module. Avoids redefinition warnings when loading multiple\n\
- SWIGged modules into the same running Allegro CL image.\n\
-";
-
-static File *f_cl = 0;
-String *f_clhead = NewString("");
-String *f_clwrap = NewString("(swig-in-package ())\n\n");
-static File *f_begin;
-static File *f_runtime;
-static File *f_cxx_header = 0;
-static File *f_cxx_wrapper = 0;
-
-static String *module_name = 0;
-static String *swig_package = 0;
-
-static String *identifier_converter = NewString("identifier-convert-null");
-
-static bool CWrap = true; // generate wrapper file for C code by default. most correct.
-static bool Generate_Wrapper = false;
-static bool unique_swig_package = false;
-
-static SwigType *fwdref_ffi_type = NewString("__SWIGACL_FwdReference");
-
-static String *current_namespace = NewString("");
-static String *current_package = NewString("");
-static Hash *defined_namespace_packages = NewHash();
-static Node *in_class = 0;
-
-static Node *first_linked_type = 0;
-static Hash *defined_foreign_types = NewHash();
-static Hash *defined_foreign_ltypes = NewHash();
-
-static String *anon_type_name = NewString("anontype");
-static int anon_type_count = 0;
-
-// stub
-String *convert_literal(String *num_param, String *type, bool try_to_split = true);
-
-class ALLEGROCL:public Language {
-public:
- virtual void main(int argc, char *argv[]);
- virtual int top(Node *n);
- virtual int functionWrapper(Node *n);
- virtual int namespaceDeclaration(Node *n);
- virtual int constructorHandler(Node *n);
- virtual int destructorHandler(Node *n);
- virtual int globalvariableHandler(Node *n);
- virtual int variableWrapper(Node *n);
- virtual int constantWrapper(Node *n);
- virtual int memberfunctionHandler(Node *n);
- virtual int membervariableHandler(Node *n);
- virtual int classHandler(Node *n);
- virtual int emit_one(Node *n);
- virtual int enumDeclaration(Node *n);
- virtual int enumvalueDeclaration(Node *n);
- virtual int typedefHandler(Node *n);
- virtual int classforwardDeclaration(Node *n);
- virtual int templateDeclaration(Node *n);
- virtual int validIdentifier(String *s);
-private:
- int emit_defun(Node *n, File *f_cl);
- int emit_dispatch_defun(Node *n);
- int emit_buffered_defuns(Node *n);
- int cClassHandler(Node *n);
- int cppClassHandler(Node *n);
-};
-static ALLEGROCL *allegrocl = 0;
-
-static String *trim(String *str) {
- char *c = Char(str);
- while (*c != '\0' && isspace((int) *c))
- ++c;
- String *result = NewString(c);
- Chop(result);
- return result;
-}
-
-int is_integer(String *s) {
- char *c = Char(s);
- if (c[0] == '#' && (c[1] == 'x' || c[1] == 'o'))
- c += 2;
-
- while (*c) {
- if (!isdigit(*c))
- return 0;
- c++;
- }
- return 1;
-}
-
-String *class_from_class_or_class_ref(String *type) {
- SwigType *stripped = SwigType_strip_qualifiers(type);
- if (SwigType_isclass(stripped))
- return stripped;
-
- if (SwigType_ispointer(stripped) || SwigType_isreference(stripped)) {
- // Printf(stderr,"It is a pointer/reference. Is it a class?\n");
- SwigType_pop(stripped);
- if (SwigType_isclass(stripped)) {
- return stripped;
- }
- }
- return 0;
-}
-
-String *lookup_defined_foreign_type(String *k) {
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "Looking up defined type '%s'.\n Found: '%s'\n", k, Getattr(defined_foreign_types, k));
-#endif
-
- return Getattr(defined_foreign_types, k);
-}
-
-String *listify_namespace(String *namespaze) {
- if (Len(namespaze) == 0)
- return NewString("()");
- String *result = NewStringf("(\"%s\")", namespaze);
- Replaceall(result, "::", "\" \"");
- return result;
-}
-
-String *namespaced_name(Node *n, String *ns = current_namespace) {
-
- return NewStringf("%s%s%s", ns, (Len(ns) != 0) ? "::" : "", Getattr(n, "sym:name"));
-}
-
-// "Namespace::Nested::Class2::Baz" -> "Baz"
-static String *strip_namespaces(String *str) {
- return Swig_scopename_last(str);
-}
-
-void add_linked_type(Node *n) {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Adding linked node of type: %s(%s) %s(%p)\n\n", nodeType(n), Getattr(n, "storage"), Getattr(n, "name"), n);
- // Swig_print_node(n);
-#endif
- if (!first_linked_type) {
- first_linked_type = n;
- Setattr(n, "allegrocl:last_linked_type", n);
- } else {
- Node *t = Getattr(first_linked_type, "allegrocl:last_linked_type");
- Setattr(t, "allegrocl:next_linked_type", n);
- Setattr(first_linked_type, "allegrocl:last_linked_type", n);
- }
-}
-
-void replace_linked_type(Node *old, Node *new_node) {
- Node *prev = Getattr(old, "allegrocl:prev_linked_type");
-
- Setattr(new_node, "allegrocl:next_linked_type", Getattr(old, "allegrocl:next_linked_type"));
- if (prev)
- Setattr(prev, "allegrocl:next_linked_type", new_node);
- Delattr(old, "allegrocl:next_linked_type");
- Delattr(old, "allegrocl:prev_linked_type");
-
- // check if we're replacing the first link.
- if (first_linked_type == old) {
- first_linked_type = new_node;
- Setattr(first_linked_type, "allegrocl:last_linked_type", Getattr(old, "allegrocl:last_linked_type"));
- }
- // check if we're replacing the last link.
- if (Getattr(first_linked_type, "allegrocl:last_linked_type") == old)
- Setattr(first_linked_type, "allegrocl:last_linked_type", new_node);
-}
-
-void insert_linked_type_at(Node *old, Node *new_node, int before = 1) {
- Node *p = 0;
-
- if (!first_linked_type) {
- add_linked_type(new_node);
- return;
- }
-
- if (!before) {
- Setattr(new_node, "allegrocl:next_linked_type", Getattr(old, "allegrocl:next_linked_type"));
- Setattr(old, "allegrocl:next_linked_type", new_node);
- if (Getattr(first_linked_type, "allegrocl:last_linked_type") == old)
- Setattr(first_linked_type, "allegrocl:last_linked_type", new_node);
- } else {
- Node *c = first_linked_type;
- while (c) {
- if (c == old) {
- break;
- } else {
- p = c;
- c = Getattr(c, "allegrocl:next_linked_type");
- }
- }
- if (c == old) {
- Setattr(new_node, "allegrocl:next_linked_type", c);
- if (first_linked_type == c) {
- first_linked_type = new_node;
- Setattr(first_linked_type, "allegrocl:last_linked_type", Getattr(c, "allegrocl:last_linked_type"));
- Delattr(c, "allegrocl:last_linked_type");
- }
- if (p)
- Setattr(p, "allegrocl:next_linked_type", new_node);
- }
- }
-}
-
-Node *find_linked_type_by_name(String *name) {
- Node *p = 0;
- Node *c = first_linked_type;
-
- // Printf(stderr,"in find_linked_type_by_name '%s'...", name);
- while (c) {
- String *key = Getattr(c, "name");
- if (!Strcmp(key, name)) {
- break;
- } else {
- p = c;
- c = Getattr(c, "allegrocl:next_linked_type");
- }
- }
- // Printf(stderr,"exit find_linked_type_by_name.\n");
-
- if (p && c)
- Setattr(c, "allegrocl:prev_linked_type", p);
- // Printf(stderr,"find_linked_type_by_name: DONE\n");
- return c;
-}
-
-Node *get_primary_synonym_of(Node *n) {
- Node *p = Getattr(n, "allegrocl:synonym-of");
- Node *prim = n;
-
- // Printf(stderr, "getting primary synonym of %p\n", n);
- while (p) {
- // Printf(stderr, " found one! %p\n", p);
- prim = p;
- p = Getattr(p, "allegrocl:synonym-of");
- }
- // Printf(stderr,"get_primary_syn: DONE. returning %s(%p)\n", Getattr(prim,"name"),prim);
- return prim;
-}
-
-void add_forward_referenced_type(Node *n, int overwrite = 0) {
- String *k = Getattr(n, "name");
- String *name = Getattr(n, "sym:name");
- String *ns = listify_namespace(current_namespace);
-
- String *val = Getattr(defined_foreign_types, k);
-
- if (!val || overwrite) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "Adding forward reference for %s (overwrite=%d)\n", k, overwrite);
-#endif
- Setattr(defined_foreign_types, Copy(k), NewString("forward-reference"));
-
- String *mangled_lname_gen = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", name, ns);
-
- Setattr(defined_foreign_ltypes, Copy(k), mangled_lname_gen);
- // Printf(f_cl, ";; forward reference stub\n"
- // "(swig-def-foreign-class \"%s\" (ff:foreign-pointer) (:class ))\n\n"
- // , name);
-
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Linking forward reference type = %s(%p)\n", k, n);
-#endif
- add_linked_type(n);
- }
-}
-
-void add_defined_foreign_type(Node *n, int overwrite = 0, String *k = 0,
- String *name = 0, String *ns = current_namespace) {
-
- String *val;
- String *ns_list = listify_namespace(ns);
- String *templated = n ? Getattr(n, "template") : 0;
- String *cDeclName = n ? Getattr(n, "name") : 0;
-
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "IN A-D-F-T. (n=%p, ow=%d, k=%s, name=%s, ns=%s\n", n, overwrite, k, name, ns);
- Printf(stderr, " templated = '%p', classDecl = '%p'\n", templated, cDeclName);
-#endif
- if (n) {
- if (!name)
- name = Getattr(n, "sym:name");
- if (!name)
- name = strip_namespaces(Getattr(n, "name"));
- if (templated) {
- k = namespaced_name(n);
- } else {
- String *kind_of_type = Getattr(n, "kind");
-
- /*
- For typedefs of the form:
-
- typedef struct __xxx { ... } xxx;
-
- behavior differs between C mode and C++ mode.
-
- C Mode:
- add_defined_foreign_type will be called once via classHandler
- to define the type for 'struct __xxx' and add the mapping from
- 'struct __xxx' -> 'xxx'
-
- It will also be called once via typedefHandler to add the
- mapping 'xxx' -> 'xxx'
-
- C++ Mode:
- add_defined_foreign_type will be called once via classHandler
- to define the type for 'xxx'. it also adds the mapping from
- 'xxx' -> 'xxx' and also for 'struct xxx' -> 'xxx'
-
- In typedefHandler, we again try to add the mapping from
- 'xxx' -> 'xxx', which already exists. This second mapping
- is ignored.
-
- Both modes:
-
- All references to this typedef'd struct will appear in
- generated lisp code as an objectd of type 'xxx'. For
- non-typedef'd structs, the classHand mapping will be
-
- struct __xxx -> (swig-insert-id "__xxx")
- */
- // Swig_print_node(n);
- String *unnamed = Getattr(n, "unnamed");
- if (kind_of_type && (!Strcmp(kind_of_type, "struct")
- || !Strcmp(kind_of_type, "union")) && cDeclName && !unnamed) {
- k = NewStringf("%s %s", kind_of_type, cDeclName);
- } else {
- if (!Strcmp(nodeType(n), "enum") && unnamed) {
- name = NewStringf("%s%d", anon_type_name, anon_type_count++);
- k = NewStringf("enum %s", name);
- Setattr(n, "allegrocl:name", name);
-
- } else {
- k = k ? k : Getattr(n, "name");
- }
- }
- }
- // Swig_print_node(n);
- }
-
- String *tname = SwigType_istemplate_templateprefix(name);
- if (tname) {
- String *temp = strip_namespaces(tname);
- name = NewStringf("%s%s%s", temp, SwigType_templateargs(name), SwigType_templatesuffix(name));
- Delete(temp);
- Delete(tname);
- }
-
- val = lookup_defined_foreign_type(k);
-
- int is_fwd_ref = 0;
- if (val)
- is_fwd_ref = !Strcmp(val, "forward-reference");
-
- if (!val || overwrite || is_fwd_ref) {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Adding defined type '%s' = '%s' '%s' (overwrite=%d, in-class=%d)\n", k, ns, name, overwrite, in_class);
-#endif
- String *mangled_name_gen = NewStringf("#.(swig-insert-id \"%s\" %s :type :type)", name, ns_list);
- String *mangled_lname_gen = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", name, ns_list);
-
- Setattr(defined_foreign_types, Copy(k), Copy(mangled_name_gen));
- Setattr(defined_foreign_ltypes, Copy(k), Copy(mangled_lname_gen));
-
- if (CPlusPlus) {
- bool cpp_struct = Strstr(k, "struct ") ? true : false;
- bool cpp_union = Strstr(k, "union ") ? true : false;
-
- String *cpp_type = 0;
- if (cpp_struct) {
- cpp_type = Copy(k);
- Replaceall(cpp_type, "struct ", "");
- } else if (cpp_union) {
- cpp_type = Copy(k);
- Replaceall(cpp_type, "union ", "");
- }
-
- if (cpp_struct || cpp_union) {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, " Also adding defined type '%s' = '%s' '%s' (overwrite=%d)\n", cpp_type, ns, name, overwrite);
-#endif
- Setattr(defined_foreign_types, Copy(cpp_type), Copy(mangled_name_gen));
- Setattr(defined_foreign_ltypes, Copy(cpp_type), Copy(mangled_lname_gen));
- }
- }
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "looking to add %s/%s(%p) to linked_type_list...\n", k, name, n);
-#endif
- if (is_fwd_ref) {
- // Printf(stderr,"*** 1\n");
- if (n)
- add_linked_type(n);
- } else {
- // Printf(stderr,"*** 1-a\n");
- if (SwigType_istemplate(k)) {
- SwigType *resolved = SwigType_typedef_resolve_all(k);
- // Printf(stderr,"*** 1-b\n");
- Node *match = find_linked_type_by_name(resolved);
- Node *new_node = 0;
- // Printf(stderr, "*** temp-1\n");
- if (n) {
- new_node = n;
- } else {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Creating a new templateInst:\n");
- Printf(stderr, " name = %s\n", resolved);
- Printf(stderr, " sym:name = %s\n", name);
- Printf(stderr, " real-name = %s\n", k);
- Printf(stderr, " type = %s\n", resolved);
- Printf(stderr, " ns = %s\n\n", ns);
-#endif
- new_node = NewHash();
- Setattr(new_node, "nodeType", "templateInst");
- Setattr(new_node, "name", Copy(resolved));
- Setattr(new_node, "sym:name", Copy(name));
- Setattr(new_node, "real-name", Copy(k));
- Setattr(new_node, "type", Copy(resolved));
- Setattr(new_node, "allegrocl:namespace", ns);
- Setattr(new_node, "allegrocl:package", ns);
- }
-
- if (!match) {
- if (!Strcmp(nodeType(new_node), "templateInst") && in_class) {
- /* this is an implicit template instantiation found while
- walking a class. need to insert this into the
- linked_type list before the current class definition */
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "trying to insert a templateInst before a class\n");
-#endif
- insert_linked_type_at(in_class, new_node);
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "DID IT!\n");
-#endif
- } else {
- // Printf(stderr,"*** 3\n");
- add_linked_type(new_node);
- }
- Setattr(new_node, "allegrocl:synonym:is-primary", "1");
- } else {
- // a synonym type was found (held in variable 'match')
- // Printf(stderr, "setting primary synonym of %p to %p\n", new_node, match);
- if (new_node == match)
- Printf(stderr, "Hey-4 * - '%s' is a synonym of itself!\n", Getattr(new_node, "name"));
- Setattr(new_node, "allegrocl:synonym-of", match);
- // Printf(stderr,"*** 4\n");
- add_linked_type(new_node);
- }
- } else {
- Node *match;
-
- if (!Strcmp(nodeType(n), "cdecl") && !Strcmp(Getattr(n, "storage"), "typedef")) {
- SwigType *type = SwigType_strip_qualifiers(Getattr(n, "type"));
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Examining typedef '%s' for class references. (%d)\n", type, SwigType_isclass(type));
-#endif
- if (SwigType_isclass(type)) {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Found typedef of a class '%s'\n", type);
-#endif
- /*
- For the following parsed expression:
-
- typedef struct __xxx { ... } xxx;
-
- if n is of kind "class" (defining the class 'struct __xxx'
- then we add n to the linked type list.
-
- if n is "cdecl" node of storage "typedef" (to note
- that xxx is equivalent to 'struct __xxx' then we don't
- want to add this node to the linked type list.
- */
- String *defined_type = lookup_defined_foreign_type(type);
- String *defined_key_type = lookup_defined_foreign_type(k);
-
- if ((Strstr(type, "struct ") || Strstr(type, "union "))
- && defined_type && !Strcmp(defined_type, defined_key_type)) {
- // mark as a synonym but don't add to linked_type list
- // Printf(stderr,"*** 4.8\n");
- Setattr(n, "allegrocl:synonym", "1");
- } else {
- SwigType *lookup_type = SwigType_istemplate(type) ? SwigType_typedef_resolve_all(type) : Copy(type);
- match = find_linked_type_by_name(lookup_type);
- if (match) {
- Setattr(n, "allegrocl:synonym", "1");
- Setattr(n, "allegrocl:synonym-of", match);
- Setattr(n, "real-name", Copy(lookup_type));
-
- // Printf(stderr, "*** pre-5: found match of '%s'(%p)\n", Getattr(match,"name"),match);
- // if(n == match) Printf(stderr, "Hey-5 *** setting synonym of %p to %p\n", n, match);
- // Printf(stderr,"*** 5\n");
- add_linked_type(n);
- } else {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Creating classfoward node for struct stub in typedef.\n");
-#endif
- Node *new_node = NewHash();
- String *symname = Copy(type);
- Replaceall(symname, "struct ", "");
- Setattr(new_node, "nodeType", "classforward");
- Setattr(new_node, "name", Copy(type));
- Setattr(new_node, "sym:name", symname);
- Setattr(new_node, "allegrocl:namespace", ns);
- Setattr(new_node, "allegrocl:package", ns);
-
- String *mangled_new_name = NewStringf("#.(swig-insert-id \"%s\" %s)", symname, ns_list);
- String *mangled_new_lname = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", symname, ns_list);
- Setattr(defined_foreign_types, Copy(symname), Copy(mangled_new_name));
- Setattr(defined_foreign_ltypes, Copy(symname), Copy(mangled_new_lname));
-
- // Printf(stderr,"Weird! Can't find the type!\n");
- add_forward_referenced_type(new_node);
- add_linked_type(new_node);
-
- Setattr(n, "allegrocl:synonym", "1");
- Setattr(n, "allegrocl:synonym-of", new_node);
-
- add_linked_type(n);
- }
- Delete(lookup_type);
- }
- } else {
- // check if it's a pointer or reference to a class.
- // Printf(stderr,"Checking if '%s' is a p. or r. to a class\n", type);
- String *class_ref = class_from_class_or_class_ref(type);
- if (class_ref) {
- match = find_linked_type_by_name(class_ref);
- Setattr(n, "allegrocl:synonym", "1");
- Setattr(n, "allegrocl:synonym-of", match);
- add_linked_type(n);
- }
- }
- Delete(type);
- // synonym types have already been added.
- // Printf(stderr,"*** 10\n");
- if (!Getattr(n, "allegrocl:synonym"))
- add_linked_type(n);
- } else if (Getattr(n, "template")) {
- // Printf(stderr, "this is a class template node(%s)\n", nodeType(n));
- String *resolved = SwigType_typedef_resolve_all(Getattr(n, "name"));
-
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, " looking up %s for linked type match with %s...\n", Getattr(n, "sym:name"), resolved);
-#endif
- match = find_linked_type_by_name(resolved);
- if (!match) {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "found no implicit instantiation of %%template node %s(%p)\n", Getattr(n, "name"), n);
-#endif
- add_linked_type(n);
- } else {
- Node *primary = get_primary_synonym_of(match);
-
- Setattr(n, "allegrocl:synonym:is-primary", "1");
- Delattr(primary, "allegrocl:synonym:is-primary");
- if (n == match)
- Printf(stderr, "Hey-7 * setting synonym of %p to %p\n (match = %p)", primary, n, match);
- Setattr(primary, "allegrocl:synonym-of", n);
- // Printf(stderr,"*** 7\n");
- add_linked_type(n);
- }
- } else {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "linking type '%s'(%p)\n", k, n);
-#endif
- // Printf(stderr,"*** 8\n");
- add_linked_type(n);
- }
- }
- }
- Delete(mangled_name_gen);
- Delete(mangled_lname_gen);
- } else {
- if (!CPlusPlus || Strcmp(Getattr(n,"kind"),"typedef")) {
- Swig_warning(WARN_TYPE_REDEFINED, Getfile(n), Getline(n),
- "Attempting to store a foreign type that exists: %s (%s)\n",
- k, val);
- }
- }
-
- Delete(ns_list);
-
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "OUT A-D-F-T\n");
-#endif
-}
-
-void note_implicit_template_instantiation(SwigType *t) {
- // the namespace of the implicit instantiation is not necessarily
- // current_namespace. Attempt to cull this from the type.
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "culling namespace of '%s' from '%s'\n", t, SwigType_templateprefix(t));
-#endif
- SwigType *type = Copy(t);
- SwigType *tok = SwigType_pop(type);
- String *implicit_ns = SwigType_istemplate(tok) ? Swig_scopename_prefix(SwigType_templateprefix(tok)) : 0;
- add_defined_foreign_type(0, 0, t, t, implicit_ns ? implicit_ns : current_namespace);
-
- Delete(type);
-}
-
-String *get_ffi_type(Node *n, SwigType *ty, const_String_or_char_ptr name) {
- /* lookup defined foreign type.
- if it exists, it will return a form suitable for placing
- into lisp code to generate the def-foreign-type name */
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "inside g_f_t: looking up '%s' '%s'\n", ty, name);
-#endif
-
- String *found_type = lookup_defined_foreign_type(ty);
-
- if (found_type) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "found_type '%s'\n", found_type);
-#endif
- return (Strcmp(found_type, "forward-reference") ? Copy(found_type) : get_ffi_type(n, fwdref_ffi_type, ""));
- } else {
- Node *node = NewHash();
- Setattr(node, "type", ty);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *tm = Swig_typemap_lookup("ffitype", node, name, 0);
- Delete(node);
-
- if (tm) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "g-f-t: found ffitype typemap '%s'\n", tm);
-#endif
- return NewString(tm);
- }
-
- if (SwigType_istemplate(ty)) {
- note_implicit_template_instantiation(ty);
- return Copy(lookup_defined_foreign_type(ty));
- }
- }
- return 0;
-}
-
-String *lookup_defined_foreign_ltype(String *l) {
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "Looking up defined ltype '%s'.\n Found: '%s'\n", l, Getattr(defined_foreign_ltypes, l));
-#endif
- return Getattr(defined_foreign_ltypes, l);
-}
-
-/* walk type and return string containing lisp version.
- recursive. */
-String *internal_compose_foreign_type(Node *n, SwigType *ty) {
-
- SwigType *tok;
- String *ffiType = NewString("");
-
- // for a function type, need to walk the parm list.
- while (Len(ty) != 0) {
- tok = SwigType_pop(ty);
-
- if (SwigType_isfunction(tok)) {
- // Generate Function wrapper
- Printf(ffiType, "(:function ");
- // walk parm list
- List *pl = SwigType_parmlist(tok);
-
- Printf(ffiType, "("); // start parm list
- for (Iterator i = First(pl); i.item; i = Next(i)) {
- SwigType *f_arg = SwigType_strip_qualifiers(i.item);
- Printf(ffiType, "%s ", internal_compose_foreign_type(n, f_arg));
- Delete(f_arg);
- }
- Printf(ffiType, ")"); // end parm list.
-
- // do function return type.
- Printf(ffiType, " %s)", internal_compose_foreign_type(n, ty));
- break;
- } else if (SwigType_ispointer(tok) || SwigType_isreference(tok)) {
- Printf(ffiType, "(* %s)", internal_compose_foreign_type(n, ty));
- } else if (SwigType_isarray(tok)) {
- Printf(ffiType, "(:array %s", internal_compose_foreign_type(n, ty));
- String *atype = NewString("int");
- String *dim = convert_literal(SwigType_array_getdim(tok, 0), atype);
- Delete(atype);
- if (is_integer(dim)) {
- Printf(ffiType, " %s)", dim);
- } else {
- Printf(ffiType, " #| %s |#)", SwigType_array_getdim(tok, 0));
- }
- } else if (SwigType_ismemberpointer(tok)) {
- // temp
- Printf(ffiType, "(* %s)", internal_compose_foreign_type(n, ty));
- } else {
- String *res = get_ffi_type(n, tok, "");
- if (res) {
- Printf(ffiType, "%s", res);
- } else {
- SwigType *resolved_type = SwigType_typedef_resolve_all(tok);
- if (Cmp(resolved_type, tok) != 0) {
- res = get_ffi_type(n, resolved_type, "");
- if (res) {
- } else {
- res = internal_compose_foreign_type(n, resolved_type);
- }
- if (res)
- Printf(ffiType, "%s", res);
- }
-
- if (!res) {
- String *is_struct = 0;
- String *tok_remove_text = 0;
- String *tok_name = Copy(tok);
- String *tok_key = SwigType_str(tok,0);
- if ((is_struct = Strstr(tok_key, "struct ")) || Strstr(tok_key, "union ")) {
- tok_remove_text = NewString(is_struct ? "struct " : "union ");
- }
-
- /* be more permissive of opaque types. This is the swig way.
- compiles will notice if these types are ultimately not
- present. */
-
- if(tok_remove_text) {
- Replaceall(tok_name,tok_remove_text,"");
- }
- tok_name = strip_namespaces(tok_name);
- Delete(tok_remove_text);
- // Swig_warning(WARN_TYPE_UNDEFINED_CLASS, Getfile(tok), Getline(tok), "Unable to find definition of '%s', assuming forward reference.\n", tok);
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "i-c-f-t: adding forward reference for unknown type '%s'. mapping: %s -> %s\n", tok, tok_key, tok_name);
-#endif
- Node *nn = NewHash();
- Setattr(nn,"nodeType","classforward");
- Setattr(nn,"kind","class");
- Setattr(nn,"sym:name",tok_name);
- Setattr(nn,"name",tok_key);
- Setattr(nn,"allegrocl:package",current_namespace);
-
- add_forward_referenced_type(nn, 0);
- // tok_name is dangling here, unused. ouch. why?
- Printf(ffiType, "%s", get_ffi_type(n, tok, ""), tok_name);
- }
- }
- }
- }
- return ffiType;
-}
-
-String *compose_foreign_type(Node *n, SwigType *ty, String * /*id*/ = 0) {
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "compose_foreign_type: ENTER (%s)...\n ", ty);
- // Printf(stderr, "compose_foreign_type: ENTER (%s)(%s)...\n ", ty, (id ? id : 0));
- /* String *id_ref = SwigType_str(ty, id);
- Printf(stderr, "looking up typemap for %s, found '%s'(%p)\n",
- id_ref, lookup_res ? Getattr(lookup_res, "code") : 0, lookup_res);
- if (lookup_res) Swig_print_node(lookup_res);
- */
-#endif
-
- /* should we allow named lookups in the typemap here? YES! */
- /* unnamed lookups should be found in get_ffi_type, called
- by internal_compose_foreign_type(), below. */
-
- /* I'm reverting to 'no' for the question above. I can no longer
- remember why I needed it. If a user needed it, I'll find out
- as soon as they upgrade. Sigh. -mutandiz 9/16/2008. */
-
-/*
- if(id && lookup_res) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "compose_foreign_type: EXIT-1 (%s)\n ", Getattr(lookup_res, "code"));
-#endif
- return NewString(Getattr(lookup_res, "code"));
- }
-*/
-
- SwigType *temp = SwigType_strip_qualifiers(ty);
- String *res = internal_compose_foreign_type(n, temp);
- Delete(temp);
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "compose_foreign_type: EXIT (%s)\n ", res);
-#endif
-
- return res;
-}
-
-void update_package_if_needed(Node *n, File *f = f_clwrap) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "update_package: ENTER... \n");
- Printf(stderr, " current_package = '%s'\n", current_package);
- Printf(stderr, " node_package = '%s'\n", Getattr(n, "allegrocl:package"));
- Printf(stderr, " node(%p) = '%s'\n", n, Getattr(n, "name"));
-#endif
- String *node_package = Getattr(n, "allegrocl:package");
- if (Strcmp(current_package, node_package)) {
- String *lispy_package = listify_namespace(node_package);
-
- Delete(current_package);
- current_package = Copy(node_package);
- Printf(f, "\n(swig-in-package %s)\n", lispy_package);
- Delete(lispy_package);
- }
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "update_package: EXIT.\n");
-#endif
-}
-
-static String *mangle_name(Node *n, char const *prefix = "ACL", String *ns = current_namespace) {
- String *suffix = Getattr(n, "sym:overname");
- String *pre_mangled_name = NewStringf("%s_%s__%s%s", prefix, ns, Getattr(n, "sym:name"), suffix);
- String *mangled_name = Swig_name_mangle(pre_mangled_name);
- Delete(pre_mangled_name);
- return mangled_name;
-}
-
-/* utilities */
-
-/* remove a pointer from ffitype. non-destructive.
- (* :char) ==> :char
- (* (:array :int 30)) ==> (:array :int 30) */
-String *dereference_ffitype(String *ffitype) {
- char *start;
- char *temp = Char(ffitype);
- String *reduced_type = 0;
-
- if(temp && temp[0] == '(' && temp[1] == '*') {
- temp += 2;
-
- // walk past start of pointer references
- while(*temp == ' ') temp++;
- start = temp;
- // temp = Char(reduced_type);
- reduced_type = NewString(start);
- temp = Char(reduced_type);
- // walk to end of string. remove closing paren
- while(*temp != '\0') temp++;
- *(--temp) = '\0';
- }
-
- return reduced_type ? reduced_type : Copy(ffitype);
-}
-
-/* returns new string w/ parens stripped */
-String *strip_parens(String *string) {
- string = Copy(string);
- Replaceall(string, "(", "");
- Replaceall(string, ")", "");
- return string;
-}
-
-int ALLEGROCL::validIdentifier(String *s) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "validIdentifier %s\n", s);
-#endif
-
- char *c = Char(s);
-
- bool got_dot = false;
- bool only_dots = true;
-
- /* Check that s is a valid common lisp symbol. There's a lot of leeway here.
- A common lisp symbol is essentially any token that's not a number and
- does not consist of only dots.
-
- We are expressly not allowing spaces in identifiers here, but spaces
- could be added via the identifier converter. */
- while (*c) {
- if (*c == '.') {
- got_dot = true;
- } else {
- only_dots = false;
- }
- if (!isgraph(*c))
- return 0;
- c++;
- }
-
- return (got_dot && only_dots) ? 0 : 1;
-}
-
-String *infix_to_prefix(String *val, char split_op, const String *op, String *type) {
- List *ored = Split(val, split_op, -1);
-
- // some float hackery
- 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;
- }
- Delete(ored);
- return 0;
-}
-
-/* To be called by code generating the lisp interface
- Will return a containing the literal based on type.
- Will return null if there are problems.
-
- try_to_split defaults to true (see stub above).
- */
-String *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;
- char *s = Char(num);
-
- String *ns = listify_namespace(current_namespace);
-
- // very basic parsing of infix expressions.
- if (try_to_split && SwigType_type(type) != T_STRING) {
- if ((res = infix_to_prefix(num, '|', "logior", type)))
- return res;
- if ((res = infix_to_prefix(num, '&', "logand", type)))
- return res;
- if ((res = infix_to_prefix(num, '^', "logxor", type)))
- return res;
- if ((res = infix_to_prefix(num, '*', "*", type)))
- return res;
- if ((res = infix_to_prefix(num, '/', "/", type)))
- return res;
- if ((res = infix_to_prefix(num, '+', "+", type)))
- return res;
- if ((res = infix_to_prefix(num, '-', "-", type)))
- return res;
- // if ((res = infix_to_prefix(num, '~', "lognot", type))) return res;
- // if( (res = infix_to_prefix(num, '<<', "ash", type)) ) return res;
- }
-
- // unary complement...
- if (s[0] == '~' && Len(num) >= 2) {
- String *id = NewString(++s);
- String *id_conv = convert_literal(id, type, false);
- Delete(id);
- if (id_conv)
- return NewStringf("(lognot %s)", id_conv);
- s--;
- }
-
- if (SwigType_type(type) == T_FLOAT || SwigType_type(type) == T_DOUBLE || SwigType_type(type) == T_LONGDOUBLE) {
- // Use CL syntax for float literals
- String *oldnum = Copy(num);
-
- // 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 == '.');
-
- 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)) {
- // Printf(stderr, "Can't parse '%s' as type '%s'.\n", oldnum, type);
- Delete(num);
- num = 0;
- }
- Delete(lisp_exp);
- } else {
- String *id = NewStringf("#.(swig-insert-id \"%s\" %s :type :constant)",
- num, ns);
- Delete(num);
- num = id;
- }
-
- Delete(oldnum);
- Delete(trimmed);
- Delete(ns);
- return num;
- } else if (SwigType_type(type) == T_CHAR) {
- /* Use CL syntax for character literals */
- Delete(num);
- Delete(trimmed);
- return NewStringf("#\\%s", num_param);
- } else if (SwigType_type(type) == T_STRING) {
- /* Use CL syntax for string literals */
- Delete(num);
- Delete(trimmed);
- return NewStringf("\"%s\"", num_param);
- } else if (Len(num) >= 1 && (isdigit(s[0]) || s[0] == '+' || s[0] == '-')) {
- /* use CL syntax for numbers */
- String *oldnum = Copy(num);
- int usuffixes = Replaceall(num, "u", "") + Replaceall(num, "U", "");
- int lsuffixes = Replaceall(num, "l", "") + Replaceall(num, "L", "");
- if (usuffixes > 1 || lsuffixes > 1) {
- Printf(stderr, "Weird!! number %s looks invalid.\n", oldnum);
- SWIG_exit(EXIT_FAILURE);
- }
- s = Char(num);
- if (s[0] == '0' && Len(num) >= 2) {
- /*octal or hex */
- res = NewStringf("#%c%s", tolower(s[1]) == 'x' ? 'x' : 'o', s + 2);
- Delete(num);
- } else {
- res = num;
- }
- Delete(oldnum);
- Delete(trimmed);
- return res;
- } else if (allegrocl->validIdentifier(num)) {
- /* convert C/C++ identifiers to CL symbols */
- res = NewStringf("#.(swig-insert-id \"%s\" %s :type :constant)", num, ns);
- Delete(num);
- Delete(trimmed);
- Delete(ns);
- return res;
- } else {
- Delete(trimmed);
- return num;
- }
-}
-
-
-void emit_stub_class(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_stub_class: ENTER... '%s'(%p)\n", Getattr(n, "sym:name"), n);
- Swig_print_node(n);
-#endif
-
-
- String *name = Getattr(n, "sym:name");
-
- if (Getattr(n, "allegrocl:synonym:already-been-stubbed"))
- return;
-
- String *tname = SwigType_istemplate_templateprefix(name);
- if (tname) {
- String *temp = strip_namespaces(tname);
- name = NewStringf("%s%s%s", temp, SwigType_templateargs(name), SwigType_templatesuffix(name));
- Delete(temp);
- Delete(tname);
- } else {
- name = strip_namespaces(name);
- }
-
- // Printf(f_clhead, ";; from emit-stub-class\n");
- update_package_if_needed(n, f_clhead);
- Printf(f_clhead, ";; class template stub.\n");
- Printf(f_clhead, "(swig-def-foreign-stub \"%s\")\n", name);
-
- Setattr(n, "allegrocl:synonym:already-been-stubbed", "1");
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_stub_class: EXIT\n");
-#endif
-}
-
-void emit_synonym(Node *synonym) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_synonym: ENTER... \n");
-#endif
-
- // Printf(stderr,"in emit_synonym for %s(%p)\n", Getattr(synonym,"name"),synonym);
- int is_tempInst = !Strcmp(nodeType(synonym), "templateInst");
- String *synonym_type;
-
- Node *of = get_primary_synonym_of(synonym);
-
- if (is_tempInst) {
- // Printf(stderr, "*** using real-name '%s'\n", Getattr(synonym,"real-name"));
- synonym_type = Getattr(synonym, "real-name");
- } else {
- // Printf(stderr, "*** using name '%s'\n", Getattr(synonym,"name"));
- synonym_type = Getattr(synonym, "name");
- }
-
- String *synonym_ns = listify_namespace(Getattr(synonym, "allegrocl:namespace"));
- String *syn_ltype, *syn_type, *of_ltype;
- // String *of_cdeclname = Getattr(of,"allegrocl:classDeclarationName");
- String *of_ns = Getattr(of, "allegrocl:namespace");
- String *of_ns_list = listify_namespace(of_ns);
- // String *of_name = of_cdeclname ? NewStringf("struct %s", Getattr(of,"name")) : NewStringf("%s::%s", of_ns, Getattr(of,"sym:name"));
- // String *of_name = NewStringf("%s::%s", of_ns, Getattr(of,"sym:name"));
- String *of_name = namespaced_name(of, of_ns);
-
- if (CPlusPlus && !Strcmp(nodeType(synonym), "cdecl")) {
- String *real_name = Getattr(synonym, "real-name");
- if (!real_name)
- real_name = NewString("Unknown"); // TODO: fix
- syn_ltype = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", strip_namespaces(real_name), synonym_ns);
- syn_type = NewStringf("#.(swig-insert-id \"%s\" %s :type :type)", strip_namespaces(real_name), synonym_ns);
- } else {
- syn_ltype = lookup_defined_foreign_ltype(synonym_type);
- syn_type = lookup_defined_foreign_type(synonym_type);
- }
-
- of_ltype = lookup_defined_foreign_ltype(of_name);
-
- // Printf(stderr,";; from emit-synonym syn='%s' of_ltype='%s'\n", syn_ltype, of_ltype);
- if( of_ltype )
- Printf(f_clhead, "(swig-def-synonym-type %s\n %s\n %s)\n", syn_ltype, of_ltype, syn_type);
-
- Delete(synonym_ns);
- Delete(of_ns_list);
- Delete(of_name);
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_synonym: EXIT\n");
-#endif
-}
-
-void emit_full_class(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_full_class: ENTER... \n");
-#endif
-
- String *name = Getattr(n, "sym:name");
- String *kind = Getattr(n, "kind");
-
- // Printf(stderr,"in emit_full_class: '%s'(%p).", Getattr(n,"name"),n);
- if (Getattr(n, "allegrocl:synonym-of")) {
- // Printf(stderr,"but it's a synonym of something.\n");
- update_package_if_needed(n, f_clhead);
- emit_synonym(n);
- return;
- }
- // collect superclasses
- 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 = lookup_defined_foreign_ltype(Getattr(i.item, "name"));
- // String *name = Getattr(i.item,"name");
- if (s) {
- Printf(supers, "%s", s);
- } else {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "emit_templ_inst: did not find ltype for base class %s (%s)", Getattr(i.item, "name"), Getattr(n, "allegrocl:namespace"));
-#endif
- }
- }
- } else {
- Printf(supers, "ff:foreign-pointer");
- }
-
- // check for "feature:aclmixins" and add those as well.
- Printf(supers, " %s)", Getattr(n,"feature:aclmixins"));
-
- // Walk children to generate type definition.
- String *slotdefs = NewString(" ");
-
-#ifdef ALLEGROCL_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 (!childDecl || !Strcmp(childDecl, "0"))
- childDecl = NewString("");
-
- SwigType *childType;
- String *cname;
-
- // don't include types for private slots (yet). spr33959.
- if(access && Strcmp(access,"public")) {
- childType = NewStringf("int");
- cname = NewString("nil");
- } else {
- childType = NewStringf("%s%s", childDecl, Getattr(c, "type"));
- cname = 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, "allegrocl:package"));
-
-#ifdef ALLEGROCL_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, compose_foreign_type(n, 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, "allegrocl:namespace"));
- update_package_if_needed(n, f_clhead);
- Printf(f_clhead, "(swig-def-foreign-class \"%s\"\n %s\n (:%s\n%s))\n\n", name, supers, kind, slotdefs);
-
- Delete(supers);
- Delete(ns_list);
-
- Setattr(n, "allegrocl:synonym:already-been-stubbed", "1");
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_full_class: EXIT\n");
-#endif
-
-}
-
-void emit_class(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_class: ENTER... '%s'(%p)\n", Getattr(n, "sym:name"), n);
-#endif
-
- int is_tempInst = !Strcmp(nodeType(n), "templateInst");
-
- String *ns_list = listify_namespace(Getattr(n, "allegrocl:namespace"));
- String *name = Getattr(n, is_tempInst ? "real-name" : "name");
-
- String *tname = SwigType_istemplate_templateprefix(name);
- if (tname) {
- String *temp = strip_namespaces(tname);
- name = NewStringf("%s%s%s", temp, SwigType_templateargs(name), SwigType_templatesuffix(name));
- Delete(temp);
- Delete(tname);
- } else {
- name = strip_namespaces(name);
- }
-
- if (Getattr(n, "allegrocl:synonym:is-primary")) {
- // Printf(stderr," is primary... ");
- if (is_tempInst) {
- emit_stub_class(n);
- } else {
- emit_full_class(n);
- }
- } else {
- // Node *primary = Getattr(n,"allegrocl:synonym-of");
- Node *primary = get_primary_synonym_of(n);
- if (primary && (primary != n)) {
- // Printf(stderr," emitting synonym... ");
- emit_stub_class(primary);
- update_package_if_needed(n, f_clhead);
- emit_synonym(n);
- } else {
- emit_full_class(n);
- }
- }
- // Printf(stderr,"DONE\n");
- Delete(name);
- Delete(ns_list);
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_class: EXIT\n");
-#endif
-}
-
-void emit_typedef(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_typedef: ENTER... \n");
-#endif
-
- String *name;
- String *sym_name = Getattr(n, "sym:name");
- String *type = NewStringf("%s%s", Getattr(n, "decl"), Getattr(n, "type"));
- String *lisp_type = compose_foreign_type(n, type);
- Delete(type);
- Node *in_class = Getattr(n, "allegrocl:typedef:in-class");
-
- // Printf(stderr,"in emit_typedef: '%s'(%p).",Getattr(n,"name"),n);
- if (Getattr(n, "allegrocl:synonym-of")) {
- // Printf(stderr," but it's a synonym of something.\n");
- emit_synonym(n);
- return;
- }
-
- if (in_class) {
- String *class_name = Getattr(in_class, "name");
- String *tname = SwigType_istemplate_templateprefix(class_name);
- if (tname) {
- String *temp = strip_namespaces(tname);
- class_name = NewStringf("%s%s%s", temp, SwigType_templateargs(class_name), SwigType_templatesuffix(class_name));
- Delete(temp);
- Delete(tname);
- }
-
- name = NewStringf("%s__%s", class_name, sym_name);
- Setattr(n, "allegrocl:in-class", in_class);
- } else {
- name = sym_name ? Copy(sym_name) : Copy(Getattr(n, "name"));
- }
-
- // leave these in for now. might want to change these to def-foreign-class at some point.
-// Printf(f_clhead, ";; %s\n", SwigType_typedef_resolve_all(lisp_type));
- Printf(f_clhead, "(swig-def-foreign-type \"%s\"\n %s)\n", name, lisp_type);
-
- Delete(name);
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_typedef: EXIT\n");
-#endif
-}
-
-void emit_enum_type_no_wrap(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_enum_type_no_wrap: ENTER... \n");
-#endif
-
- String *unnamed = Getattr(n, "unnamed");
- String *name;
- // SwigType *enumtype;
-
- name = unnamed ? Getattr(n, "allegrocl:name") : Getattr(n, "sym:name");
- SwigType *tmp = NewStringf("enum %s", unnamed ? unnamed : name);
-
- Node *node = NewHash();
- Setattr(node, "type", tmp);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *enumtype = Swig_typemap_lookup("ffitype", node, "", 0);
- Delete(node);
-
- Delete(tmp);
-
- if (name) {
- String *ns = listify_namespace(current_namespace);
-
- Printf(f_clhead, "(swig-def-foreign-type \"%s\" %s)\n", name, enumtype);
- Delete(ns);
-
- // walk children.
- Node *c;
- for (c = firstChild(n); c; c = nextSibling(c)) {
- if (!Getattr(c, "error")) {
- String *val = Getattr(c, "enumvalue");
- if (!val)
- val = Getattr(c, "enumvalueex");
- String *converted_val = convert_literal(val, Getattr(c, "type"));
- String *valname = Getattr(c, "sym:name");
-
- if (converted_val) {
- Printf(f_clhead, "(swig-defconstant \"%s\" %s)\n", valname, converted_val);
- Delete(converted_val);
- } else {
- Swig_warning(WARN_LANG_DISCARD_CONST, Getfile(n), Getline(n), "Unable to parse enum value '%s'. Setting to NIL\n", val);
- Printf(f_clhead, "(swig-defconstant \"%s\" nil #| %s |#)\n", valname, val);
- }
- }
- }
- }
- Printf(f_clhead, "\n");
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_enum_type_no_wrap: EXIT\n");
-#endif
-
-}
-
-void emit_enum_type(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_enum_type: ENTER... \n");
-#endif
-
- if (!Generate_Wrapper) {
- emit_enum_type_no_wrap(n);
- return;
- }
-
- String *unnamed = Getattr(n, "unnamed");
- String *name;
- // SwigType *enumtype;
-
- name = unnamed ? Getattr(n, "allegrocl:name") : Getattr(n, "sym:name");
- SwigType *tmp = NewStringf("enum %s", unnamed ? unnamed : name);
-
- Node *node = NewHash();
- Setattr(node, "type", tmp);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *enumtype = Swig_typemap_lookup("ffitype", node, "", 0);
- Delete(node);
-
- Delete(tmp);
-
- if (name) {
- String *ns = listify_namespace(current_namespace);
-
- Printf(f_clhead, "(swig-def-foreign-type \"%s\" %s)\n", name, enumtype);
- Delete(ns);
-
- // walk children.
- Node *c;
- for(c = firstChild(n); c; c=nextSibling(c)) {
- String *mangled_name = mangle_name(c, "ACL_ENUM", Getattr(c,"allegrocl:package"));
- Printf(f_clhead, "(swig-defvar \"%s\" \"%s\" :type :constant :ftype :signed-long)\n", Getattr(c, "sym:name"), mangled_name);
- Delete(mangled_name);
- }
- }
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_enum_type: EXIT\n");
-#endif
-
-}
-
-void emit_default_linked_type(Node *n) {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_default_linked_type: ENTER... \n");
-#endif
-
- // catchall for non class types.
- if (!Strcmp(nodeType(n), "classforward")) {
- Printf(f_clhead, ";; forward referenced stub.\n");
- Printf(f_clhead, "(swig-def-foreign-class \"%s\" (ff:foreign-pointer) (:class ))\n\n", Getattr(n, "sym:name"));
- } else if (!Strcmp(nodeType(n), "enum")) {
- emit_enum_type(n);
- } else {
- Printf(stderr, "Don't know how to emit node type '%s' named '%s'\n", nodeType(n), Getattr(n, "name"));
- }
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_default_linked_type: EXIT\n");
-#endif
-
-}
-
-void dump_linked_types(File *f) {
- Node *n = first_linked_type;
- int i = 0;
- while (n) {
- Printf(f, "%d: (%p) node '%s' name '%s'\n", i++, n, nodeType(n), Getattr(n, "sym:name"));
-
- Node *t = Getattr(n, "allegrocl:synonym-of");
- if (t)
- Printf(f, " synonym-of %s(%p)\n", Getattr(t, "name"), t);
- n = Getattr(n, "allegrocl:next_linked_type");
- }
-}
-
-void emit_linked_types() {
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_linked_types: ENTER... ");
-#endif
-
- Node *n = first_linked_type;
-
- while (n) {
- String *node_type = nodeType(n);
-
- // Printf(stderr,"emitting node %s(%p) of type %s.", Getattr(n,"name"),n, nodeType(n));
- if (!Strcmp(node_type, "class") || !Strcmp(node_type, "templateInst")) {
- // may need to emit a stub, so it will update the package itself.
- // Printf(stderr," Passing to emit_class.");
- emit_class(n);
- } else if (!Strcmp(nodeType(n), "cdecl")) {
- // Printf(stderr," Passing to emit_typedef.");
- update_package_if_needed(n, f_clhead);
- emit_typedef(n);
- } else {
- // Printf(stderr," Passing to default_emitter.");
- update_package_if_needed(n, f_clhead);
- emit_default_linked_type(n);
- }
-
- n = Getattr(n, "allegrocl:next_linked_type");
- // Printf(stderr,"returned.\n");
- }
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_linked_types: EXIT\n");
-#endif
-}
-
-extern "C" Language *swig_allegrocl(void) {
- return (allegrocl = new ALLEGROCL());
-}
-
-void ALLEGROCL::main(int argc, char *argv[]) {
- int i;
-
- Preprocessor_define("SWIGALLEGROCL 1", 0);
- SWIG_library_directory("allegrocl");
- SWIG_config_file("allegrocl.swg");
-
- for (i = 1; i < argc; i++) {
- if (!strcmp(argv[i], "-identifier-converter")) {
- char *conv = argv[i + 1];
-
- if (!conv)
- Swig_arg_error();
-
- Swig_mark_arg(i);
- Swig_mark_arg(i + 1);
- i++;
-
- /* check for built-ins */
- if (!strcmp(conv, "lispify")) {
- Delete(identifier_converter);
- identifier_converter = NewString("identifier-convert-lispify");
- } else if (!strcmp(conv, "null")) {
- Delete(identifier_converter);
- identifier_converter = NewString("identifier-convert-null");
- } else {
- /* Must be user defined */
- Delete(identifier_converter);
- identifier_converter = NewString(conv);
- }
- } else if (!strcmp(argv[i], "-cwrap")) {
- CWrap = true;
- Swig_mark_arg(i);
- } else if (!strcmp(argv[i], "-nocwrap")) {
- CWrap = false;
- Swig_mark_arg(i);
- } else if (!strcmp(argv[i], "-isolate")) {
- unique_swig_package = true;
- Swig_mark_arg(i);
- }
-
- if (!strcmp(argv[i], "-help")) {
- Printf(stdout, "%s\n", usage);
- }
-
- }
-
- allow_overloading();
-}
-
-int ALLEGROCL::top(Node *n) {
- module_name = Getattr(n, "name");
- String *cxx_filename = Getattr(n, "outfile");
- String *cl_filename = NewString("");
-
- swig_package = unique_swig_package ? NewStringf("swig.%s", module_name) : NewString("swig");
-
- Printf(cl_filename, "%s%s.cl", SWIG_output_directory(), module_name);
-
- f_cl = NewFile(cl_filename, "w", SWIG_output_files());
- if (!f_cl) {
- Printf(stderr, "Unable to open %s for writing\n", cl_filename);
- SWIG_exit(EXIT_FAILURE);
- }
-
- Generate_Wrapper = CPlusPlus || CWrap;
-
- if (Generate_Wrapper) {
- f_begin = NewFile(cxx_filename, "w", SWIG_output_files());
- if (!f_begin) {
- Delete(f_cl);
- Printf(stderr, "Unable to open %s for writing\n", cxx_filename);
- SWIG_exit(EXIT_FAILURE);
- }
- } else
- f_begin = 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("lisp", f_clwrap);
- Swig_register_filebyname("lisphead", f_cl);
-
- Swig_banner(f_begin);
-
- Printf(f_runtime, "\n\n#ifndef SWIGALLEGROCL\n#define SWIGALLEGROCL\n#endif\n\n");
-
- Swig_banner_target_lang(f_cl, ";;");
-
- Printf(f_cl, "\n"
- "(defpackage :%s\n"
- " (:use :common-lisp :ff :excl)\n"
- " (:export #:*swig-identifier-converter* #:*swig-module-name*\n"
- " #:*void* #:*swig-export-list*))\n"
- "(in-package :%s)\n\n"
- "(eval-when (:compile-toplevel :load-toplevel :execute)\n"
- " (defparameter *swig-identifier-converter* '%s)\n"
- " (defparameter *swig-module-name* :%s))\n\n", swig_package, swig_package, identifier_converter, module_name);
- Printf(f_cl, "(defpackage :%s\n" " (:use :common-lisp :%s :ff :excl))\n\n", module_name, swig_package);
-
- Printf(f_clhead, "(in-package :%s)\n", module_name);
-
- Language::top(n);
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- dump_linked_types(stderr);
-#endif
- emit_linked_types();
-
- Printf(f_clwrap, "\n(cl::in-package :%s)\n", swig_package);
- Printf(f_clwrap, "\n(macrolet ((swig-do-export ()\n");
- Printf(f_clwrap, " `(dolist (s ',*swig-export-list*)\n");
- Printf(f_clwrap, " (apply #'export s))))\n");
- Printf(f_clwrap, " (swig-do-export))\n");
- Printf(f_clwrap, "\n(setq *swig-export-list* nil)\n");
-
- Printf(f_cl, "%s\n", f_clhead);
- Printf(f_cl, "%s\n", f_clwrap);
-
- Delete(f_cl);
- Delete(f_clhead);
- Delete(f_clwrap);
-
- Dump(f_runtime, f_begin);
- Printf(f_begin, "%s\n", f_cxx_wrapper);
-
- Delete(f_runtime);
- Delete(f_begin);
- Delete(f_cxx_wrapper);
-
- // Swig_print_tree(n);
-
- return SWIG_OK;
-}
-
-int any_varargs(ParmList *pl) {
- Parm *p;
-
- for (p = pl; p; p = nextSibling(p)) {
- if (SwigType_isvarargs(Getattr(p, "type")))
- return 1;
- }
-
- return 0;
-}
-
-String *get_lisp_type(Node *n, SwigType *ty, const_String_or_char_ptr name) {
- Node *node = NewHash();
- Setattr(node, "type", ty);
- Setattr(node, "name", name);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *tm = Swig_typemap_lookup("lisptype", node, "", 0);
- Delete(node);
-
- return tm ? NewString(tm) : NewString("");
-}
-
-Node *parent_node_skipping_extends(Node *n) {
- Node *result = n;
- do {
- result = parentNode(result);
- }
- while (Cmp("extend", nodeType(result)) == 0);
- return result;
-}
-
-/* -----------------------------------------------------------------------------
- * emit_num_lin_arguments()
- *
- * Calculate the total number of arguments. This function is safe for use
- * with multi-argument typemaps which may change the number of arguments in
- * strange ways.
- * ----------------------------------------------------------------------------- */
-
-int emit_num_lin_arguments(ParmList *parms) {
- Parm *p = parms;
- int nargs = 0;
-
- while (p) {
- // Printf(stderr,"enla: '%s' lin='%p' numinputs='%s'\n", Getattr(p,"name"), Getattr(p,"tmap:lin"), Getattr(p,"tmap:lin:numinputs"));
- if (Getattr(p, "tmap:lin")) {
- nargs += GetInt(p, "tmap:lin:numinputs");
- p = Getattr(p, "tmap:lin:next");
- } else {
- p = nextSibling(p);
- }
- }
-
- /* DB 04/02/2003: Not sure this is necessary with tmap:in:numinputs */
- /*
- if (parms && (p = Getattr(parms,"emit:varargs"))) {
- if (!nextSibling(p)) {
- nargs--;
- }
- }
- */
- return nargs;
-}
-
-String *id_converter_type(SwigType const *type) {
- SwigType *t = Copy(type);
- String *result = 0;
-
- if (SwigType_ispointer(t)) {
- SwigType_pop(t);
- String *pointee = id_converter_type(t);
- result = NewStringf("(:* %s)", pointee);
- Delete(pointee);
- } else if (SwigType_ismemberpointer(t)) {
- String *klass = SwigType_parm(t);
- SwigType_pop(t);
- String *member = id_converter_type(t);
- result = NewStringf("(:member \"%s\" %s)", klass, member);
- Delete(klass);
- Delete(member);
- } else if (SwigType_isreference(t)) {
- SwigType_pop(t);
- String *referencee = id_converter_type(t);
- result = NewStringf("(:& %s)", referencee);
- Delete(referencee);
- } else if (SwigType_isarray(t)) {
- String *size = SwigType_parm(t);
- SwigType_pop(t);
- String *element_type = id_converter_type(t);
- result = NewStringf("(:array %s \"%s\")", element_type, size);
- Delete(size);
- Delete(element_type);
- } else if (SwigType_isfunction(t)) {
- result = NewString("(:function (");
- String *parmlist_str = SwigType_parm(t);
- List *parms = SwigType_parmlist(parmlist_str);
-
- for (Iterator i = First(parms); i.item;) {
- String *parm = id_converter_type((SwigType *) i.item);
- Printf(result, "%s", parm);
- i = Next(i);
- if (i.item)
- Printf(result, " ");
- Delete(parm);
- }
- SwigType_pop(t);
- String *ret = id_converter_type(t);
- Printf(result, ") %s)", ret);
-
- Delete(parmlist_str);
- Delete(parms);
- Delete(ret);
- } else if (SwigType_isqualifier(t)) {
- result = NewString("(:qualified (");
- String *qualifiers_str = Copy(SwigType_parm(t)); // ?!
- // Replaceall below SEGVs if we don't put the Copy here...
- SwigType_pop(t);
- String *qualifiee = id_converter_type(t);
-
- Replaceall(qualifiers_str, " ", " :");
- if (Len(qualifiers_str) > 0)
- Printf(result, ":");
- Printf(result, "%s) %s)", qualifiers_str, qualifiee);
-
- Delete(qualifiers_str);
- Delete(qualifiee);
- } else if (SwigType_istemplate(t)) {
- result = NewStringf("(:template \"%s\")", t);
- } else { /* if (SwigType_issimple(t)) */
-
- if (Strstr(Char(t), "::")) {
- result = listify_namespace(t);
- } else {
- result = NewStringf("\"%s\"", t);
- }
- }
-
- Delete(t);
- return result;
-}
-
-static ParmList *parmlist_with_names(ParmList *pl) {
- ParmList *pl2 = CopyParmList(pl);
- for (Parm *p = pl, *p2 = pl2; p2; p = nextSibling(p), p2 = nextSibling(p2)) {
- if (!Getattr(p2, "name"))
- Setattr(p2, "name", Getattr(p2, "lname"));
- Setattr(p2, "name", strip_namespaces(Getattr(p2, "name")));
- Setattr(p2, "tmap:ctype", Getattr(p, "tmap:ctype"));
-
- String *temp = Getattr(p, "tmap:lin");
- if (temp) {
- Setattr(p2, "tmap:lin", temp);
- Setattr(p2, "tmap:lin:next", Getattr(p, "tmap:lin:next"));
- }
- }
- return pl2;
-}
-
-static String *parmlist_str_id_converter(ParmList *pl) {
- String *result = NewString("");
- for (Parm *p = pl; p;) {
- String *lispy_type = id_converter_type(Getattr(p, "type"));
- Printf(result, "(\"%s\" %s)", Getattr(p, "name"), lispy_type);
- Delete(lispy_type);
- if ((p = nextSibling(p)))
- Printf(result, " ");
- }
- return result;
-}
-
-String *collect_others_args(Node *overload) {
- String *overloaded_from = Getattr(overload, "sym:overloaded");
- String *others_args = NewString("");
- int first_overload = 1;
-
- for (Node *overload2 = overloaded_from; overload2; overload2 = Getattr(overload2, "sym:nextSibling")) {
- if (overload2 == overload || GetInt(overload2, "overload:ignore"))
- continue;
-
- ParmList *opl = parmlist_with_names(Getattr(overload2, "wrap:parms"));
- String *args = parmlist_str_id_converter(opl);
- if (!first_overload)
- Printf(others_args, "\n ");
- Printf(others_args, "(%s)", args);
- Delete(args);
- Delete(opl);
- first_overload = 0;
- }
- return others_args;
-}
-
-struct IDargs {
- String *name;
- String *type;
- String *klass;
- String *arity;
-
- IDargs():name(0), type(0), klass(0), arity(0) {
- }
-
- String *full_quoted_str() {
- String *result = no_others_quoted_str();
- if (arity)
- Printf(result, " :arity %s", arity);
- return result;
- }
-
- String *no_others_quoted_str() {
- String *result = NewString("");
- Printf(result, "\"%s\" :type :%s", name, type);
- if (klass)
- Printf(result, " :class \"%s\"", klass);
- return result;
- }
-
- String *noname_str(bool include_class = true) {
- String *result = NewString("");
- Printf(result, " :type :%s", type);
- if (klass && include_class)
- Printf(result, " :class \"%s\"", klass);
- if (arity)
- Printf(result, " :arity %s", arity);
- return result;
- }
-
- String *noname_no_others_str(bool include_class = true) {
- String *result = NewString("");
- Printf(result, " :type :%s", type);
- if (klass && include_class)
- Printf(result, " :class \"%s\"", klass);
- return result;
- }
-};
-IDargs *id_converter_arguments(Node *n) {
- IDargs *result = (IDargs *) GetVoid(n, "allegrocl:id-converter-args");
- if (!result)
- result = new IDargs;
-
- // Base name
- if (!result->name) {
- result->name = Getattr(n, "allegrocl:old-sym:name");
- if (!result->name)
- result->name = Getattr(n, "sym:name");
- result->name = Copy(result->name);
- }
- // :type
- if (result->type)
- Delete(result->type);
- if (!Getattr(n, "allegrocl:kind"))
- Setattr(n, "allegrocl:kind", "function");
- if (Strstr(Getattr(n, "name"), "operator "))
- Replaceall(Getattr(n, "allegrocl:kind"), "function", "operator");
- if (Strstr(Getattr(n, "allegrocl:kind"), "variable")) {
- int name_end = Len(Getattr(n, "sym:name")) - 4;
- char *str = Char(Getattr(n, "sym:name"));
- String *get_set = NewString(str + name_end + 1);
- result->type = Copy(Getattr(n, "allegrocl:kind"));
- Replaceall(result->type, "variable", "");
- Printf(result->type, "%ster", get_set);
- Delete(get_set);
- } else {
- result->type = Copy(Getattr(n, "allegrocl:kind"));
- }
-
- // :class
- if (Strstr(result->type, "member ")) {
- Replaceall(result->type, "member ", "");
- if (!result->klass) {
- result->klass = Copy(Getattr(parent_node_skipping_extends(n), "sym:name"));
- }
- }
- // :arity
- if (Getattr(n, "sym:overloaded")) {
- if (result->arity)
- Delete(result->arity);
- result->arity = NewStringf("%d",
- // emit_num_arguments(Getattr(n, "wrap:parms")));
- emit_num_lin_arguments(Getattr(n, "wrap:parms")));
- // Printf(stderr, "got arity of '%s' node '%s' '%p'\n", result->arity, Getattr(n,"name"), Getattr(n,"wrap:parms"));
- }
-
- SetVoid(n, "allegrocl:id-converter-args", result);
- return result;
-}
-
-int ALLEGROCL::emit_buffered_defuns(Node *n) {
-
- Node *overloaded_from = Getattr(n, "sym:overloaded");
-
- String *wrap;
-
- if (!overloaded_from) {
- wrap = Getattr(n, "allegrocl:lisp-wrap");
-
- Printf(f_clwrap, "%s\n", wrap);
- Delattr(n, "allegrocl:lisp-wrap");
- Delete(wrap);
- } else {
- for (Node *overload = overloaded_from; overload; overload = Getattr(overload, "sym:nextSibling")) {
- String *others_args = collect_others_args(overload);
- wrap = Getattr(overload, "allegrocl:lisp-wrap");
-
- Replaceall(wrap, "@@OTHERS-ARGS-GO-HERE@@", others_args);
-// IDargs* id_args = id_converter_arguments(overload);
-// Replaceall(id_args->others_args, "@@OTHERS-ARGS-GO-HERE@@", others_args);
-
- if (!GetInt(overload, "overload:ignore"))
- Printf(f_clwrap, "%s", wrap);
-
- Delattr(overload, "allegrocl:lisp-wrap");
- Delete(wrap);
- }
- }
- return SWIG_OK;
-}
-
-String *dispatching_type(Node *n, Parm *p) {
- String *result = 0;
-
- String *parsed = Getattr(p, "type"); //Swig_cparse_type(Getattr(p,"tmap:ctype"));
- String *cl_t = SwigType_typedef_resolve_all(parsed);
-
- Node *node = NewHash();
- Setattr(node, "type", parsed);
- Setfile(node, Getfile(n));
- Setline(node, Getline(n));
- const String *tm = Swig_typemap_lookup("lispclass", node, Getattr(p, "name"), 0);
- Delete(node);
-
- if (tm) {
- result = Copy(tm);
- } else {
- String *lookup_type = class_from_class_or_class_ref(parsed);
- if (lookup_type)
- result = lookup_defined_foreign_ltype(lookup_type);
- }
-
- // if (!result && SwigType_ispointer(cl_t)) {
- // SwigType_pop(cl_t);
- // result = lookup_defined_foreign_ltype(cl_t);
- // }
-
- if (!result)
- result = NewStringf("ff:foreign-pointer");
-
- // Delete(parsed);
- Delete(cl_t);
- return result;
-}
-
-int ALLEGROCL::emit_dispatch_defun(Node *n) {
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_dispatch_defun: ENTER... ");
-#endif
- List *overloads = Swig_overload_rank(n, true);
-
- // Printf(stderr,"\ndispatch node=%p\n\n", n);
- // Swig_print_node(n);
-
- Node *overloaded_from = Getattr(n,"sym:overloaded");
- bool include_class = Getattr(overloaded_from, "allegrocl:dispatcher:include-class") ? true : false;
- String *id_args = id_converter_arguments(n)->noname_no_others_str(include_class);
- Printf(f_clwrap, "(swig-dispatcher (\"%s\" %s :arities (", Getattr(overloaded_from, "allegrocl:dispatcher:name"), id_args);
-
- Delattr(overloaded_from, "allegrocl:dispatcher:include-class");
- Delattr(overloaded_from, "allegrocl:dispatcher:name");
-
- int last_arity = -1;
- for (Iterator i = First(overloads); i.item; i = Next(i)) {
- int arity = emit_num_lin_arguments(Getattr(i.item, "wrap:parms"));
- if (arity == last_arity)
- continue;
-
- Printf(f_clwrap, "%s%d", last_arity == -1 ? "" : " ", arity);
-
- last_arity = arity;
- }
- Printf(f_clwrap, ")))\n");
-
- Delete(id_args);
- Delete(overloads);
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_dispatch_defun: EXIT\n");
-#endif
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::emit_defun(Node *n, File *fcl) {
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_defun: ENTER... ");
-#endif
-
- // avoid name conflicts between smart pointer wrappers and the wrappers for the
- // actual class.
- bool smartmemberwrapper = (!Cmp(Getattr(n, "view"), "memberfunctionHandler") &&
- Getattr(n,"allocate:smartpointeraccess"));
-
-#ifdef ALLEGROCL_DEBUG
- int auto_generated = Cmp(Getattr(n, "view"), "globalfunctionHandler");
- Printf(stderr, "%s%sfunction %s%s%s\n", auto_generated ? "> " : "", Getattr(n, "sym:overloaded")
- ? "overloaded " : "", current_namespace, (current_namespace) > 0 ? "::" : "", Getattr(n, "sym:name"));
- Printf(stderr, " (view: %s)\n", Getattr(n, "view"));
- Swig_print_node(n);
-#endif
-
-
- String *funcname = Getattr(n, "allegrocl:old-sym:name");
- if (smartmemberwrapper || !funcname)
- funcname = Getattr(n, "sym:name");
-
- String *mangled_name = Getattr(n, "wrap:name");
- ParmList *pl = parmlist_with_names(Getattr(n, "wrap:parms"));
-
- // attach typemap info.
- Wrapper *wrap = NewWrapper();
- Swig_typemap_attach_parms("lin", pl, wrap);
- // Swig_typemap_attach_parms("ffitype", pl, wrap);
- Swig_typemap_lookup("lout", n, Swig_cresult_name(), 0);
-
- SwigType *result_type = Swig_cparse_type(Getattr(n, "tmap:ctype"));
- // prime the pump, with support for OUTPUT, INOUT typemaps.
- Printf(wrap->code,
- "(cl::let ((ACL_ffresult %s:*void*)\n ACL_result)\n $body\n (cl::if (cl::eq ACL_ffresult %s:*void*)\n (cl::values-list ACL_result)\n (cl::values-list (cl::cons ACL_ffresult ACL_result))))",
- swig_package, swig_package);
-
- Parm *p;
- int largnum = 0, argnum = 0, first = 1;
- // int varargs=0;
- if (Generate_Wrapper) {
- String *extra_parms = id_converter_arguments(n)->noname_str(smartmemberwrapper ? false : true);
- Node *overloaded_from = Getattr(n,"sym:overloaded");
- if (overloaded_from) {
- if(!GetFlag(overloaded_from,"allegrocl:dispatcher:name")) {
- Setattr(overloaded_from,"allegrocl:dispatcher:name",funcname);
- Setattr(overloaded_from,"allegrocl:dispatcher:include-class", smartmemberwrapper ? 0 : "1");
- // Printf(stderr, " set a:d:name='%s', a:d:i-c='%s'\n", Getattr(n,"allegrocl:dispatcher:name"), Getattr(n,"allegrocl:dispatcher:include-class"));
- }
- Printf(fcl, "(swig-defmethod (\"%s\" \"%s\"%s)\n", funcname, mangled_name, extra_parms);
- } else
- Printf(fcl, "(swig-defun (\"%s\" \"%s\"%s)\n", funcname, mangled_name, extra_parms);
- Delete(extra_parms);
- }
- // Just C
- else {
- Printf(fcl, "(swig-defun (\"%s\" \"%s\")\n", funcname, Generate_Wrapper ? mangled_name : funcname);
- }
-
- //////////////////////////////////////
- // Lisp foreign call parameter list //
- //////////////////////////////////////
- Printf(fcl, " (");
-
- /* Special cases */
-
- if (ParmList_len(pl) == 0) {
- Printf(fcl, ":void");
-/* } else if (any_varargs(pl)) {
- Printf(fcl, "#| varargs |#");
- varargs=1; */
- } else {
- String *largs = NewString("");
-
- for (p = pl; p; p = nextSibling(p), argnum++, largnum++) {
- // SwigType *argtype=Getattr(p, "type");
- SwigType *argtype = Swig_cparse_type(Getattr(p, "tmap:ctype"));
- SwigType *parmtype = Getattr(p,"type");
-
- if (!first) {
- Printf(fcl, "\n ");
- }
-
- /* by default, skip varargs */
- if (!SwigType_isvarargs(parmtype)) {
- String *argname = NewStringf("PARM%d_%s", largnum, Getattr(p, "name"));
-
- // Printf(stderr,"%s\n", Getattr(p,"tmap:lin"));
- String *ffitype = compose_foreign_type(n, argtype, Getattr(p,"name"));
- String *deref_ffitype = dereference_ffitype(ffitype);
- String *lisptype = get_lisp_type(n, parmtype, Getattr(p, "name"));
-
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "lisptype of '%s' '%s' = '%s'\n", parmtype,
- Getattr(p, "name"), lisptype);
-#endif
-
- // while we're walking the parameters, generating LIN
- // wrapper code...
- Setattr(p, "lname", NewStringf("SWIG_arg%d", largnum));
-
- String *parm_code = Getattr(p, "tmap:lin");
- if (parm_code) {
- String *lname = Getattr(p, "lname");
-
- Printf(largs, " %s", lname);
- Replaceall(parm_code, "$in_fftype", ffitype); // must come before $in
- Replaceall(parm_code, "$in", argname);
- Replaceall(parm_code, "$out", lname);
- Replaceall(parm_code, "$*in_fftype", deref_ffitype);
- Replaceall(wrap->code, "$body", parm_code);
- }
-
- String *dispatchtype = Getattr(n, "sym:overloaded") ? dispatching_type(n, p) : NewString("");
-
- // if this parameter has been removed from the C/++ wrapper
- // it shouldn't be in the lisp wrapper either.
- if (!checkAttribute(p, "tmap:in:numinputs", "0")) {
- Printf(fcl, "(%s %s %s %s %s)",
- // parms in the ff wrapper, but not in the lisp wrapper.
- (checkAttribute(p, "tmap:lin:numinputs", "0") ? ":p-" : ":p+"), argname, dispatchtype, ffitype, lisptype);
-
- first = 0;
- }
-
- Delete(argname);
- Delete(ffitype);
- Delete(deref_ffitype);
- Delete(lisptype);
- }
- }
-
- Printf(wrap->locals, "%s", largs);
- }
-
- String *lout = Getattr(n, "tmap:lout");
- Replaceall(lout, "$owner", GetFlag(n, "feature:new") ? "t" : "nil");
-
- Replaceall(wrap->code, "$body", lout);
- // $lclass handling.
- String *lclass = (String *) 0;
- SwigType *parsed = Swig_cparse_type(Getattr(n, "tmap:ctype"));
- // SwigType *cl_t = SwigType_typedef_resolve_all(parsed);
- SwigType *cl_t = class_from_class_or_class_ref(parsed);
- String *out_ffitype = compose_foreign_type(n, parsed);
- String *deref_out_ffitype;
- String *out_temp = Copy(parsed);
-
- if (SwigType_ispointer(out_temp)) {
- SwigType_pop(out_temp);
- deref_out_ffitype = compose_foreign_type(n, out_temp);
- } else {
- deref_out_ffitype = Copy(out_ffitype);
- }
-
- Delete(out_temp);
-
- Delete(parsed);
-
- if (cl_t) {
- lclass = lookup_defined_foreign_ltype(cl_t);
- }
-
- int ff_foreign_ptr = 0;
- if (!lclass) {
- ff_foreign_ptr = 1;
- lclass = NewStringf("ff:foreign-pointer");
- }
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "for output wrapping %s: type=%s, ctype=%s\n", Getattr(n, "name"),
- Getattr(n, "type"), Swig_cparse_type(Getattr(n, "tmap:ctype")));
-#endif
-
- if (lclass)
- Replaceall(wrap->code, "$lclass", lclass);
- if (out_ffitype)
- Replaceall(wrap->code, "$out_fftype", out_ffitype);
- if (deref_out_ffitype)
- Replaceall(wrap->code, "$*out_fftype", deref_out_ffitype);
-
- Replaceall(wrap->code, "$body", NewStringf("(swig-ff-call%s)", wrap->locals));
- String *ldestructor = Copy(lclass);
- if (ff_foreign_ptr)
- Replaceall(ldestructor, ldestructor, "cl::identity");
- else
- Replaceall(ldestructor, ":type :class", ":type :destructor");
- Replaceall(wrap->code, "$ldestructor", ldestructor);
- Delete(ldestructor);
-
- Printf(fcl, ")\n"); /* finish arg list */
-
- /////////////////////////////////////////////////////
- // Lisp foreign call return type and optimizations //
- /////////////////////////////////////////////////////
- Printf(fcl, " (:returning (%s %s)", compose_foreign_type(n, result_type), get_lisp_type(n, Getattr(n, "type"), Swig_cresult_name()));
-
- for (Iterator option = First(n); option.item; option = Next(option)) {
- if (Strncmp("feature:ffargs:", option.key, 15))
- continue;
- String *option_val = option.item;
- String *option_name = NewString(Char(option.key) + 14);
- Replaceall(option_name, "_", "-");
-
- // TODO: varargs vs call-direct ?
- Printf(fcl, "\n %s %s", option_name, option_val);
-
- Delete(option_name);
- }
-
- Printf(fcl, ")\n %s)\n\n", wrap->code);
- // Wrapper_print(wrap, stderr);
-
- Delete(result_type);
- Delete(mangled_name);
- Delete(pl);
- DelWrapper(wrap);
-
-#ifdef ALLEGROCL_WRAP_DEBUG
- Printf(stderr, "emit_defun: EXIT\n");
-#endif
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::functionWrapper(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "functionWrapper %s\n", Getattr(n,"name"));
-#endif
-
-
- ParmList *parms = CopyParmList(Getattr(n, "parms"));
- Wrapper *f = NewWrapper();
- SwigType *t = Getattr(n, "type");
- String *name = Getattr(n, "name");
-
- 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("= (%s)0",
- SwigType_str(SwigType_strip_qualifiers(return_type),0));
- Wrapper_add_localv(f, "lresult",
- SwigType_lstr(SwigType_ltype(return_type), "lresult"),
- lresult_init, NIL);
- Delete(lresult_init);
- }
- // 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);
- Swig_typemap_attach_parms("lin", parms, f);
- emit_attach_parmmaps(parms, f);
-
- String *mangled = mangle_name(n);
- Node *overloaded = Getattr(n, "sym:overloaded");
-
- // Parameter overloading
- Setattr(n, "wrap:parms", parms);
- Setattr(n, "wrap:name", mangled);
-
- if (overloaded) {
- // emit warnings when overloading is impossible on the lisp side.
- // basically Swig_overload_check(n), but with script_lang_wrapping
- // set to true.
- Delete(Swig_overload_rank(n, true));
- if (Getattr(n, "overload:ignore")) {
- // if we're the last overload, make sure to force the emit
- // of the rest of the overloads before we leave.
- // Printf(stderr, "ignored overload %s(%p)\n", name, Getattr(n, "sym:nextSibling"));
- if (!Getattr(n, "sym:nextSibling")) {
- update_package_if_needed(n);
- emit_buffered_defuns(n);
- emit_dispatch_defun(n);
- }
- DelWrapper(f);
- return SWIG_OK;
- }
- }
- // Get number of required and total arguments
- int num_arguments = emit_num_arguments(parms);
- int gencomma = 0;
-
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "Walking parameters for %s '%s'\n", Getattr(n, "allegrocl:kind"), name);
-#endif
- // Now walk the function parameter list and generate code to get arguments
- String *name_and_parms = NewStringf("%s (", mangled);
- int i;
- Parm *p;
- for (i = 0, p = parms; i < num_arguments; i++) {
-
-#ifdef ALLEGROCL_DEBUG
- String *temp1 = Getattr(p,"tmap:in");
- String *temp2 = Getattr(p,"tmap:in:numinputs");
- Printf(stderr," parm %d: %s, tmap:in='%s', tmap:in:numinputs='%s'\n", i, Getattr(p,"name"), temp1 ? temp1 : "", temp2 ? temp2 : "");
-#endif
-
- while (p && checkAttribute(p, "tmap:in:numinputs", "0")) {
- p = Getattr(p, "tmap:in:next");
- }
-
- if (!p)
- break;
-
- 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 ALLEGROCL_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");
- //if (!parm_code) {
- // Swig_warning(...);
- // p = nextSibling(p);
- /*} else */ {
- // canThrow(n, "in", p);
- 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, ")");
-
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, " arity = %d(%d)\n", emit_num_lin_arguments(parms), emit_num_lin_arguments(Getattr(n,"wrap:parms")));
-#endif
-
- // Emit the function definition
- String *signature = SwigType_str(return_type, name_and_parms);
- Printf(f->def, "EXPORT %s {", signature);
- if (CPlusPlus)
- Printf(f->code, " try {\n");
-
- String *actioncode = emit_action(n);
-
- String *tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode);
- if (!is_void_return) {
- if (tm) {
- Replaceall(tm, "$result", "lresult");
- Printf(f->code, "%s\n", tm);
- Printf(f->code, " return lresult;\n");
- Delete(tm);
- } else {
- Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number,
- "Unable to use return type %s in function %s.\n",
- SwigType_str(t, 0), name);
- }
- }
-
- /* See if there is any return cleanup code */
- if ((tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0))) {
- Printf(f->code, "%s\n", tm);
- Delete(tm);
- }
-
- emit_return_variable(n, t, f);
-
- if (CPlusPlus) {
- Printf(f->code, " } catch (...) {\n");
- if (!is_void_return)
- Printf(f->code, " return (%s)0;\n",
- SwigType_str(SwigType_strip_qualifiers(return_type),0));
- Printf(f->code, " }\n");
- }
- Printf(f->code, "}\n");
-
- /* print this when in C mode? make this a command-line arg? */
- if (Generate_Wrapper)
- Wrapper_print(f, f_cxx_wrapper);
-
- String *f_buffer = NewString("");
-
- emit_defun(n, f_buffer);
- Setattr(n, "allegrocl:lisp-wrap", f_buffer);
-
- 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);
- }
- }
-
- DelWrapper(f);
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::namespaceDeclaration(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "namespaceDecl: '%s'(%p) (fc=%p)\n", Getattr(n, "sym:name"), n, firstChild(n));
-#endif
-
- /* don't wrap a namespace with no contents. package bloat.
- also, test-suite/namespace_class.i claims an unnamed namespace
- is 'private' and should not be wrapped. Complying...
- */
- if (Getattr(n,"unnamed") || !firstChild(n))
- return SWIG_OK;
-
- String *name = Getattr(n, "sym:name");
-
- String *old_namespace = current_namespace;
- if (Cmp(current_namespace, "") == 0)
- current_namespace = NewStringf("%s", name);
- else
- current_namespace = NewStringf("%s::%s", current_namespace, name);
-
- if (!GetInt(defined_namespace_packages, current_namespace)) {
- SetInt(defined_namespace_packages, current_namespace, 1);
- String *lispy_namespace = listify_namespace(current_namespace);
- Printf(f_clhead, "(swig-defpackage %s)\n", lispy_namespace);
- Delete(lispy_namespace);
- }
-
- emit_children(n);
-
- Delete(current_namespace);
- current_namespace = old_namespace;
- return SWIG_OK;
-}
-
-int ALLEGROCL::constructorHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "constructorHandler %s\n", Getattr(n, "name"));
-#endif
- // Swig_print_node(n);
- Setattr(n, "allegrocl:kind", "constructor");
- Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
-
- // Let SWIG generate a global forwarding function.
- return Language::constructorHandler(n);
-}
-
-int ALLEGROCL::destructorHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "destructorHandler %s\n", Getattr(n, "name"));
-#endif
-
- Setattr(n, "allegrocl:kind", "destructor");
- Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
-
- // Let SWIG generate a global forwarding function.
- return Language::destructorHandler(n);
-}
-
-int ALLEGROCL::constantWrapper(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "constantWrapper %s\n", Getattr(n, "name"));
-#endif
-
- if (Generate_Wrapper) {
- // Setattr(n,"wrap:name",mangle_name(n, "ACLPP"));
- String *const_type = Getattr(n, "type");
-
- String *const_val = 0;
- String *raw_const = Getattr(n, "value");
-
- if (SwigType_type(const_type) == T_STRING) {
- const_val = NewStringf("\"%s\"", raw_const);
- } else if (SwigType_type(const_type) == T_CHAR) {
- const_val = NewStringf("'%s'", raw_const);
- } else {
- const_val = Copy(raw_const);
- }
-
- SwigType_add_qualifier(const_type, "const");
-
- String *ppcname = NewStringf("ACLppc_%s", Getattr(n, "sym:name"));
- // Printf(f_runtime, "static const %s = %s;\n", SwigType_lstr(const_type, ppcname), const_val);
- Printf(f_runtime, "static %s = %s;\n", SwigType_lstr(const_type, ppcname), const_val);
-
- Setattr(n, "name", ppcname);
- SetFlag(n, "feature:immutable");
-
- Delete(const_val);
- return variableWrapper(n);
- }
-
- String *type = Getattr(n, "type");
- String *value = Getattr(n, "value");
- String *converted_value = convert_literal(value, type);
- String *name = Getattr(n, "sym:name");
-
- Setattr(n, "allegrocl:kind", "constant");
- Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
-
-#if 0
- Printf(stdout, "constant %s is of type %s. value: %s\n", name, type, converted_value);
-#endif
-
- if (converted_value) {
- Printf(f_clwrap, "(swig-defconstant \"%s\" %s)\n", name, converted_value);
- } else {
- Swig_warning(WARN_LANG_DISCARD_CONST, Getfile(n), Getline(n), "Unable to parse constant value '%s'. Setting to NIL\n", value);
- Printf(f_clwrap, "(swig-defconstant \"%s\" nil #| %s |#)\n", name, value);
- }
-
- Delete(converted_value);
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::globalvariableHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "globalvariableHandler %s\n", Getattr(n, "name"));
-#endif
-
- if (Generate_Wrapper)
- return Language::globalvariableHandler(n);
-
- // String *name = Getattr(n, "name");
- SwigType *type = Getattr(n, "type");
- SwigType *rtype = SwigType_typedef_resolve_all(type);
-
- if (SwigType_isclass(rtype)) {
- SwigType_add_pointer(type);
- SwigType_add_pointer(rtype);
- }
-
- Printf(f_clwrap, "(swig-defvar \"%s\" \"%s\" :type %s)\n",
- Getattr(n, "sym:name"), Getattr(n, "sym:name"), ((SwigType_isconst(type)) ? ":constant" : ":variable"));
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::variableWrapper(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "variableWrapper %s\n", Getattr(n, "name"));
-#endif
- Setattr(n, "allegrocl:kind", "variable");
- Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
-
- // Let SWIG generate a get/set function pair.
- if (Generate_Wrapper)
- return Language::variableWrapper(n);
-
- String *name = Getattr(n, "name");
- SwigType *type = Getattr(n, "type");
- SwigType *ctype;
- SwigType *rtype = SwigType_typedef_resolve_all(type);
-
- String *mangled_name = mangle_name(n);
-
- int pointer_added = 0;
-
- if (SwigType_isclass(rtype)) {
- SwigType_add_pointer(type);
- SwigType_add_pointer(rtype);
- pointer_added = 1;
- }
-
- ctype = SwigType_str(type, 0);
-
- // EXPORT ;
- // = ;
- Printf(f_runtime, "EXPORT %s %s;\n%s %s = %s%s;\n", ctype, mangled_name, ctype, mangled_name, (pointer_added ? "&" : ""), name);
-
- Printf(f_cl, "(swig-defvar \"%s\" :type %s)\n", mangled_name, ((SwigType_isconst(type)) ? ":constant" : ":variable"));
-
- Printf(stderr,"***\n");
- Delete(mangled_name);
-
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "DONE variable %s\n", Getattr(n, "name"));
-#endif
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::memberfunctionHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "memberfunctionHandler %s::%s\n", Getattr(parent_node_skipping_extends(n), "name"), Getattr(n, "name"));
- Swig_print_node(n);
-#endif
- Setattr(n, "allegrocl:kind", "member function");
- Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
-
- // Let SWIG generate a global forwarding function.
- return Language::memberfunctionHandler(n);
-}
-
-int ALLEGROCL::membervariableHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "membervariableHandler %s::%s\n", Getattr(parent_node_skipping_extends(n), "name"), Getattr(n, "name"));
-#endif
- Setattr(n, "allegrocl:kind", "member variable");
- Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
-
- // Let SWIG generate a get/set function pair.
- return Language::membervariableHandler(n);
-}
-
-int ALLEGROCL::typedefHandler(Node *n) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "In typedefHandler\n");
-#endif
-
- SwigType *typedef_type = Getattr(n,"type");
- // has the side-effect of noting any implicit
- // template instantiations in type.
- String *ff_type = compose_foreign_type(n, typedef_type);
-
- String *sym_name = Getattr(n, "sym:name");
-
- String *name;
- String *type_ref;
-
- if (in_class) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, " typedef in class '%s'(%p)\n", Getattr(in_class, "sym:name"), in_class);
-#endif
- Setattr(n, "allegrocl:typedef:in-class", in_class);
-
- String *class_name = Getattr(in_class, "name");
- name = NewStringf("%s__%s", class_name, sym_name);
- type_ref = NewStringf("%s::%s", class_name, sym_name);
- Setattr(n, "allegrocl:in-class", in_class);
- } else {
- name = Copy(sym_name);
- type_ref = Copy(Getattr(n, "name"));
- }
-
- Setattr(n, "allegrocl:namespace", current_namespace);
-
- String *lookup = lookup_defined_foreign_type(typedef_type);
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "** lookup='%s'(%p), typedef_type='%s', strcmp = '%d' strstr = '%d'\n", lookup, lookup, typedef_type, Strcmp(typedef_type,"void"), Strstr(ff_type,"__SWIGACL_FwdReference"));
-#endif
-
- if(lookup || (!lookup && Strcmp(typedef_type,"void")) ||
- (!lookup && Strstr(ff_type,"__SWIGACL_FwdReference"))) {
- add_defined_foreign_type(n, 0, type_ref, name);
- } else {
- add_forward_referenced_type(n);
- }
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "Out typedefHandler\n");
-#endif
-
- Delete(ff_type);
-
- return SWIG_OK;
-}
-
-// forward referenced classes are added specially to defined_foreign_types
-int ALLEGROCL::classforwardDeclaration(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "classforwardDeclaration %s\n", Getattr(n, "name"));
-#endif
-
- add_forward_referenced_type(n);
- return SWIG_OK;
-}
-
-int ALLEGROCL::classHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "classHandler %s::%s\n", current_namespace, Getattr(n, "sym:name"));
-#endif
-
- int result;
-
- if (Generate_Wrapper)
- result = cppClassHandler(n);
- else
- result = cClassHandler(n);
-
- return result;
-}
-
-int ALLEGROCL::cClassHandler(Node *n) {
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "In cClassHandler\n");
-#endif
- /* Add this structure to the known lisp types */
- // Printf(stderr, "Adding %s foreign type\n", name);
- String *ns = listify_namespace(current_namespace);
-
- add_defined_foreign_type(n);
-
- Delete(ns);
-
-#ifdef ALLEGROCL_TYPE_DEBUG
- Printf(stderr, "Out cClassHandler\n");
-#endif
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::cppClassHandler(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "cppClassHandler %s\n", Getattr(n, "name"));
-#endif
-
- // String *name=Getattr(n, "sym:name");
- // String *kind = Getattr(n,"kind");
-
- /* Template instantiation.
- Careful.
- SWIG does not create instantiations of templated classes whenever
- it sees a templated class reference (say, as a return type, or
- in a parameter list).
-
- The %template directive results in a templated class instantiation
- that will actually be seen by :: classHandler().
-
- In this case, we don't want to error if the type already exists;
- the point is to force the creation of wrappers for the templated
- class.
- */
- String *templated = Getattr(n, "template");
- String *t_name;
- // String *ns = listify_namespace(current_namespace);
-
- if (templated) {
- t_name = namespaced_name(n);
- } else {
- t_name = Getattr(n, "name");
- }
-
- Setattr(n, "allegrocl:namespace", current_namespace);
-
- /* Add this structure to the known lisp types.
- Class may contain references to the type currently being
- defined */
- if (!templated || !lookup_defined_foreign_type(t_name)) {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "Adding %s foreign type\n", Getattr(n, "sym:name"));
-#endif
- add_defined_foreign_type(n);
- } else {
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "cppClassHand: type %s already exists. Assuming %%template instantiation for wrapping purposes.\n", Getattr(n, "sym:name"));
-#endif
- add_defined_foreign_type(n, 1);
- }
-
- // Generate slot accessors, constructor, and destructor.
- Node *prev_class = in_class;
- in_class = n;
-
- Node *c;
- // walk all member variables.
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, " MANUALLY walking class members... \n");
-#endif
- for (c = firstChild(n); c; c = nextSibling(c)) {
- // ping the types of all children--even protected and private
- // so their types can be added to the linked_type_list.
- SwigType *childType = NewStringf("%s%s", Getattr(c, "decl"),
- Getattr(c, "type"));
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, "looking at child '%p' of type '%s' '%d'\n", c, childType, SwigType_isfunction(childType));
- // Swig_print_node(c);
-#endif
- if (!SwigType_isfunction(childType))
- Delete(compose_foreign_type(n, childType));
-
- Delete(childType);
- }
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, " MANUAL walk DONE.\n");
-#endif
-
- // this will walk all necessary methods.
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, " LANGUAGE walk of children...\n");
-#endif
- Language::classHandler(n);
-#ifdef ALLEGROCL_CLASS_DEBUG
- Printf(stderr, " LANGUAGE walk DONE\n");
-#endif
- in_class = prev_class;
-
- return SWIG_OK;
-}
-
-int ALLEGROCL::emit_one(Node *n) {
- // When the current package does not correspond with the current
- // namespace we need to generate an IN-PACKAGE form, unless the
- // current node is another namespace node.
- if (Cmp(nodeType(n), "namespace") != 0 && Cmp(current_package, current_namespace) != 0) {
- String *lispy_namespace = listify_namespace(current_namespace);
- Printf(f_clwrap, "(swig-in-package %s)\n", lispy_namespace);
- Delete(lispy_namespace);
- Delete(current_package);
- current_package = NewStringf("%s", current_namespace);
- }
-
- Setattr(n, "allegrocl:package", current_package);
-
- return Language::emit_one(n);
-}
-
-int ALLEGROCL::enumDeclaration(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "enumDeclaration %s\n", Getattr(n, "name"));
-#endif
-
- if (getCurrentClass() && (cplus_mode != PUBLIC))
- return SWIG_NOWRAP;
-
- if (Getattr(n, "sym:name")) {
- add_defined_foreign_type(n);
- }
- Node *c;
- for (c = firstChild(n); c; c = nextSibling(c)) {
- ALLEGROCL::enumvalueDeclaration(c);
- // since we walk our own children, we need to add
- // the current package ourselves.
- Setattr(c, "allegrocl:package", current_package);
- }
- return SWIG_OK;
-}
-
-
-int ALLEGROCL::enumvalueDeclaration(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "enumvalueDeclaration %s\n", Getattr(n, "name"));
-#endif
- /* print this when in C mode? make this a command-line arg? */
- if (Generate_Wrapper) {
- SwigType *enum_type = Copy(Getattr(n,"type"));
- String *mangled_name =
- mangle_name(n, "ACL_ENUM",
- in_class ? Getattr(in_class,"name") :
- current_namespace);
-
- SwigType_add_qualifier(enum_type,"const");
-
- String *enum_decl = SwigType_str(enum_type, mangled_name);
- Printf(f_cxx_wrapper, "EXPORT %s;\n", enum_decl);
- Printf(f_cxx_wrapper, "%s = %s;\n", enum_decl, Getattr(n, "value"));
-
- Delete(mangled_name);
- Delete(enum_type);
- Delete(enum_decl);
- }
- return SWIG_OK;
-}
-
-int ALLEGROCL::templateDeclaration(Node *n) {
-#ifdef ALLEGROCL_DEBUG
- Printf(stderr, "templateDeclaration %s\n", Getattr(n, "name"));
-#endif
-
- String *type = Getattr(n, "templatetype");
-
- // Printf(stderr, "tempDecl: %s %s\n", Getattr(n,"name"),
- // type);
- // Swig_print_node(n);
-
- if (!Strcmp(type, "cdecl")) {
- SwigType *ty = NewStringf("%s%s", Getattr(n, "decl"),
- Getattr(n, "type"));
- Delete(ty);
- }
-
- Delete(type);
-
- return SWIG_OK;
-}
-