;;; 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
(define method
(letrec ((specializers
(lambda (ls)
- (cond ((null? ls) (list ls))
+ (cond ((null? ls) '('()))
((pair? ls) (cons (if (pair? (car ls))
(cadar ls)
'<top>)
(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))
;;;
(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)