X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdefs.lisp;h=dbed28c0a279ea95d93061c737c1329629dae5aa;hb=88cc2f72774202503588331fddd1592ae8546de1;hp=781f4c6ec8d7ed78378ea55dc1afdd91015da758;hpb=feea06ce0acba516d739867b23341509e9c36d50;p=sbcl.git diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp index 781f4c6..dbed28c 100644 --- a/src/pcl/defs.lisp +++ b/src/pcl/defs.lisp @@ -38,50 +38,18 @@ has already been partially loaded. This may not work, you may~%~ need to get a fresh lisp (reboot) and then load PCL.")) -;;; 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)) ;;;; type specifier hackery @@ -232,13 +200,8 @@ (defun variable-class (var env) (caddr (var-declaration 'class var env))) -(defvar *name->class->slotd-table* (make-hash-table)) - (defvar *standard-method-combination*) -(defun make-class-predicate-name (name) - (list 'class-predicate name)) - (defun plist-value (object name) (getf (object-plist object) name)) @@ -351,9 +314,7 @@ 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 @@ -365,16 +326,15 @@ ;; 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 @@ -382,7 +342,7 @@ (method-class :initarg :method-class :accessor generic-function-method-class) - (method-combination + (%method-combination :initarg :method-combination :accessor generic-function-method-combination) (declarations @@ -406,13 +366,14 @@ (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 @@ -421,24 +382,18 @@ :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) ()) @@ -446,16 +401,13 @@ (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))) @@ -468,6 +420,14 @@ :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 @@ -493,17 +453,13 @@ :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 @@ -579,7 +535,15 @@ ()) (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 and + ;; responses in comp.lang.lisp). -- CSR, 2006-02-27 + ((%type :initform nil :reader specializer-type))) (defclass specializer-with-object (specializer) ()) @@ -612,8 +576,8 @@ specializer) ((name :initform nil - :initarg :name - :accessor class-name) + :initarg :name + :reader class-name) (class-eq-specializer :initform nil :reader class-eq-specializer) @@ -628,10 +592,7 @@ :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 @@ -651,7 +612,7 @@ ;;; 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 @@ -708,8 +669,10 @@ :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))) @@ -738,5 +701,5 @@ (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)))