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

More work on the chicken module. The test suite, zlib, and overload examples are still broken.

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@6610 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
John Lenz 2004-11-02 02:50:30 +00:00
commit 2cdf91de5d
17 changed files with 305 additions and 181 deletions
Download patch file Download diff file Expand all files Collapse all files

17
SWIG/Examples/chicken/class/Makefile
View file

@ -5,16 +5,16 @@ SRCS =
CXXSRCS = example.cxx
TARGET = class
INCLUDE =
SWIGOPT =
SWIGOPT =
CFLAGS =
VARIANT =
VARIANT = _csc
# uncomment the following lines to build a static exe (only pick one of the CHICKEN_MAIN lines)
#CHICKEN_MAIN = test-lowlevel-class.scm
#CHICKEN_MAIN = test-tinyclos-class.scm
#VARIANT = _static
all:: $(TARGET)
all:: $(TARGET) $(TARGET)_proxy
$(TARGET): $(INTERFACE) $(SRCS)
$(MAKE) -f $(TOP)/Makefile \
@ -22,10 +22,17 @@ $(TARGET): $(INTERFACE) $(SRCS)
INCLUDE='$(INCLUDE)' SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' \
SWIG='$(SWIG)' INTERFACE='$(INTERFACE)' CHICKENOPTS='$(CHICKENOPTS)' chicken$(VARIANT)_cpp
$(TARGET)_proxy: $(INTERFACE) $(SRCS)
$(MAKE) -f $(TOP)/Makefile \
SRCS='$(SRCS)' CXXSRCS='$(CXXSRCS)' CHICKEN_MAIN='$(CHICKEN_MAIN)' \
INCLUDE='$(INCLUDE)' SWIGOPT='$(SWIGOPT) -proxy' TARGET='$(TARGET)_proxy' \
SWIG='$(SWIG)' INTERFACE='$(INTERFACE)' CHICKENOPTS='$(CHICKENOPTS)' chicken$(VARIANT)_cpp
clean::
$(MAKE) -f $(TOP)/Makefile chicken_clean
rm -f example.scm example-generic.scm example-clos.scm
rm -f example.scm
rm -f $(TARGET)
check::
csi -batch $(TARGET).so test-lowlevel-class.scm test-tinyclos-class.scm
env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH csi test-lowlevel-class.scm
env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH csi test-tinyclos-class.scm

6
SWIG/Examples/chicken/class/example.i
View file

@ -5,12 +5,6 @@
#include "example.h"
%}
/* Let "Shape" objects be converted back and forth from TinyCLOS into
low-level CHICKEN SWIG procedures */
%typemap(clos_in) Shape * = SIMPLE_CLOS_OBJECT *;
%typemap(clos_out) Shape * = SIMPLE_CLOS_OBJECT *;
/* Let's just grab the original header file here */
%include "example.h"

35
SWIG/Examples/chicken/class/test-lowlevel-class.scm
View file

@ -1,16 +1,17 @@
;; This file illustrates the low-level C++ interface generated
;; by SWIG.
(load-library 'example "class.so")
(declare (uses example))
;; ----- Object creation -----
(display "Creating some objects:\n")
(define c (example:new-Circle 10.0))
(define c (new-Circle 10.0))
(display " Created circle ")
(display c)
(display "\n")
(define s (example:new-Square 10.0))
(define s (new-Square 10.0))
(display " Created square ")
(display s)
(display "\n")
@ -18,29 +19,29 @@
;; ----- Access a static member -----
(display "\nA total of ")
(display (example:Shape-nshapes))
(display (Shape-nshapes))
(display " shapes were created\n")
;; ----- Member data access -----
;; Set the location of the object
(example:Shape-x-set c 20.0)
(example:Shape-y-set c 30.0)
(Shape-x-set c 20.0)
(Shape-y-set c 30.0)
(example:Shape-x-set s -10.0)
(example:Shape-y-set s 5.0)
(Shape-x-set s -10.0)
(Shape-y-set s 5.0)
(display "\nHere is their current position:\n")
(display " Circle = (")
(display (example:Shape-x-get c))
(display (Shape-x-get c))
(display ", ")
(display (example:Shape-y-get c))
(display (Shape-y-get c))
(display ")\n")
(display " Square = (")
(display (example:Shape-x-get s))
(display (Shape-x-get s))
(display ", ")
(display (example:Shape-y-get s))
(display (Shape-y-get s))
(display ")\n")
;; ----- Call some methods -----
@ -52,10 +53,10 @@
(display o)
(display "\n")
(display " area = ")
(display (example:Shape-area o))
(display (Shape-area o))
(display "\n")
(display " perimeter = ")
(display (example:Shape-perimeter o))
(display (Shape-perimeter o))
(display "\n"))))
(disp c)
(disp s))
@ -63,10 +64,12 @@
(display "\nGuess I'll clean up now\n")
;; Note: this invokes the virtual destructor
(example:delete-Shape c)
(example:delete-Shape s)
(delete-Shape c)
(delete-Shape s)
(set! s 3)
(display (example:Shape-nshapes))
(display (Shape-nshapes))
(display " shapes remain\n")
(display "Goodbye\n")
(exit)

