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

git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@6400 626c5289-ae23-0410-ae9c-e8d60b6d4f22

SWIG/CHANGES.current

@@ -1,6 +1,19 @@
 Version 1.3.23 (in progress)
 ============================
 
+10/16/2004: wuzzeb (John Lenz)
+            [CHICKEN]
+	    - Completly change how chicken.cxx handles CLOS and generic code.
+	      chicken no longer exports -clos.scm and -generic.scm.  The clos
+	      code is exported directly into the module.scm file if -proxy is passed.
+	    - The code now always exports a unit.  Running the test-suite is now
+	      majorly broken, and needs to be fixed.
+	    - CLOS now generates virtual slots for member variables similar to how
+	      GOOPS support works in the guile module.
+	    - chicken no longer prefixes symbols by the module name, and no longer
+	      forces all names to lower case.  It now has -useclassprefix and -closprefix
+	      similar to how guile handles GOOPS names.
+
 10/16/2004: wsfulton
             Templated functions with default arguments working with new default argument
             wrapping approach. The new approach no longer fails with the following default

SWIG/Examples/test-suite/chicken/Makefile.in

@@ -17,7 +17,7 @@ SO           = @SO@
 include $(srcdir)/../common.mk
 
 # Overridden variables here
-SWIGOPT += -noprefix
+SWIGOPT +=
 
 # Rules for the different types of tests
 %.cpptest: 
@@ -39,7 +39,7 @@ SWIGOPT += -noprefix
 # a file is found which has _runme.scm appended after the testcase name.
 run_testcase = \
 	if [ -f $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then (	  \
-	  env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(CHICKEN_CSI) $*$(SO) $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX);) \
+	  env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(CHICKEN_CSI) $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX);) \
 	fi;
 
 # Clean

SWIG/Lib/chicken/chicken.swg

@@ -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 {

SWIG/Lib/chicken/chickenrun.swg

@@ -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) {

SWIG/Lib/chicken/swigclosprefix.scm

@@ -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)))))