summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--oop/ChangeLog7
-rw-r--r--oop/goops.scm17
2 files changed, 17 insertions, 7 deletions
diff --git a/oop/ChangeLog b/oop/ChangeLog
index 09dae3c64..b071f5019 100644
--- a/oop/ChangeLog
+++ b/oop/ChangeLog
@@ -1,3 +1,10 @@
+2001-03-04 Mikael Djurfeldt <mdj@linnaeus.mit.edu>
+
+ * goops.scm (change-object-class): Quote empty list constants.
+ (method): Reverted previous change (enclosing body);
+ Quote empty list.
+ (initialize <method>): Pre-expand the method closure.
+
2001-02-23 Keisuke Nishida <kxn30@po.cwru.edu>
* goops.scm (method): Enclosed BODY by `(let () ...)'.
diff --git a/oop/goops.scm b/oop/goops.scm
index b2405b283..a0af2b9bf 100644
--- 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
@@ -468,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>)
@@ -487,9 +487,9 @@
`(make <method>
#:specializers (list* ,@(specializers args))
#:procedure (lambda ,(formals args)
- ,(if (null? body)
- *unspecified*
- `(let () ,@body)))))))))
+ ,@(if (null? body)
+ (list *unspecified*)
+ body))))))))
;;;
;;; {add-method!}
@@ -1318,7 +1318,10 @@
(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
+ (%pre-expand-closure!
+ (get-keyword #:procedure initargs (lambda l '()))))
(slot-set! method 'code-table '()))
(define-method initialize ((obj <foreign-object>) initargs))
@@ -1328,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)