Changeset 4347

Timestamp:

10/13/03 13:11:20 (18 years ago)

Author:

piso

Message:

Work in progress.

File:

• trunk/j/src/org/armedbear/lisp/defclass.lisp (modified) (4 diffs)

trunk/j/src/org/armedbear/lisp/defclass.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: defclass.lisp,v 1.20 2003-10-13 12:08:23 piso Exp $
+;;; $Id: defclass.lisp,v 1.21 2003-10-13 13:11:20 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -58 +58 @@
 (defsetf class-precedence-list %set-class-precedence-list)
 (defsetf class-slots %set-class-slots)
+
+(defun (setf find-class) (new-value symbol &optional errorp environment)
+  (%set-find-class symbol new-value))
 
 (defun canonicalize-direct-slots (direct-slots)
@@ -502 +505 @@
       (setf class (apply #'make-instance-standard-class
                          (find-class 'standard-class) :name name all-keys))
-      (add-class class))
+      (%set-find-class name class))
     class))
 
@@ -1104 +1107 @@
   (let ((form (method-body method))
         (lambda-list (method-lambda-list method)))
-    (compile-in-lexical-environment (method-environment method)
-                                    `(lambda (args next-emfun)
-                                       (flet ((call-next-method (&rest cnm-args)
-                                                                (if (null next-emfun)
-                                                                    (error "No next method for the~@
-                                                                    generic function ~S."
-                                                                           (method-generic-function ',method))
-                                                                    (funcall next-emfun (or cnm-args args))))
-                                              (next-method-p ()
-                                                             (not (null next-emfun))))
-                                         (apply #'(lambda ,(kludge-arglist lambda-list)
-                                                   ,form)
-                                                args))))))
+    (compile-in-lexical-environment
+     (method-environment method)
+     `(lambda (args next-emfun)
+        (flet ((call-next-method (&rest cnm-args)
+                                 (if (null next-emfun)
+                                     (error "no next method for the generic function ~S"
+                                            (method-generic-function ',method))
+                                     (funcall next-emfun (or cnm-args args))))
+               (next-method-p ()
+                              (not (null next-emfun))))
+          (apply #'(lambda ,(kludge-arglist lambda-list)
+                    ,form)
+                 args))))))
 
 ;;; N.B. The function kludge-arglist is used to pave over the differences