mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

* goops.scm (change-object-class): Quote empty list constants.

Browse source 
(method): Reverted previous change (enclosing body);
Quote empty list.
(initialize <method>): Pre-expand the method closure.
This commit is contained in:
Mikael Djurfeldt 2001-03-04 05:28:21 +00:00
parent 87e7741df7
commit cc6c7feea4
2 changed files with 17 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

7
oop/ChangeLog
View file

@ -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 () ...)'.

17
oop/goops.scm
View file

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