0.6.10.19:
[sbcl.git] / src / pcl / defs.lisp
index 1daa52f..dcaa9eb 100644 (file)
 
 (in-package "SB-PCL")
 \f
-(eval-when (:compile-toplevel :load-toplevel :execute)
-
-;;; FIXME: These are non-ANSI hacks which it would be nice to get rid of.
-(defvar *defclass-times*   '(:load-toplevel :execute)) ; You probably have
-                                       ; to change this if you use
-                                       ; DEFCONSTRUCTOR.
-(defvar *defmethod-times*  '(:load-toplevel :execute))
-(defvar *defgeneric-times* '(:load-toplevel :execute))
-
-) ; EVAL-WHEN
 
 (eval-when (:load-toplevel :execute)
   (when (eq *boot-state* 'complete)
 ;;;   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)
-                      (setf-var . setf-case))
-  #+setf (declare (ignore setf-var setf-case))
-  (once-only (spec)
-    `(cond (#-setf (symbolp ,spec) #+setf t
-           (let ((,non-setf-var ,spec)) ,@non-setf-case))
-          #-setf
-          ((and (listp ,spec)
-                (eq (car ,spec) 'setf)
-                (symbolp (cadr ,spec)))
-           (let ((,setf-var (cadr ,spec))) ,@setf-case))
-          #-setf
-          (t
-           (error
-             "Can't understand ~S as a generic function specifier.~%~
-              It must be either a symbol which can name a function or~%~
-              a list like ~S, where the car is the symbol ~S and the cadr~%~
-              is a symbol which can name a generic function."
-             ,spec '(setf <foo>) 'setf)))))
+                      (non-setf-var . non-setf-case))
+  `(let ((,non-setf-var ,spec)) ,@non-setf-case))
 
 ;;; If symbol names a function which is traced or advised, return the
 ;;; unadvised, traced etc. definition. This lets me get at the generic
 ;;; function object even when it is traced.
 (defun unencapsulated-fdefinition (symbol)
-  (symbol-function symbol))
+  (name-get-fdefinition symbol))
 
 ;;; If symbol names a function which is traced or advised, redefine
 ;;; the `real' definition without affecting the advise.
     (sb-c::%%defun name new-definition nil)
     (sb-c::note-name-defined name :function)
     new-definition)
-  (setf (symbol-function name) new-definition))
+  (name-set-fdefinition name new-definition))
 
 (defun gboundp (spec)
   (parse-gspec spec
-    (name (fboundp name))
-    (name (fboundp (get-setf-function-name name)))))
+    (name (fboundp name))))
 
 (defun gmakunbound (spec)
   (parse-gspec spec
-    (name (fmakunbound name))
-    (name (fmakunbound (get-setf-function-name name)))))
+    (name (fmakunbound name))))
 
 (defun gdefinition (spec)
   (parse-gspec spec
-    (name (or #-setf (macro-function name)             ;??
-             (unencapsulated-fdefinition name)))
-    (name (unencapsulated-fdefinition (get-setf-function-name name)))))
+    (name (unencapsulated-fdefinition name))))
 
-(defun #-setf SETF\ SB-PCL\ GDEFINITION #+setf (setf gdefinition) (new-value
-                                                                  spec)
+(defun (setf gdefinition) (new-value spec)
   (parse-gspec spec
-    (name (fdefine-carefully name new-value))
-    (name (fdefine-carefully (get-setf-function-name name) new-value))))
+    (name (fdefine-carefully name new-value))))
 \f
 (declaim (special *the-class-t*
                  *the-class-vector* *the-class-symbol*
 (defun plist-value (object name)
   (getf (object-plist object) name))
 
-(defun #-setf SETF\ SB-PCL\ PLIST-VALUE #+setf (setf plist-value) (new-value
-                                                                  object
-                                                                  name)
+(defun (setf plist-value) (new-value object name)
   (if new-value
       (setf (getf (object-plist object) name) new-value)
       (progn