Changeset 4347


Ignore:
Timestamp:
10/13/03 13:11:20 (19 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/defclass.lisp

    r4342 r4347  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: defclass.lisp,v 1.20 2003-10-13 12:08:23 piso Exp $
     4;;; $Id: defclass.lisp,v 1.21 2003-10-13 13:11:20 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    5858(defsetf class-precedence-list %set-class-precedence-list)
    5959(defsetf class-slots %set-class-slots)
     60
     61(defun (setf find-class) (new-value symbol &optional errorp environment)
     62  (%set-find-class symbol new-value))
    6063
    6164(defun canonicalize-direct-slots (direct-slots)
     
    502505      (setf class (apply #'make-instance-standard-class
    503506                         (find-class 'standard-class) :name name all-keys))
    504       (add-class class))
     507      (%set-find-class name class))
    505508    class))
    506509
     
    11041107  (let ((form (method-body method))
    11051108        (lambda-list (method-lambda-list method)))
    1106     (compile-in-lexical-environment (method-environment method)
    1107                                     `(lambda (args next-emfun)
    1108                                        (flet ((call-next-method (&rest cnm-args)
    1109                                                                 (if (null next-emfun)
    1110                                                                     (error "No next method for the~@
    1111                                                                     generic function ~S."
    1112                                                                            (method-generic-function ',method))
    1113                                                                     (funcall next-emfun (or cnm-args args))))
    1114                                               (next-method-p ()
    1115                                                              (not (null next-emfun))))
    1116                                          (apply #'(lambda ,(kludge-arglist lambda-list)
    1117                                                    ,form)
    1118                                                 args))))))
     1109    (compile-in-lexical-environment
     1110     (method-environment method)
     1111     `(lambda (args next-emfun)
     1112        (flet ((call-next-method (&rest cnm-args)
     1113                                 (if (null next-emfun)
     1114                                     (error "no next method for the generic function ~S"
     1115                                            (method-generic-function ',method))
     1116                                     (funcall next-emfun (or cnm-args args))))
     1117               (next-method-p ()
     1118                              (not (null next-emfun))))
     1119          (apply #'(lambda ,(kludge-arglist lambda-list)
     1120                    ,form)
     1121                 args))))))
    11191122
    11201123;;; N.B. The function kludge-arglist is used to pave over the differences
Note: See TracChangeset for help on using the changeset viewer.