Merge new set of GOOPS changes by John Lenz.
GOOPS objects are now manipulated directly by the C code. Some fixes to typemap-GOOPS interaction. git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@5254 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Matthias Köppe
parent
f331b98ae2
commit
3e64557893
3 changed files with 98 additions and 41 deletions
|
|
@ -16,41 +16,27 @@
|
|||
(define-class <swig-metaclass> (<class>)
|
||||
(new-function #:init-value #f))
|
||||
|
||||
(define-method (compute-get-n-set (class <swig-metaclass>) s)
|
||||
(case (slot-definition-allocation s)
|
||||
((#:swig-virtual)
|
||||
(list
|
||||
;getter
|
||||
(let ((func (get-keyword #:slot-ref (slot-definition-options s) #f)))
|
||||
(lambda (x) (func (slot-ref x 'smob))))
|
||||
;setter
|
||||
(let ((func (get-keyword #:slot-set! (slot-definition-options s) #f)))
|
||||
(lambda (x val) (func (slot-ref x 'smob) val)))))
|
||||
((#:swig-virtual-class)
|
||||
(list
|
||||
;getter
|
||||
(let ((func (get-keyword #:slot-ref (slot-definition-options s) #f))
|
||||
(class (get-keyword #:class (slot-definition-options s) #f)))
|
||||
(lambda (x) (make class #:init-smob (func (slot-ref x 'smob)))))
|
||||
;setter
|
||||
(let ((func (get-keyword #:slot-set! (slot-definition-options s) #f)))
|
||||
(lambda (x val) (func (slot-ref x 'smob) (slot-ref val 'smob))))))
|
||||
(else (next-method))))
|
||||
|
||||
(define-method (initialize (class <swig-metaclass>) initargs)
|
||||
(slot-set! class 'new-function (get-keyword #:new-function initargs #f))
|
||||
(next-method))
|
||||
|
||||
(define-class <swig> ()
|
||||
(smob #:init-value #f)
|
||||
#:metaclass <swig-metaclass>)
|
||||
(define-class <swig> ()
|
||||
(swig-smob #:init-value #f)
|
||||
#:metaclass <swig-metaclass>
|
||||
)
|
||||
|
||||
(define-method (initialize (obj <swig>) initargs)
|
||||
(next-method)
|
||||
(let ((arg (get-keyword #:init-smob initargs #f)))
|
||||
(if arg
|
||||
(slot-set! obj 'smob arg)
|
||||
(slot-set! obj 'smob (apply (slot-ref (class-of obj) 'new-function)
|
||||
(get-keyword #:args initargs '()))))))
|
||||
|
||||
(slot-set! obj 'swig-smob
|
||||
(let ((arg (get-keyword #:init-smob initargs #f)))
|
||||
(if arg
|
||||
arg
|
||||
(let ((ret (apply (slot-ref (class-of obj) 'new-function) (get-keyword #:args initargs '()))))
|
||||
;; if the class is registered with runtime environment,
|
||||
;; new-Function will return a <swig> goops class. In that case, extract the smob
|
||||
;; from that goops class and set it as the current smob.
|
||||
(if (slot-exists? ret 'swig-smob)
|
||||
(slot-ref ret 'swig-smob)
|
||||
ret))))))
|
||||
|
||||
(export <swig-metaclass> <swig>)
|
||||
|
|
|
|||
|
|
@ -43,6 +43,9 @@
|
|||
for (i = 0; swig_types_initial[i]; i++) {
|
||||
swig_types[i] = SWIG_TypeRegister(swig_types_initial[i]);
|
||||
}
|
||||
for (i = 0; swig_types_initial[i]; i++) {
|
||||
SWIG_PropagateClientData(swig_types[i]);
|
||||
}
|
||||
_swig_init = 1;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
* -----------------------------------------------------------------------
|
||||
* swig_lib/guile/guile_scm_run.swg
|
||||
*
|
||||
* Author: John Lenz <jelenz@students.wisc.edu>
|
||||
* Author: John Lenz <jelenz@wisc.edu>
|
||||
* ----------------------------------------------------------------------- */
|
||||
|
||||
#include <libguile.h>
|
||||
|
|
@ -17,6 +17,11 @@ extern "C" {
|
|||
typedef SCM (*swig_guile_proc)();
|
||||
typedef SCM (*guile_destructor)(SCM);
|
||||
|
||||
typedef struct swig_guile_clientdata {
|
||||
guile_destructor destroy;
|
||||
SCM goops_class;
|
||||
} swig_guile_clientdata;
|
||||
|
||||
#define SWIG_scm2str(s) SWIG_scm2newstr(s, NULL)
|
||||
|
||||
#define SWIG_malloc(size) \
|
||||
|
|
@ -29,6 +34,8 @@ typedef SCM (*guile_destructor)(SCM);
|
|||
SWIG_Guile_MustGetPtr(s, type, argnum, flags, FUNC_NAME)
|
||||
#define SWIG_NewPointerObj(ptr, type, owner) \
|
||||
SWIG_Guile_NewPointerObj((void*)ptr, type, owner)
|
||||
#define SWIG_PropagateClientData(type) \
|
||||
SWIG_Guile_PropagateClientData(type)
|
||||
|
||||
#ifdef SWIG_NOINCLUDE
|
||||
|
||||
|
|
@ -47,6 +54,9 @@ SWIGIMPORT(void *) SWIG_Guile_MustGetPtr(SCM s, swig_type_info *type, int argnum
|
|||
SWIGIMPORT(SCM) SWIG_Guile_NewPointerObj(void *ptr, swig_type_info *type, int owner);
|
||||
/* Get arguments from an argument list */
|
||||
SWIGIMPORT(int) SWIG_Guile_GetArgs(SCM *dest, SCM rest, int reqargs, int optargs, const char *procname);
|
||||
/* Propagate client data to equivalent types */
|
||||
SWIGIMPORT(void)
|
||||
SWIG_Guile_PropagateClientData(swig_type_info *type);
|
||||
|
||||
#else
|
||||
|
||||
|
|
@ -69,14 +79,38 @@ SWIG_scm2newstr(SCM str, size_t *len) {
|
|||
|
||||
static scm_t_bits swig_tag = 0;
|
||||
static scm_t_bits swig_collected_tag = 0;
|
||||
static SCM swig_make_func = SCM_EOL;
|
||||
static SCM swig_keyword = SCM_EOL;
|
||||
static SCM swig_symbol = SCM_EOL;
|
||||
|
||||
#define SWIG_Guile_GetSmob(x) \
|
||||
( SCM_NNULLP(x) && SCM_INSTANCEP(x) && SCM_NFALSEP(scm_slot_exists_p(x, swig_symbol)) \
|
||||
? scm_slot_ref(x, swig_symbol) : (x) )
|
||||
|
||||
SWIGRUNTIME(SCM)
|
||||
SWIG_Guile_NewPointerObj(void *ptr, swig_type_info *type, int owner)
|
||||
{
|
||||
SCM smob;
|
||||
swig_guile_clientdata *cdata = (swig_guile_clientdata *) type->clientdata;
|
||||
if (owner)
|
||||
SCM_RETURN_NEWSMOB2(swig_collected_tag, ptr, (void *) type);
|
||||
SCM_NEWSMOB2(smob, swig_collected_tag, ptr, (void *) type);
|
||||
else
|
||||
SCM_RETURN_NEWSMOB2(swig_tag, ptr, (void *) type);
|
||||
SCM_NEWSMOB2(smob, swig_tag, ptr, (void *) type);
|
||||
|
||||
if (!cdata || SCM_NULLP(cdata->goops_class) || swig_make_func == SCM_EOL ) {
|
||||
return smob;
|
||||
} else {
|
||||
/* the scm_make() C function only handles the creation of gf, methods and classes (no instances)
|
||||
the (make ...) function is later redefined in goops.scm. So we need to lookup and
|
||||
call that function */
|
||||
return scm_apply(
|
||||
swig_make_func,
|
||||
scm_list_3(
|
||||
cdata->goops_class,
|
||||
swig_keyword,
|
||||
smob),
|
||||
SCM_EOL);
|
||||
}
|
||||
}
|
||||
|
||||
/* Return 0 if successful. */
|
||||
|
|
@ -85,22 +119,24 @@ SWIG_Guile_ConvertPtr(SCM s, void **result, swig_type_info *type, int flags)
|
|||
{
|
||||
swig_type_info *cast;
|
||||
swig_type_info *from;
|
||||
if (SCM_NULLP(s)) {
|
||||
SCM smob = SWIG_Guile_GetSmob(s);
|
||||
|
||||
if (SCM_NULLP(smob)) {
|
||||
*result = NULL;
|
||||
return 0;
|
||||
} else if (SCM_SMOB_PREDICATE(swig_tag, s) || SCM_SMOB_PREDICATE(swig_collected_tag, s)) {
|
||||
from = (swig_type_info *) SCM_CELL_WORD_2(s);
|
||||
} else if (SCM_SMOB_PREDICATE(swig_tag, smob) || SCM_SMOB_PREDICATE(swig_collected_tag, smob)) {
|
||||
from = (swig_type_info *) SCM_CELL_WORD_2(smob);
|
||||
if (!from) return 1;
|
||||
if (type) {
|
||||
cast = SWIG_TypeCheck((char*)from->name, type);
|
||||
if (cast) {
|
||||
*result = SWIG_TypeCast(cast, (void *) SCM_CELL_WORD_1(s));
|
||||
*result = SWIG_TypeCast(cast, (void *) SCM_CELL_WORD_1(smob));
|
||||
return 0;
|
||||
} else {
|
||||
return 1;
|
||||
}
|
||||
} else {
|
||||
*result = (void *) SCM_CELL_WORD_1(s);
|
||||
*result = (void *) SCM_CELL_WORD_1(smob);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
|
@ -124,7 +160,9 @@ SWIG_Guile_MustGetPtr (SCM s, swig_type_info *type,
|
|||
static int
|
||||
print_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
|
||||
{
|
||||
swig_type_info *type = (swig_type_info *) SCM_CELL_WORD_2(swig_smob);
|
||||
swig_type_info *type;
|
||||
|
||||
type = (swig_type_info *) SCM_CELL_WORD_2(swig_smob);
|
||||
if (type) {
|
||||
scm_puts((char *) "#<swig ", port);
|
||||
if (type->str != NULL)
|
||||
|
|
@ -144,7 +182,9 @@ print_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
|
|||
static int
|
||||
print_collected_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
|
||||
{
|
||||
swig_type_info *type = (swig_type_info *) SCM_CELL_WORD_2(swig_smob);
|
||||
swig_type_info *type;
|
||||
|
||||
type = (swig_type_info *) SCM_CELL_WORD_2(swig_smob);
|
||||
if (type) {
|
||||
scm_puts((char *) "#<collected swig ", port);
|
||||
if (type->str != NULL)
|
||||
|
|
@ -176,7 +216,7 @@ free_swig(SCM A)
|
|||
swig_type_info *type = (swig_type_info *) SCM_CELL_WORD_2(A);
|
||||
if (type) {
|
||||
if (type->clientdata)
|
||||
((guile_destructor)type->clientdata)(A);
|
||||
((swig_guile_clientdata *)type->clientdata)->destroy(A);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -196,6 +236,11 @@ SWIG_Guile_Init ()
|
|||
scm_set_smob_equalp(swig_collected_tag, equalp_swig);
|
||||
scm_set_smob_free(swig_collected_tag, free_swig);
|
||||
}
|
||||
|
||||
swig_make_func = scm_permanent_object(
|
||||
scm_variable_ref(scm_c_module_lookup(scm_c_resolve_module("oop goops"), "make")));
|
||||
swig_keyword = scm_permanent_object(scm_c_make_keyword("init-smob"));
|
||||
swig_symbol = scm_permanent_object(scm_str2symbol("swig-smob"));
|
||||
}
|
||||
|
||||
SWIGRUNTIME(int)
|
||||
|
|
@ -224,6 +269,29 @@ SWIG_Guile_GetArgs (SCM *dest, SCM rest,
|
|||
return num_args_passed;
|
||||
}
|
||||
|
||||
/* This function will propagate the clientdata field of type to
|
||||
* any new swig_type_info structures that have been added into the list
|
||||
* of equivalent types. It is like calling
|
||||
* SWIG_TypeClientData(type, clientdata) a second time.
|
||||
*/
|
||||
SWIGRUNTIME(void)
|
||||
SWIG_Guile_PropagateClientData(swig_type_info *type) {
|
||||
swig_type_info *equiv = type->next;
|
||||
swig_type_info *tc;
|
||||
if (!type->clientdata) return;
|
||||
while (equiv) {
|
||||
if (!equiv->converter) {
|
||||
tc = swig_type_list;
|
||||
while (tc) {
|
||||
if ((strcmp(tc->name, equiv->name) == 0) && !tc->clientdata)
|
||||
SWIG_TypeClientData(tc, type->clientdata);
|
||||
tc = tc->prev;
|
||||
}
|
||||
}
|
||||
equiv = equiv->next;
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue