* goops/compile.scm (compile-method): Tag method closure for body

[bpt/guile.git] / oop / goops.scm

diff --git a/oop/goops.scm b/oop/goops.scm
index 94d4e1d..ca5c85d 100644 (file)
--- a/oop/goops.scm
+++ b/oop/goops.scm
@@ -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
@@ -77,8 +77,7 @@
     generic-function-methods method-generic-function method-specializers
     primitive-generic-generic enable-primitive-generic!
     method-procedure accessor-method-slot-definition
-    slot-exists? make find-method get-keyword
-    %logand)
+    slot-exists? make find-method get-keyword)
 
 \f
 (define min-fixnum (- (expt 2 29)))
@@ -469,7 +468,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>)
@@ -1315,11 +1314,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))
@@ -1329,7 +1331,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)