39
SWIG/Examples/chicken/class/test-tinyclos-class.scm
View file

@ -1,23 +1,18 @@
;; This file illustrates the shadow C++ interface generated
;; by SWIG.
(load-library 'example "class_proxy.so")
(declare (uses example))
(declare (uses tinyclos))
;; All generic methods must be included first
(include "example-generic")
;; After generic are defined, can include TinyCLOS code
(include "example-clos")
;; ----- Object creation -----
(display "Creating some objects:\n")
(define c (make <example:Circle> 10.0))
(define c (make <Circle> 10.0))
(display " Created circle ")
(display c)
(display "\n")
(define s (make <example:Square> 10.0))
(define s (make <Square> 10.0))
(display " Created square ")
(display s)
(display "\n")
@ -25,29 +20,29 @@
;; ----- Access a static member -----
(display "\nA total of ")
(display (+example:Shape-nshapes+))
(display (nshapes))
(display " shapes were created\n")
;; ----- Member data access -----
;; Set the location of the object
(-set-x!- c 20.0)
(-set-y!- c 30.0)
(slot-set! c 'x 20.0)
(slot-set! c 'y 30.0)
(-set-x!- s -10.0)
(-set-y!- s 5.0)
(slot-set! s 'x -10.0)
(slot-set! s 'y 5.0)
(display "\nHere is their current position:\n")
(display " Circle = (")
(display (-get-x- c))
(display (slot-ref c 'x))
(display ", ")
(display (-get-y- c))
(display (slot-ref c 'y))
(display ")\n")
(display " Square = (")
(display (-get-x- s))
(display (slot-ref s 'x))
(display ", ")
(display (-get-y- s))
(display (slot-ref s 'y))
(display ")\n")
;; ----- Call some methods -----
@ -59,10 +54,10 @@
(display o)
(display "\n")
(display " area = ")
(display (-area- o))
(display (area o))
(display "\n")
(display " perimeter = ")
(display (-perimeter- o))
(display (perimeter o))
(display "\n"))))
(disp c)
(disp s))
@ -72,8 +67,10 @@
;; Note: Invoke the virtual destructors by forcing garbage collection
(set! c 77)
(set! s 88)
(gc #t)
;(gc #t)
(display (+example:Shape-nshapes+))
(display (nshapes))
(display " shapes remain\n")
(display "Goodbye\n")
(exit)

4
SWIG/Examples/chicken/constants/Makefile
View file

@ -23,8 +23,8 @@ $(TARGET): $(INTERFACE) $(SRCS)
clean::
$(MAKE) -f $(TOP)/Makefile chicken_clean
rm -f example.scm example-generic.scm example-clos.scm
rm -f example.scm
rm -f $(TARGET)
check::
csi -batch $(TARGET).so test-constants.scm
csi test-constants.scm

19
SWIG/Examples/chicken/constants/test-constants.scm
View file

@ -1,17 +1,18 @@
;; run with './constants test-constants.scm'
;; feel free to uncomment and comment sections
(load-library 'example "constants.so")
(declare (uses example))
(display "starting test ... you will see 'finished' if successful.\n")
(or (= (example:ICONST) 42) (exit 1))
(or (< (abs (- (example:FCONST) 2.1828)) 0.00001) (exit 1))
(or (char=? (example:CCONST) #\x) (exit 1))
(or (char=? (example:CCONST2) #\newline) (exit 1))
(or (string=? (example:SCONST) "Hello World") (exit 1))
(or (string=? (example:SCONST2) "\"Hello World\"") (exit 1))
(or (< (abs (- (example:EXPR) (+ (example:ICONST) (* 3 (example:FCONST))))) 0.00001) (exit 1))
(or (= (example:iconstX) 37) (exit 1))
(or (< (abs (- (example:fconstX) 3.14)) 0.00001) (exit 1))
(or (= (ICONST) 42) (exit 1))
(or (< (abs (- (FCONST) 2.1828)) 0.00001) (exit 1))
(or (char=? (CCONST) #\x) (exit 1))
(or (char=? (CCONST2) #\newline) (exit 1))
(or (string=? (SCONST) "Hello World") (exit 1))
(or (string=? (SCONST2) "\"Hello World\"") (exit 1))
(or (< (abs (- (EXPR) (+ (ICONST) (* 3 (FCONST))))) 0.00001) (exit 1))
(or (= (iconstX) 37) (exit 1))
(or (< (abs (- (fconstX) 3.14)) 0.00001) (exit 1))
(display "finished test.\n")
(exit 0)

4
SWIG/Examples/chicken/multimap/Makefile
View file

@ -23,8 +23,8 @@ $(TARGET): $(INTERFACE) $(SRCS)
clean::
$(MAKE) -f $(TOP)/Makefile chicken_clean
rm -f example.scm example-generic.scm example-clos.scm
rm -f example.scm
rm -f $(TARGET)
check::
csi -batch $(TARGET).so test-multimap.scm
env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH csi test-multimap.scm

55
SWIG/Examples/chicken/multimap/test-multimap.scm
View file

@ -1,56 +1,59 @@
;; run with './multimap test-multimap.scm'
;; feel free to uncomment and comment sections
(load-library 'example "multimap.so")
(declare (uses example))
(display "(example:gcd 90 12): ")
(display (example:gcd 90 12))
(display "(gcd 90 12): ")
(display (gcd 90 12))
(display "\n")
(display "(example:gcd 90 'a): ")
;;(display (example:gcd 90 'a))
(display "(gcd 90 'a): ")
;;(display (gcd 90 'a))
(display "\n")
(display "(example:gcd 'b 12): ")
;;(display (example:gcd 'b 12))
(display "(gcd 'b 12): ")
;;(display (gcd 'b 12))
(display "\n")
(display "(example:circle 0.5 0.5): ")
(example:circle 0.5 0.5)
(display "(circle 0.5 0.5): ")
(circle 0.5 0.5)
(display "\n")
(display "(example:circle 1.0 1.0): ")
;;(example:circle 1.0 1.0)
(display "(circle 1.0 1.0): ")
;;(circle 1.0 1.0)
(display "\n")
(display "(example:circle 1 1): ")
;;(example:circle 1 1)
(display "(circle 1 1): ")
;;(circle 1 1)
(display "\n")
(display "(example:capitalize \"will this be all capital letters?\"): ")
(display (example:capitalize "will this be all capital letters?"))
(display "(capitalize \"will this be all capital letters?\"): ")
(display (capitalize "will this be all capital letters?"))
(display "\n")
(display "(example:capitalize 'a): ")
;;(display (example:capitalize 'a))
(display "(capitalize 'a): ")
;;(display (capitalize 'a))
(display "\n")
(display "(example:count \"jumpity little spider\" #\\t): ")
(display (example:count "jumpity little spider" #\t))
(display "(count \"jumpity little spider\" #\\t): ")
(display (count "jumpity little spider" #\t))
(display "\n")
(display "(example:gcdmain '#(\"hi\" \"there\")): ")
(display (example:gcdmain '#("hi" "there")))
(display "(gcdmain '#(\"hi\" \"there\")): ")
(display (gcdmain '#("hi" "there")))
(display "\n")
(display "(example:gcdmain '#(\"gcd\" \"9\" \"28\")): ")
(example:gcdmain '#("gcd" "9" "28"))
(display "(gcdmain '#(\"gcd\" \"9\" \"28\")): ")
(gcdmain '#("gcd" "9" "28"))
(display "\n")
(display "(example:gcdmain '#(\"gcd\" \"12\" \"90\")): ")
(example:gcdmain '#("gcd" "12" "90"))
(display "(gcdmain '#(\"gcd\" \"12\" \"90\")): ")
(gcdmain '#("gcd" "12" "90"))
(display "\n")
(display "(example:squarecubed 3: ")
(display (example:squareCubed 3))
(display "(squarecubed 3: ")
(display (squareCubed 3))
(display "\n")
(exit)

6
SWIG/Examples/chicken/overload/Makefile
View file

@ -5,7 +5,7 @@ SRCS =
CXXSRCS = example.cxx
TARGET = overload
INCLUDE =
SWIGOPT =
SWIGOPT = -proxy -unhideprimitive
CFLAGS =
VARIANT =
@ -23,8 +23,8 @@ $(TARGET): $(INTERFACE) $(SRCS)
clean::
$(MAKE) -f $(TOP)/Makefile chicken_clean
rm -f example.scm example-generic.scm example-clos.scm
rm -f example.scm
rm -f $(TARGET)
check::
csi -batch $(TARGET).so test-overload.scm
env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH csi test-overload.scm

50
SWIG/Examples/chicken/overload/test-overload.scm
View file

@ -1,5 +1,6 @@
;; This file demonstrates the overloading capabilities of SWIG
(load-library 'example "overload.so")
(declare (uses example))
(declare (uses tinyclos))
@ -8,42 +9,39 @@
(display "
Trying low level code ...
(example:foo 1)
(example:foo \"some string\")
(define A-FOO (example:new-Foo))
(define ANOTHER-FOO (example:new-Foo A-FOO)) ;; copy constructor
(example:Foo-bar A-FOO 2)
(example:Foo-bar ANOTHER-FOO \"another string\" 3)
(foo 1)
(foo \"some string\")
(define A-FOO (new-Foo))
(define ANOTHER-FOO (new-Foo A-FOO)) ;; copy constructor
(Foo-bar A-FOO 2)
(Foo-bar ANOTHER-FOO \"another string\" 3)
")
(example:foo 1)
(example:foo "some string")
(define A-FOO (example:new-Foo))
(define ANOTHER-FOO (example:new-Foo A-FOO)) ;; copy constructor
(example:Foo-bar A-FOO 2)
(example:Foo-bar ANOTHER-FOO "another string" 3)
(primitive:foo 1)
(primitive:foo "some string")
(define A-FOO (slot-ref (primitive:new-Foo) 'swig-this))
(define ANOTHER-FOO (slot-ref (primitive:new-Foo A-FOO) 'swig-this)) ;; copy constructor
(primitive:Foo-bar A-FOO 2)
(primitive:Foo-bar ANOTHER-FOO "another string" 3)
;; TinyCLOS
;; --------
(display "
Trying TinyCLOS code ...
(+example:foo+ 1)
(+example:foo+ \"some string\")
(define A-FOO (make <example:Foo>))
(define ANOTHER-FOO (make <example:Foo> A-FOO)) ;; copy constructor
(+foo+ 1)
(+foo+ \"some string\")
(define A-FOO (make <Foo>))
(define ANOTHER-FOO (make <Foo> A-FOO)) ;; copy constructor
(-bar- A-FOO 2)
(-bar- ANOTHER-FOO \"another string\" 3)
")
;; ALL generic methods must be included first
(include "example-generic")
;; After generic methods are defined, can include TinyCLOS code
(include "example-clos")
(foo 1)
(foo "some string")
(define A-FOO (make <Foo>))
(define ANOTHER-FOO (make <Foo> (slot-ref A-FOO 'swig-this))) ;; copy constructor
(bar A-FOO 2)
(bar ANOTHER-FOO "another string" 3)
(+example:foo+ 1)
(+example:foo+ "some string")
(define A-FOO (make <example:Foo>))
(define ANOTHER-FOO (make <example:Foo> A-FOO)) ;; copy constructor
(-bar- A-FOO 2)
(-bar- ANOTHER-FOO "another string" 3)
(exit)

2
SWIG/Examples/chicken/simple/Makefile
View file

@ -27,4 +27,4 @@ clean::
rm -f $(TARGET)
check::
csi -batch simple.so test-simple.scm
env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH csi test-simple.scm

43
SWIG/Examples/chicken/simple/test-simple.scm
View file

@ -1,43 +1,46 @@
;; feel free to uncomment and comment sections
(load-library 'example "simple.so")
(declare (uses example))
(display "(example:My-variable): ")
(display (example:My-variable))
(display "(My-variable): ")
(display (My-variable))
(display "\n")
(display "(example:My-variable 3.141259): ")
(display (example:My-variable 3.141259))
(display "(My-variable 3.141259): ")
(display (My-variable 3.141259))
(display "\n")
(display "(example:My-variable): ")
(display (example:My-variable))
(display "(My-variable): ")
(display (My-variable))
(display "\n")
(display "(example:My-variable 'a): ")
;;(display (example:My-variable 'a))
(display "(My-variable 'a): ")
;;(display (My-variable 'a))
(display "\n")
(display "(example:My-variable 1.5 'b): ")
(display (example:My-variable 1.5 'b))
(display "(My-variable 1.5 'b): ")
(display (My-variable 1.5 'b))
(display "\n")
(display "(example:fact 5): ")
(display (example:fact 5))
(display "(fact 5): ")
(display (fact 5))
(display "\n")
(display "(example:fact 'a): ")
;;(display (example:fact 'a))
(display "(fact 'a): ")
;;(display (fact 'a))
(display "\n")
(display "(example:mod 75 7): ")
(display (example:mod 75 7))
(display "(mod 75 7): ")
(display (mod 75 7))
(display "\n")
(display "(example:my-mod 75 7): ")
(display (example:my-mod 75 7))
(display "(my-mod 75 7): ")
(display (my-mod 75 7))
(display "\n")
(display "(example:get-time): ")
(display (example:get-time))
(display "(get-time): ")
(display (get-time))
(display "\n")
(exit)

11
SWIG/Examples/test-suite/chicken/newobject2_runme.ss
View file

@ -6,4 +6,15 @@
(if (not (= (slot-ref f 'dummy) 14))
(error "Bad dummy value"))
(define f2 (makeFoo))
(slot-set! f2 'dummy 16)
(if (not (= (slot-ref f2 'dummy) 16))
(error "Bad dummy value for f2"))
(set! f #f)
(set! f2 #f)
(gc)
(exit 0)

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

@ -584,7 +584,7 @@ SWIGEXPORT(void) SWIG_init(int, C_word, C_word) C_noret;
%insert(init) %{
/* CHICKEN initialization function */
static char[] swig_type_ptr_name = "type_pointer" SWIG_TYPE_TABLE_NAME;
static char *swig_type_ptr_name = "type_pointer" SWIG_TYPE_TABLE_NAME;
SWIGEXPORT(void)
SWIG_init(int argc, C_word closure, C_word continuation) {
static int typeinit = 0;
@ -593,6 +593,7 @@ SWIG_init(int argc, C_word closure, C_word continuation) {
C_word tmp;
C_word *a;
C_word ret;
C_word *return_vec;
if (!typeinit) {
/* lookup the type pointer... it is stored in it's own symbol table */
@ -620,6 +621,12 @@ SWIG_init(int argc, C_word closure, C_word continuation) {
ret = C_SCHEME_FALSE;
}
#if $veclength
return_vec = C_alloc(C_SIZEOF_VECTOR($veclength));
ret = (C_word) return_vec;
*(return_vec++) = C_VECTOR_TYPE | $veclength;
#endif
a = C_alloc(2*$nummethods$symsize);
%}

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

@ -38,6 +38,7 @@ extern "C" {
#define C_swig_is_pair(x) (C_truep (C_blockp(x)) && C_truep (C_pairp(x)))
#define C_swig_is_ptr(x) (C_truep (C_blockp (x)) && C_truep (C_pointerp (x)))
#define C_swig_is_swigpointer(x) (C_truep (C_blockp(x)) && C_truep (C_swigpointerp(x)))
#define C_swig_is_closurep(x) (C_truep (C_blockp(x)) && C_truep(C_closurep(x)))
#define SWIG_APPEND_VALUE(object) \
if (resultobj == C_SCHEME_UNDEFINED) \
@ -60,9 +61,9 @@ enum {
SWIG_BARF1_ARGUMENT_NULL /* 1 arg */
};
struct swig_chicken_clientdata {
typedef struct swig_chicken_clientdata {
C_word clos_class;
};
} swig_chicken_clientdata;
static char *
SWIG_Chicken_MakeString(C_word str) {
@ -161,13 +162,22 @@ SWIG_Chicken_Barf(int code, C_char *msg, ...)
}
}
static SWIGINLINE C_word
static C_word
SWIG_Chicken_NewPointerObj(void *ptr, swig_type_info *type, int owner, C_word **data)
{
swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) type->clientdata;
if (ptr == NULL)
return C_SCHEME_FALSE;
else
return C_swigmpointer(data, ptr, type);
else {
C_word cptr = C_swigmpointer(data, ptr, type);
if (cdata && cdata->clos_class && C_swig_is_closurep(cdata->clos_class)) {
C_save(cptr);
return C_callback(cdata->clos_class, 1);
} else {
return cptr;
}
}
}
/* Return 0 if successful. */

22
SWIG/Lib/chicken/swigclosprefix.scm
View file

@ -1,15 +1,15 @@
;(declare (hide swig-initialize))
(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 (swig-initialize obj initargs create)
(slot-set! obj 'swig-this
(if (memq 'swig-this initargs)
(cadr initargs)
(let ((ret (apply create initargs)))
(if (instance? ret)
(begin
(set-finalizer! ret (lambda (x) #t))
(slot-ref ret 'swig-this))
ret)))))
(define-class <swig-metaclass-$module> (<class>) (void))

144
SWIG/Source/Modules/chicken.cxx
View file

@ -2,6 +2,8 @@
* CHICKEN module for SWIG
*
* Author : Jonah Beckford
*
* Major restructuring: John Lenz
*
* Modified from mzscheme.cxx, guile.cxx and python.cxx : David
* Beazley
@ -62,7 +64,7 @@ static int useclassprefix = 0;
static String *closprefix = 0;
static String *memberfunction_name = 0;
static int hide_primitive = 1;
static String *primitive_hide = 0;
static Hash *primitive_names = 0;
class CHICKEN : public Language {
public:
@ -78,6 +80,7 @@ public:
virtual int membervariableHandler(Node *n);
virtual int constructorHandler(Node *n);
virtual int validIdentifier(String *s);
virtual int staticmembervariableHandler(Node *n);
protected:
void addMethod(String *scheme_name, String *function);
@ -86,6 +89,7 @@ protected:
void dispatchFunction(Node *n);
String *chickenNameMapping(String *, String_or_char *);
String *chickenPrimitiveName(String *);
};
/* -----------------------------------------------------------------------
@ -136,6 +140,8 @@ CHICKEN::main(int argc, char *argv[])
}
}
if (!clos) hide_primitive = 0;
// Add a symbol for this module
Preprocessor_define("SWIGCHICKEN 1",0);
@ -169,7 +175,7 @@ CHICKEN::top(Node *n)
chickentext = NewString("");
closhelpers = NewString("");
f_sym_size = NewString("");
primitive_hide = NewString("");
primitive_names = NewHash();
/* Register file targets with the SWIG file handler */
Swig_register_filebyname("header",f_header);
@ -227,15 +233,13 @@ CHICKEN::top(Node *n)
tab4, "(foreign-declare \"C_extern void swig_", module, "_init(int,C_word,C_word) C_noret;\"))\n", NIL);
Printv(f_scm,"(define swig-init (##core#primitive \"swig_", module,
"_init\"))\n", NIL);
Printv(f_scm,"(swig-init)\n\n", NIL);
Printv(f_scm,"(define swig-init-return (swig-init))\n\n", NIL);
if (clos) {
Printf (f_scm, "(declare (uses tinyclos))\n");
Replaceall(closhelpers,"$module", scmmodule);
Printf (f_scm, "%s\n", closhelpers);
Printf (f_scm, "%s\n", closcode);
if (hide_primitive)
Printf(f_scm, "(declare (hide %s))\n", primitive_hide);
}
Printf(f_scm, "%s\n", chickentext);
@ -249,12 +253,17 @@ CHICKEN::top(Node *n)
Replaceall(f_init, "$nummethods", buftmp);
Replaceall(f_init, "$symsize", f_sym_size);
if (hide_primitive)
Replaceall(f_init, "$veclength", buftmp);
else
Replaceall(f_init, "$veclength", "0");
Delete(chicken_filename);
Delete(chickentext);
Delete(closhelpers);
Delete(primitive_hide);
/* Close all of the files */
Delete(primitive_names);
Delete(scmmodule);
Dump(f_header,f_runtime);
Dump(f_wrappers,f_runtime);
@ -267,6 +276,14 @@ CHICKEN::top(Node *n)
Delete(f_runtime);
return SWIG_OK;
}
static int checkNodeClass(Node *n) {
String *kind = Getattr(n, "kind");
if (kind && Strcmp(kind, "class") == 0)
return 1;
else
return 0;
}
int
CHICKEN::functionWrapper(Node *n)
@ -401,7 +418,7 @@ CHICKEN::functionWrapper(Node *n)
if (clos) {
if (i < num_required) {
if (strcmp("void", Char(pt)) != 0) {
Node *class_node = Swig_symbol_clookup(pb, Getattr(n, "sym:symtab"));
Node *class_node = Swig_symbol_clookup_check(pb, Getattr(n, "sym:symtab"), checkNodeClass);
String *closclassname = (class_node == NULL) ? NULL : Getattr(class_node, "chicken:closclassname");
if (closclassname) {
Printv(method_signature, " (", argname, " ", closclassname, ")", NIL);
@ -540,16 +557,22 @@ CHICKEN::functionWrapper(Node *n)
Setattr(n,"wrap:name", wname);
/* Now register the function with the interpreter. */
int exportclos = 0;
if (!Getattr(n,"sym:overloaded")) {
addMethod(scmname, wname);
exportclos = 1;
}
else {
if (!Getattr(n,"sym:nextSibling")) {
dispatchFunction(n);
exportclos = 1;
}
}
if (!in_class || memberfunction_name) {
/* only export the clos function if sym:overloaded is false or last function in list of overloaded members
* also only export if we are not in a class, or if in a class memberfunction (this protects against member variables
* and static functions and so forth, which are generated seperatly */
if (exportclos && (!in_class || memberfunction_name)) {
String *method_def = NewString("");
String *clos_name;
if (in_class)
@ -559,13 +582,13 @@ CHICKEN::functionWrapper(Node *n)
Replaceall(method_signature, "_", "-");
Replaceall(method_signature, "_", "-");
if (!any_specialized_arg) {
Printv(method_def, "(define ", clos_name, " primitive:", scmname, ")\n", NIL);
Printv(method_def, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
} else if (num_required == num_arguments) {
Printv(method_def, "(define-method (", clos_name, method_signature, ")\n", NIL);
Printv(method_def, " (primitive:", scmname, primitive_args, "))\n", NIL);
Printv(method_def, " (", chickenPrimitiveName(scmname), primitive_args, "))\n", NIL);
} else {
Printv(method_def, "(define-method (", clos_name, method_signature, " . %args)\n", NIL);
Printv(method_def, " (apply primitive:", scmname, primitive_args, " %args))\n", NIL);
Printv(method_def, " (apply ", chickenPrimitiveName(scmname), primitive_args, " %args))\n", NIL);
}
if (in_class) {
Printv(clos_class_methods, method_def, NIL);
@ -941,18 +964,26 @@ CHICKEN::classHandler(Node *n)
Printf(closcode, ")))\n");
String *newmethod = NewStringf("new-%s", short_class_name);
String *delmethod = NewStringf("delete-%s", short_class_name);
if (have_constructor) {
Printv(closcode, "(define-method (initialize (obj ", class_name, ") initargs)\n",
" (call-next-method)\n",
" (slot-set! obj 'swig-this (apply primitive:new-", short_class_name, " initargs))\n",
" (set-finalizer! obj (lambda (x) (primitive:delete-", short_class_name, " (slot-ref x 'swig-this)))))\n",
" (swig-initialize obj initargs ", chickenPrimitiveName(newmethod), ")\n",
" (set-finalizer! obj (lambda (x) (", chickenPrimitiveName(delmethod), " (slot-ref x 'swig-this))))",
")\n",
NIL);
} else {
Printv(closcode, "(define-method (initialize (obj ", class_name, ") initargs)\n",
" (call-next-method)\n",
" (slot-set! obj 'swig-this #f))\n", NIL);
" (swig-initialize obj initargs (lambda x #f)))\n",
NIL);
}
Delete(newmethod);
Delete(delmethod);
Printf(closcode, "%s\n", clos_class_methods);
Delete(clos_class_methods);
clos_class_methods = 0;
@ -967,11 +998,13 @@ CHICKEN::classHandler(Node *n)
Printv(f_wrappers, "static void ", funcname, "(int,C_word,C_word,C_word) C_noret;\n",
"static void ", funcname, "(int argc, C_word closure, C_word continuation, C_word cl) {\n",
" C_trace(\"", funcname, "\");\n",
" ((swig_chicken_clientdata *)(SWIGTYPE", swigtype_ptr,"->clientdata))->clos_class = cl;\n",
" C_mutate(&((swig_chicken_clientdata *)(SWIGTYPE", swigtype_ptr,"->clientdata))->clos_class, cl);\n",
" C_kontinue(continuation, C_SCHEME_UNDEFINED);\n",
"}\n", NIL);
addMethod(closfuncname, funcname);
Printv(closcode, "(", chickenPrimitiveName(closfuncname), " (lambda (x) (make ", class_name, " 'swig-this x)))\n", NIL);
Delete(closfuncname);
Delete(funcname);
}
@ -1018,13 +1051,16 @@ CHICKEN::membervariableHandler(Node *n)
Node *class_node = Swig_symbol_clookup(pb, Getattr(n, "sym:symtab"));
String *closclassname = (class_node == NULL) ? NULL : Getattr(class_node, "chicken:closclassname");
Printv(closcode," (list '", proc, " ':swig-virtual ':swig-get primitive:", short_class_name, "-", proc, "-get", NIL);
String *getfunc = NewStringf("%s-%s-get", short_class_name, proc);
String *setfunc = NewStringf("%s-%s-set", short_class_name, proc);
Printv(closcode," (list '", proc, " ':swig-virtual ':swig-get ", chickenPrimitiveName(getfunc), NIL);
if (!Getattr(n,"feature:immutable")) {
if (closclassname) {
Printv(closcode, " ':swig-set (lambda (x y) (primitive:", short_class_name, "-", proc, "-set x (slot-ref y 'swig-this))\n");
Printv(closcode, " ':swig-set (lambda (x y) (", chickenPrimitiveName(setfunc), " x (slot-ref y 'swig-this))\n");
} else {
Printv(closcode, " ':swig-set primitive:", short_class_name, "-", proc, "-set)\n", NIL);
Printv(closcode, " ':swig-set ", chickenPrimitiveName(setfunc), ")\n", NIL);
}
} else {
Printf(closcode, ")\n");
@ -1034,6 +1070,36 @@ CHICKEN::membervariableHandler(Node *n)
return SWIG_OK;
}
int
CHICKEN::staticmembervariableHandler(Node *n)
{
String *iname = Getattr(n, "sym:name");
String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type")));
Language::staticmembervariableHandler(n);
String *proc = NewString(iname);
Replaceall(proc, "_", "-");
String *closprocname = chickenNameMapping(proc, short_class_name);
Node *class_node = Swig_symbol_clookup(pb, Getattr(n, "sym:symtab"));
String *closclassname = (class_node == NULL) ? NULL : Getattr(class_node, "chicken:closclassname");
String *primfunc = NewStringf("%s-%s", short_class_name, proc);
if (closclassname) {
Printv(clos_class_methods, "(define (", closprocname, " . lst) (if (null? lst) (", chickenPrimitiveName(primfunc), ") (",
chickenPrimitiveName(primfunc), " (slot-ref (car lst) 'swig-this))))\n", NIL);
} else {
Printv(clos_class_methods, "(define ", closprocname, " ", chickenPrimitiveName(primfunc), ")\n", NIL);
}
Delete(closprocname);
return SWIG_OK;
}
int
CHICKEN::constructorHandler(Node *n)
{
@ -1134,20 +1200,44 @@ CHICKEN::addMethod(String *scheme_name, String *function)
}
Append(sym, scheme_name);
if (clos) {
Printf(primitive_hide, " %s ", sym);
/* add symbol to Chicken internal symbol table */
if (hide_primitive) {
Printv(f_init, "{\n",
" C_word *p0 = a;\n",
" *(a++)=C_CLOSURE_TYPE|1;\n",
" *(a++)=(C_word)", function, ";\n",
" C_mutate(return_vec++, (C_word)p0);\n",
"}\n", NIL);
} else {
Printf(f_sym_size, "+C_SIZEOF_INTERNED_SYMBOL(%d)", Len(sym));
Printf(f_init, "sym = C_intern (&a, %d, \"%s\");\n",
Len(sym), sym);
Printv(f_init,
"C_mutate ((C_word*)sym+1, (*a=C_CLOSURE_TYPE|1, a[1]=(C_word)",
function, ", tmp=(C_word)a, a+=2, tmp));\n", NIL);
}
if (hide_primitive) {
Setattr(primitive_names, scheme_name, NewStringf("(vector-ref swig-init-return %i)", num_methods));
} else {
Setattr(primitive_names, scheme_name, Copy(sym));
}
/* add symbol to Chicken internal symbol table */
Printf(f_sym_size, "+C_SIZEOF_INTERNED_SYMBOL(%d)", Len(sym));
Printf(f_init, "sym = C_intern (&a, %d, \"%s\");\n",
Len(sym), sym);
Printv(f_init,
"C_mutate ((C_word*)sym+1, (*a=C_CLOSURE_TYPE|1, a[1]=(C_word)",
function, ", tmp=(C_word)a, a+=2, tmp));\n", NIL);
num_methods++;
Delete(sym);
}
String *
CHICKEN::chickenPrimitiveName(String *name) {
String *value = Getattr(primitive_names, name);
if (value)
return value;
else {
Swig_error(input_file, line_number, "Internal Error: attempting to reference non-existant primitive name %s\n", name);
return NewString("#f");
}
}
int
CHICKEN::validIdentifier(String *s)