guile/guile-oops ChangeLog INSTALL README compi...

[Mikael Djurfeldt]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Mikael Djurfeldt <address@hidden>       01/03/04 18:23:56

Modified files:
        guile-oops     : ChangeLog INSTALL README compile.scm 
                         configure.in dispatch.scm goops.c goops.h 
                         goops.scm internal.scm 

Log message:
        * goops.c, goops.h (scm_sys_tag_body): Added.
        
        * dispatch.scm (method-cache-install!): Fixed n-specializers.
        
        * compile.scm (compile-method): Tag method closure for body
        expansion.
        
        * goops.scm (change-object-class): Quote empty list constants.
        (method): Reverted previous change (enclosing body);
        Quote empty list.
        (initialize <method>): Supply `dummy-procedure' as default instead
        of creating a new closure.
        
        * internal.scm: Re-export (oop goops) without copying bindings.
        
        * configure.in: Test for GOOPS in libguile.
        
        * goops.h: Renamed class --> cls, new --> newinst in order to
        accomodate C++.
        
        * configure.in, Makefile.am: Added kludge to prevent
        libgoopscore.so to be linked with libqthreads.so (which strangely
        generates a lintian shlib-with-non-pic-code error).

CVSWeb URLs:
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-oops/ChangeLog.diff?r1=1.131&r2=1.132
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-oops/INSTALL.diff?r1=1.3&r2=1.4
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-oops/README.diff?r1=1.15&r2=1.16
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-oops/compile.scm.diff?r1=1.7&r2=1.8
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-oops/configure.in.diff?r1=1.15&r2=1.16
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-oops/dispatch.scm.diff?r1=1.17&r2=1.18
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-oops/goops.c.diff?r1=1.74&r2=1.75
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-oops/goops.h.diff?r1=1.32&r2=1.33
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-oops/goops.scm.diff?r1=1.61&r2=1.62
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-oops/internal.scm.diff?r1=1.1&r2=1.2

Patches:
Index: guile/guile-oops/ChangeLog
diff -u guile/guile-oops/ChangeLog:1.131 guile/guile-oops/ChangeLog:1.132
--- guile/guile-oops/ChangeLog:1.131    Thu Feb 22 17:05:03 2001
+++ guile/guile-oops/ChangeLog  Sun Mar  4 18:23:56 2001
@@ -1,4 +1,24 @@
-2001-02-22  Mikael Djurfeldt  <address@hidden>
+2001-03-04  Mikael Djurfeldt  <address@hidden>
+
+       * goops.c, goops.h (scm_sys_tag_body): Added.
+
+       * dispatch.scm (method-cache-install!): Fixed n-specializers.
+
+       * compile.scm (compile-method): Tag method closure for body
+       expansion.
+
+       * goops.scm (change-object-class): Quote empty list constants.
+       (method): Reverted previous change (enclosing body);
+       Quote empty list.
+       (initialize <method>): Supply `dummy-procedure' as default instead
+       of creating a new closure.
+       
+       * internal.scm: Re-export (oop goops) without copying bindings.
+
+       * configure.in: Test for GOOPS in libguile.
+
+       * goops.h: Renamed class --> cls, new --> newinst in order to
+       accomodate C++.
 
        * configure.in, Makefile.am: Added kludge to prevent
        libgoopscore.so to be linked with libqthreads.so (which strangely
Index: guile/guile-oops/INSTALL
diff -u guile/guile-oops/INSTALL:1.3 guile/guile-oops/INSTALL:1.4
--- guile/guile-oops/INSTALL:1.3        Sat Aug 21 20:39:35 1999
+++ guile/guile-oops/INSTALL    Sun Mar  4 18:23:56 2001
@@ -2,9 +2,9 @@
 
 To build GOOPS on unix, there are two (three) basic steps:
 
-       0. If you don't have Guile version 1.3.2 or higher installed
-          on your system, you need to do that first.  (See README
-          under "Obtaining GOOPS").
+       0. If you don't have a Guile version between 1.3.2 and 1.4,
+           inclusively, installed on your system, you need to do that
+           first.  (See README under "Obtaining GOOPS").
 
        1. Type "./configure", to configure the package for your system.
 
Index: guile/guile-oops/README
diff -u guile/guile-oops/README:1.15 guile/guile-oops/README:1.16
--- guile/guile-oops/README:1.15        Tue Jan  4 07:13:29 2000
+++ guile/guile-oops/README     Sun Mar  4 18:23:56 2001
@@ -23,7 +23,7 @@
 [Most of this section can be found in the texinfo documentation as well.]
 
 1. Make sure that you have a version of Guile later than or equal to
-   1.3.2 installed on your system.  (You can type
+   1.3.2 and earlier than 1.5 installed on your system.  (You can type
 
      guile -c '(write-line (version))'
 
Index: guile/guile-oops/compile.scm
diff -u guile/guile-oops/compile.scm:1.7 guile/guile-oops/compile.scm:1.8
--- guile/guile-oops/compile.scm:1.7    Wed Aug 25 21:29:28 1999
+++ guile/guile-oops/compile.scm        Sun Mar  4 18:23:56 2001
@@ -1,4 +1,4 @@
-;;;;   Copyright (C) 1999 Free Software Foundation, Inc.
+;;;;   Copyright (C) 1999, 2001 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -109,6 +109,9 @@
 ;;; NOTE: This section is far from finished.  It will finally be
 ;;; implemented on C level.
 
+(define %tag-body
+  (nested-ref the-root-module '(app modules oop goops %tag-body)))
+
 (define (compile-method methods types)
   (let* ((proc (method-procedure (car methods)))
         (src (procedure-source proc))
@@ -132,5 +135,5 @@
              ,@body)))
        (cons (procedure-environment proc)
              (cons formals
-                   body))
+                   (%tag-body body)))
        )))
