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

Rework the CLOS code for chicken... still needs a little more work

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@6400 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
John Lenz 2004-10-16 20:56:10 +00:00
commit 4fc9128a6c
6 changed files with 373 additions and 955 deletions
Download patch file Download diff file Expand all files Collapse all files

9
SWIG/Lib/chicken/chicken.swg
View file

@ -582,16 +582,18 @@ $result = C_SCHEME_UNDEFINED;
extern "C" {
#endif
/* Chicken initialization function */
SWIGEXPORT(void) $realmodule_swig_init(int, C_word, C_word) C_noret;
SWIGEXPORT(void) SWIG_init(int, C_word, C_word) C_noret;
#ifdef __cplusplus
}
#endif
%}
%insert(closprefix) "swigclosprefix.scm"
%insert(init) %{
/* CHICKEN initialization function */
SWIGEXPORT(void)
$realmodule_swig_init(int argc, C_word closure, C_word continuation) {
SWIG_init(int argc, C_word closure, C_word continuation) {
static int typeinit = 0;
int i;
C_word sym;
@ -616,6 +618,9 @@ $realmodule_swig_init(int argc, C_word closure, C_word continuation) {
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]);
}
typeinit = 1;
ret = C_SCHEME_TRUE;
} else {

4
SWIG/Lib/chicken/chickenrun.swg
View file

@ -59,6 +59,10 @@ enum {
SWIG_BARF1_BAD_ARGUMENT_TYPE /* 1 arg */,
SWIG_BARF1_ARGUMENT_NULL /* 1 arg */
};
struct swig_chicken_clientdata {
C_word clos_class;
};
static char *
SWIG_Chicken_MakeString(C_word str) {

33
SWIG/Lib/chicken/swigclosprefix.scm Normal file
View file

@ -0,0 +1,33 @@
;(declare (hide swig-initialize))
;(define (swig-initialize obj initargs create destroy)
; (if (memq 'swig-init initargs)
; (slot-set! obj 'swig-this (cadr initargs))
; (begin
; (slot-set! obj 'swig-this (apply create initargs))
;(let ((ret (apply create initargs)))
; (if (instance? ret)
; (slot-ref ret 'swig-this)
; ret)))
; (set-finalizer! obj destroy))))
(define-class <swig-metaclass-$module> (<class>) (void))
(define-method (compute-getter-and-setter (class <swig-metaclass-$module>) slot allocator)
(if (not (memq ':swig-virtual slot))
(call-next-method)
(let ((getter (let search-get ((lst slot))
(if (null? lst)
#f
(if (eq? (car lst) ':swig-get)
(cadr lst)
(search-get (cdr lst))))))
(setter (let search-set ((lst slot))
(if (null? lst)
#f
(if (eq? (car lst) ':swig-set)
(cadr lst)
(search-set (cdr lst)))))))
(values
(lambda (o) (getter (slot-ref o 'swig-this)))
(lambda (o new) (setter (slot-ref o 'swig-this) new) new)))))