has already been partially loaded. This may not work, you may~%~
need to get a fresh lisp (reboot) and then load PCL."))
\f
-;;; comments from CMU CL version of PCL:
-;;; This is like fdefinition on the Lispm. If Common Lisp had
-;;; something like function specs I wouldn't need this. On the other
-;;; hand, I don't like the way this really works so maybe function
-;;; specs aren't really right either?
-;;; I also don't understand the real implications of a Lisp-1 on this
-;;; sort of thing. Certainly some of the lossage in all of this is
-;;; because these SPECs name global definitions.
-;;; Note that this implementation is set up so that an implementation
-;;; which has a 'real' function spec mechanism can use that instead
-;;; and in that way get rid of setf generic function names.
-(defmacro parse-gspec (spec
- (non-setf-var . non-setf-case))
- `(let ((,non-setf-var ,spec)) ,@non-setf-case))
-
-;;; If symbol names a function which is traced, return the untraced
-;;; definition. This lets us get at the generic function object even
-;;; when it is traced.
-(defun unencapsulated-fdefinition (symbol)
- (fdefinition symbol))
-
-;;; If symbol names a function which is traced, redefine the `real'
-;;; definition without affecting the trace.
-(defun fdefine-carefully (name new-definition)
- (progn
- (sb-c::note-name-defined name :function)
- new-definition)
- (setf (fdefinition name) new-definition))
-
-(defun gboundp (spec)
- (parse-gspec spec
- (name (fboundp name))))
-
-(defun gmakunbound (spec)
- (parse-gspec spec
- (name (fmakunbound name))))
-
+#-sb-fluid (declaim (inline gdefinition))
(defun gdefinition (spec)
- (parse-gspec spec
- (name (unencapsulated-fdefinition name))))
+ ;; This is null layer right now, but once FDEFINITION stops bypasssing
+ ;; fwrappers/encapsulations we can do that here.
+ (fdefinition spec))
(defun (setf gdefinition) (new-value spec)
- (parse-gspec spec
- (name (fdefine-carefully name new-value))))
+ ;; This is almost a null layer right now, but once (SETF
+ ;; FDEFINITION) stops bypasssing fwrappers/encapsulations we can do
+ ;; that here.
+ (sb-c::note-name-defined spec :function) ; FIXME: do we need this? Why?
+ (setf (fdefinition spec) new-value))
\f
;;;; type specifier hackery
(defun variable-class (var env)
(caddr (var-declaration 'class var env)))
-(defvar *name->class->slotd-table* (make-hash-table))
-
(defvar *standard-method-combination*)
\f
-(defun make-class-predicate-name (name)
- (list 'class-predicate name))
-
(defun plist-value (object name)
(getf (object-plist object) name))
definition-source-mixin
metaobject
funcallable-standard-object)
- ((documentation
- :initform nil
- :initarg :documentation)
+ ((%documentation :initform nil :initarg :documentation)
;; We need to make a distinction between the methods initially set
;; up by :METHOD options to DEFGENERIC and the ones set up later by
;; DEFMETHOD, because ANSI specifies that executing DEFGENERIC on
;; DEFMETHOD, then modifying and reloading a.lisp and/or b.lisp
;; tends to leave the generic function in a state consistent with
;; the most-recently-loaded state of a.lisp and b.lisp.)
- (initial-methods
- :initform ()
- :accessor generic-function-initial-methods))
+ (initial-methods :initform ()
+ :accessor generic-function-initial-methods))
(:metaclass funcallable-standard-class))
(defclass standard-generic-function (generic-function)
((name
:initform nil
:initarg :name
- :accessor generic-function-name)
+ :reader generic-function-name)
(methods
:initform ()
:accessor generic-function-methods
(method-class
:initarg :method-class
:accessor generic-function-method-class)
- (method-combination
+ (%method-combination
:initarg :method-combination
:accessor generic-function-method-combination)
(declarations
(defclass method (metaobject) ())
(defclass standard-method (definition-source-mixin plist-mixin method)
- ((generic-function
+ ((%generic-function
:initform nil
:accessor method-generic-function)
-;;; (qualifiers
-;;; :initform ()
-;;; :initarg :qualifiers
-;;; :reader method-qualifiers)
+ #+nil ; implemented by PLIST
+ (qualifiers
+ :initform ()
+ :initarg :qualifiers
+ :reader method-qualifiers)
(specializers
:initform ()
:initarg :specializers
:initform ()
:initarg :lambda-list
:reader method-lambda-list)
- (function
- :initform nil
- :initarg :function) ;no writer
+ (%function :initform nil :initarg :function)
(fast-function
:initform nil
:initarg :fast-function ;no writer
:reader method-fast-function)
- (documentation
- :initform nil
- :initarg :documentation)))
+ (%documentation :initform nil :initarg :documentation)))
(defclass standard-accessor-method (standard-method)
- ((slot-name :initform nil
- :initarg :slot-name
+ ((slot-name :initform nil :initarg :slot-name
:reader accessor-method-slot-name)
- (slot-definition :initform nil
- :initarg :slot-definition
- :reader accessor-method-slot-definition)))
+ (%slot-definition :initform nil :initarg :slot-definition
+ :reader accessor-method-slot-definition)))
(defclass standard-reader-method (standard-accessor-method) ())
(defclass standard-writer-method (standard-accessor-method) ())
(defclass standard-boundp-method (standard-accessor-method) ())
(defclass method-combination (metaobject)
- ((documentation
- :reader method-combination-documentation
- :initform nil
- :initarg :documentation)))
+ ((%documentation :initform nil :initarg :documentation)))
(defclass standard-method-combination (definition-source-mixin
method-combination)
- ((type
- :reader method-combination-type
- :initarg :type)
+ ((type-name
+ :reader method-combination-type-name
+ :initarg :type-name)
(options
:reader method-combination-options
:initarg :options)))
:initarg :args-lambda-list
:reader long-method-combination-args-lambda-list)))
+(defclass short-method-combination (standard-method-combination)
+ ((operator
+ :reader short-combination-operator
+ :initarg :operator)
+ (identity-with-one-argument
+ :reader short-combination-identity-with-one-argument
+ :initarg :identity-with-one-argument)))
+
(defclass slot-definition (metaobject)
((name
:initform nil
:initform nil
:initarg :initargs
:accessor slot-definition-initargs)
- (type
- :initform t
- :initarg :type
- :accessor slot-definition-type)
- (documentation
- :initform nil
- :initarg :documentation)
- (class
- :initform nil
- :initarg :class
- :accessor slot-definition-class)))
+ (%type :initform t :initarg :type :accessor slot-definition-type)
+ (%documentation
+ :initform nil :initarg :documentation
+ ;; KLUDGE: we need a reader for bootstrapping purposes, in
+ ;; COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS.
+ :reader %slot-definition-documentation)
+ (%class :initform nil :initarg :class :accessor slot-definition-class)))
(defclass standard-slot-definition (slot-definition)
((allocation
())
(defclass specializer (metaobject)
- ((type :initform nil :reader specializer-type)))
+ ;; KLUDGE: in sbcl-0.9.10.2 this was renamed from TYPE, which was an
+ ;; external symbol of the CL package and hence potentially collides
+ ;; with user code. Renaming this to %TYPE, however, is the coward's
+ ;; way out, because the objects that PCL puts in this slot aren't
+ ;; (quite) types: they are closer to kinds of specializer. However,
+ ;; the wholesale renaming and disentangling of specializers didn't
+ ;; appeal. (See also message <sqd5hrclb2.fsf@cam.ac.uk> and
+ ;; responses in comp.lang.lisp). -- CSR, 2006-02-27
+ ((%type :initform nil :reader specializer-type)))
(defclass specializer-with-object (specializer) ())
specializer)
((name
:initform nil
- :initarg :name
- :accessor class-name)
+ :initarg :name
+ :reader class-name)
(class-eq-specializer
:initform nil
:reader class-eq-specializer)
:reader class-direct-subclasses)
(direct-methods
:initform (cons nil nil))
- (predicate-name
- :initform nil
- :reader class-predicate-name)
- (documentation
+ (%documentation
:initform nil
:initarg :documentation)
(finalized-p
;;; The class PCL-CLASS is an implementation-specific common
;;; superclass of all specified subclasses of the class CLASS.
(defclass pcl-class (class)
- ((class-precedence-list
+ ((%class-precedence-list
:reader class-precedence-list)
;; KLUDGE: see note in CPL-OR-NIL
(cpl-available-p
:initarg :from-defclass-p)))
(defclass definition-source-mixin (standard-object)
- ((source :initform *load-pathname* :reader definition-source
- :initarg :definition-source)))
+ ((source
+ :initform nil
+ :reader definition-source
+ :initarg :definition-source)))
(defclass plist-mixin (standard-object)
((plist :initform () :accessor object-plist)))
(generic-function generic-function-p)
(standard-generic-function standard-generic-function-p)
(method-combination method-combination-p)
- (long-method-combination long-method-combination-p)))
-
+ (long-method-combination long-method-combination-p)
+ (short-method-combination short-method-combination-p)))
projects / sbcl.git / blobdiff