Index: guile/guile-oops/configure.in
diff -u guile/guile-oops/configure.in:1.15 guile/guile-oops/configure.in:1.16
--- guile/guile-oops/configure.in:1.15  Thu Feb 22 17:04:53 2001
+++ guile/guile-oops/configure.in       Sun Mar  4 18:23:56 2001
@@ -27,7 +27,11 @@
 
 AC_SUBST(LIBQTHREADS)
 
-AC_CHECK_FUNCS(scm_simple_format, scm_shared_array_root)
+AC_CHECK_FUNCS(scm_simple_format, scm_shared_array_root, scm_init_goops)
+
+if test "$ac_cv_func_scm_init_goops" == "yes"; then
+  AC_MSG_ERROR([Your Guile already has GOOPS built in.  You don't need this 
package.])
+fi
 
 AC_CACHE_CHECK(for two argument scm_mutex_init,
 ac_cv_func_scm_mutex_init_two_args,
Index: guile/guile-oops/dispatch.scm
diff -u guile/guile-oops/dispatch.scm:1.17 guile/guile-oops/dispatch.scm:1.18
--- guile/guile-oops/dispatch.scm:1.17  Sun Jul  2 00:33:56 2000
+++ guile/guile-oops/dispatch.scm       Sun Mar  4 18:23:56 2001
@@ -1,4 +1,4 @@
-;;;;   Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;;;;   Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -261,7 +261,7 @@
             (n-specializers
              (if (list? specializers)
                  (length specializers)
-                 (abs (slot-ref (method-cache-generic-function exp)
+                 (+ 1 (slot-ref (method-cache-generic-function exp)
                                 'n-specialized)))))
        (let* ((types (map class-of (first-n args n-specializers)))
               (entry+cmethod (compute-entry-with-cmethod applicable types)))
Index: guile/guile-oops/goops.c
diff -u guile/guile-oops/goops.c:1.74 guile/guile-oops/goops.c:1.75
--- guile/guile-oops/goops.c:1.74       Sat Aug 26 20:23:09 2000
+++ guile/guile-oops/goops.c    Sun Mar  4 18:23:56 2001
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+/*     Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -1034,7 +1034,14 @@
   return scm_slot_ref (obj, Intern ("slot-definition"));
 }  
 
+SCM_PROC (s_sys_tag_body, "%tag-body", 1, 0, 0, scm_sys_tag_body);
 
+SCM
+scm_sys_tag_body (SCM body)
+{
+  return scm_cons (SCM_IM_LAMBDA, body);
+}
+
 /******************************************************************************
  *
  * S l o t   a c c e s s
@@ -1137,7 +1144,7 @@
   /* Two cases here:
    *   - access is an integer (the offset of this slot in the slots vector)
    *   - otherwise (car access) is the getter function to apply
-          */
+   */
   if (SCM_INUMP (access))
     return SCM_SLOT (obj, SCM_INUM (access));
   else
@@ -1772,10 +1779,15 @@
        SCM_SLOT (SCM_CAR (methods), scm_si_code_table) = SCM_EOL;
     }
   {
-    int n = SCM_INUM (SCM_SLOT (gf, scm_si_n_specialized));
+    SCM n = SCM_SLOT (gf, scm_si_n_specialized);
     /* The sign of n is a flag indicating rest args. */
+    
+    /* In the separately packaged GOOPS, n-specialized in the cache
+     * is n-specialized in the gf + 1.  This is a workaround for a bug
+     * in the old SCM_IM_DISPATCH code in eval.c
+     */
     SCM_SET_MCACHE_N_SPECIALIZED (SCM_ENTITY_PROCEDURE (gf),
-                                 SCM_MAKINUM (n >= 0 ? n : -n));
+                                 SCM_MAKINUM (SCM_INUM (n) + 1));
   }
   return SCM_UNSPECIFIED;
 }
@@ -2914,3 +2926,9 @@
 {
   scm_register_module_xxx ("oop goops goopscore", (void *) scm_init_goops);
 }
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
Index: guile/guile-oops/goops.h
diff -u guile/guile-oops/goops.h:1.32 guile/guile-oops/goops.h:1.33
--- guile/guile-oops/goops.h:1.32       Fri Jun 30 13:01:41 2000
+++ guile/guile-oops/goops.h    Sun Mar  4 18:23:56 2001
@@ -2,7 +2,7 @@
 
 #ifndef GOOPSH
 #define GOOPSH
-/*     Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+/*     Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -205,7 +205,7 @@
 char *scm_c_oldfmt0 (char *);
 char *scm_c_oldfmt (char *, int n);
 void scm_load_goops (void);
-SCM scm_make_foreign_object (SCM class, SCM initargs);
+SCM scm_make_foreign_object (SCM cls, SCM initargs);
 SCM scm_make_class (SCM meta, char *s_name, SCM supers, size_t size,
                    void * (*constructor) (SCM initargs),
                    size_t (*destructor) (void *));
@@ -259,18 +259,19 @@
 SCM scm_method_generic_function (SCM obj); 
 SCM scm_method_specializers (SCM obj); 
 SCM scm_method_procedure (SCM obj); 
-SCM scm_accessor_method_slot_definition (SCM obj); 
+SCM scm_accessor_method_slot_definition (SCM obj);
+SCM scm_sys_tag_body (SCM body);
 SCM scm_sys_fast_slot_ref (SCM obj, SCM index); 
 SCM scm_sys_fast_slot_set_x (SCM obj, SCM index, SCM value); 
-SCM scm_slot_ref_using_class (SCM class, SCM obj, SCM slot_name); 
-SCM scm_slot_set_using_class_x (SCM class, SCM obj, SCM slot_name, SCM value); 
-SCM scm_slot_bound_using_class_p (SCM class, SCM obj, SCM slot_name); 
-SCM scm_slot_exists_using_class_p (SCM class, SCM obj, SCM slot_name); 
+SCM scm_slot_ref_using_class (SCM cls, SCM obj, SCM slot_name); 
+SCM scm_slot_set_using_class_x (SCM cls, SCM obj, SCM slot_name, SCM value); 
+SCM scm_slot_bound_using_class_p (SCM cls, SCM obj, SCM slot_name); 
+SCM scm_slot_exists_using_class_p (SCM cls, SCM obj, SCM slot_name); 
 SCM scm_slot_bound_p (SCM obj, SCM slot_name); 
 SCM scm_slots_exists_p (SCM obj, SCM slot_name); 
-SCM scm_sys_modify_instance (SCM old, SCM new); 
-SCM scm_sys_modify_class (SCM old, SCM new); 
-SCM scm_sys_invalidate_class (SCM class);
+SCM scm_sys_modify_instance (SCM old, SCM newinst); 
+SCM scm_sys_modify_class (SCM old, SCM newclass); 
+SCM scm_sys_invalidate_class (SCM cls);
 SCM scm_make_method_cache (SCM gf);
 SCM scm_sys_invalidate_method_cache_x (SCM gf);
 SCM scm_generic_capability_p (SCM proc);
Index: guile/guile-oops/goops.scm
diff -u guile/guile-oops/goops.scm:1.61 guile/guile-oops/goops.scm:1.62
--- guile/guile-oops/goops.scm:1.61     Sat Oct 21 15:46:03 2000
+++ guile/guile-oops/goops.scm  Sun Mar  4 18:23:56 2001
@@ -1,6 +1,6 @@
 ;;; installed-scm-file
 
-;;;;   Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+;;;;   Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -469,7 +469,7 @@
 (define method
   (letrec ((specializers
            (lambda (ls)
-             (cond ((null? ls) (list ls))
+             (cond ((null? ls) '('()))
                    ((pair? ls) (cons (if (pair? (car ls))
                                          (cadar ls)
                                          '<top>)
@@ -531,21 +531,8 @@
   (slot-set! gf 'methods (compute-new-list-of-methods gf m))
   (let ((specializers (slot-ref m 'specializers)))
     (slot-set! gf 'n-specialized
-              (let ((n-specialized (slot-ref gf 'n-specialized)))
-                ;; The magnitude indicates # specializers.
-                ;; A negative value indicates that at least one
-                ;; method has rest arguments. (Ugly but effective
-                ;; space optimization saving one slot in GF objects.)
-                (cond ((negative? n-specialized)
-                       (- (max (+ 1 (length* specializers))
-                               (abs n-specialized))))
-                      ((list? specializers)
-                       (max (length specializers)
-                            n-specialized))
-                      (else
-                       (- (+ 1 (max (length* specializers)
-                                    n-specialized)))))
-                )))
+              (max (length* specializers)
+                   (slot-ref gf 'n-specialized))))
   (%invalidate-method-cache! gf)
   (add-method-in-classes! m)
   *unspecified*)
@@ -1328,11 +1315,14 @@
        (set-procedure-property! generic 'name name))
     ))
 
+(define dummy-procedure (lambda args *unspecified*))
+
 (define-method initialize ((method <method>) initargs)
   (next-method)
   (slot-set! method 'generic-function (get-keyword #:generic-function initargs 
#f))
   (slot-set! method 'specializers (get-keyword #:specializers initargs '()))
-  (slot-set! method 'procedure (get-keyword #:procedure initargs (lambda l 
'())))
+  (slot-set! method 'procedure
+            (get-keyword #:procedure initargs dummy-procedure))
   (slot-set! method 'code-table '()))
 
 (define-method initialize ((obj <foreign-object>) initargs))
@@ -1342,7 +1332,7 @@
 ;;;
 
 (define (change-object-class old-instance old-class new-class)
-  (let ((new-instance (allocate-instance new-class ())))
+  (let ((new-instance (allocate-instance new-class '())))
     ;; Initalize the slot of the new instance
     (for-each (lambda (slot)
                (if (and (slot-exists-using-class? old-class old-instance slot)
Index: guile/guile-oops/internal.scm
diff -u guile/guile-oops/internal.scm:1.1 guile/guile-oops/internal.scm:1.2
--- guile/guile-oops/internal.scm:1.1   Thu Mar 18 23:02:39 1999
+++ guile/guile-oops/internal.scm       Sun Mar  4 18:23:56 2001
@@ -1,6 +1,6 @@
 ;;; installed-scm-file
 
-;;;;   Copyright (C) 1999 Free Software Foundation, Inc.
+;;;;   Copyright (C) 1999, 2001 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -22,7 +22,5 @@
 (define-module (oop goops internal)
   :use-module (oop goops))
 
-;; Export all bindings from (oop goops)
-(module-for-each (lambda (sym var)
-                  (module-add! %module-public-interface sym var))
-                (nested-ref the-root-module '(app modules oop goops)))
+(set-module-uses! %module-public-interface
+                 (list (nested-ref the-root-module '(app modules oop goops))))