From f865612b20955e92189b1e683203e12c8f08eb79 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Tue, 16 Oct 2001 00:46:33 +0000 Subject: [PATCH] 0.pre7.66: got rid of now-redundant :ACCESSOR-FOR stuff, hoping that henceforth slot accessors can truly be ordinary functions with ordinary inline expansions instead of hybrid non-ANSI weirdosities --- src/code/defstruct.lisp | 18 +++--------------- src/code/early-setf.lisp | 5 ----- src/compiler/generic/genesis.lisp | 12 +----------- src/compiler/globaldb.lisp | 8 -------- src/compiler/info-functions.lisp | 19 ++++--------------- src/compiler/ir1tran.lisp | 17 +---------------- src/compiler/proclaim.lisp | 5 ++--- tests/interface.pure.lisp | 3 --- version.lisp-expr | 2 +- 9 files changed, 12 insertions(+), 77 deletions(-) diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 9d0dd52..2404a83 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -926,10 +926,9 @@ (dolist (dsd (dd-slots dd)) (let* ((accessor-name (dsd-accessor-name dsd))) (when accessor-name - - ;; new implementation sbcl-0.pre7.64 (multiple-value-bind (reader-designator writer-designator) (accessor-inline-expansion-designators dd dsd) + (proclaim-as-defstruct-fun-name accessor-name) (setf (info :function :inline-expansion-designator accessor-name) @@ -937,23 +936,14 @@ (info :function :inlinep accessor-name) :inline) (unless (dsd-read-only dsd) + (proclaim-as-defstruct-fun-name `(setf ,accessor-name)) (let ((setf-accessor-name `(setf ,accessor-name))) (setf (info :function :inline-expansion-designator setf-accessor-name) writer-designator (info :function :inlinep setf-accessor-name) - :inline)))) - - ;; old code from before sbcl-0.pre7.64, will hopefully - ;; fade away and/or merge into new code above - (when (eq (dsd-raw-type dsd) t) ; when not raw slot - (proclaim-as-defstruct-fun-name accessor-name) - (setf (info :function :accessor-for accessor-name) class) - (unless (dsd-read-only dsd) - (proclaim-as-defstruct-fun-name `(setf ,accessor-name)) - (setf (info :function :accessor-for `(setf ,accessor-name)) - class)))))) + :inline))))))) ;; FIXME: Couldn't this logic be merged into ;; PROCLAIM-AS-DEFSTRUCT-FUN-NAME? @@ -1425,8 +1415,6 @@ ;;; are any undefined warnings, we nuke them. (defun proclaim-as-defstruct-fun-name (name) (when name - (when (info :function :accessor-for name) - (setf (info :function :accessor-for name) nil)) (proclaim-as-fun-name name) (note-name-defined name :function) (setf (info :function :where-from name) :declared) diff --git a/src/code/early-setf.lisp b/src/code/early-setf.lisp index 65b6efb..8a21d7a 100644 --- a/src/code/early-setf.lisp +++ b/src/code/early-setf.lisp @@ -339,11 +339,6 @@ GET-SETF-EXPANSION directly." ((not (fboundp `(setf ,name))) ;; All is well, we don't need any warnings. (values)) - ((info :function :accessor-for name) - (warn "defining SETF macro for DEFSTRUCT slot ~ - accessor; redefining as a normal function: ~S" - name) - (proclaim-as-fun-name name)) ((not (eq (symbol-package name) (symbol-package 'aref))) (style-warn "defining setf macro for ~S when ~S is fbound" name `(setf ,name)))) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index b54e70e..234871d 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -2707,17 +2707,7 @@ initially undefined function references:~2%") (setf undefs (sort undefs #'string< :key #'fun-name-block-name)) (dolist (name undefs) - (format t "~S" name) - ;; FIXME: This ACCESSOR-FOR stuff should go away when the - ;; code has stabilized. (It's only here to help me - ;; categorize the flood of undefined functions caused by - ;; completely rewriting the bootstrap process. Hopefully any - ;; future maintainers will mostly have small numbers of - ;; undefined functions..) - (let ((accessor-for (info :function :accessor-for name))) - (when accessor-for - (format t " (accessor for ~S)" accessor-for))) - (format t "~%"))) + (format t "~S~%" name))) (format t "~%~|~%layout names:~2%") (collect ((stuff)) diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index f586c10..7c137a3 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -1135,14 +1135,6 @@ :type :ir1-transform :type-spec (or function null)) -;;; If a function is a slot accessor or setter, then this is the class -;;; that it accesses slots of. -(define-info-type - :class :function - :type :accessor-for - :type-spec (or sb!xc:class null) - :default nil) - ;;; If a function is "known" to the compiler, then this is a ;;; FUNCTION-INFO structure containing the info used to special-case ;;; compilation. diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp index 52be034..64bba8d 100644 --- a/src/compiler/info-functions.lisp +++ b/src/compiler/info-functions.lisp @@ -41,22 +41,12 @@ (check-fun-name name) (when (fboundp name) (ecase (info :function :kind name) - (:function - (let ((accessor-for (info :function :accessor-for name))) - (when accessor-for - (compiler-style-warning - "~@" - name - accessor-for) - (clear-info :function :accessor-for name)))) - (:macro + (:function) ; happy case + ((nil)) ; another happy case + (:macro ; maybe-not-so-good case (compiler-style-warning "~S was previously defined as a macro." name) (setf (info :function :where-from name) :assumed) - (clear-info :function :macro-function name)) - ((nil)))) + (clear-info :function :macro-function name)))) (setf (info :function :kind name) :function) (note-if-setf-function-and-macro name) name) @@ -89,7 +79,6 @@ (frob :where-from :assumed) (frob :inlinep) (frob :kind) - (frob :accessor-for) (frob :inline-expansion-designator) (frob :source-transform) (frob :assumed-type))) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index b61c8af..c36d9e1 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -129,22 +129,7 @@ :inlinep inlinep :where-from (info :function :where-from name) :type (info :function :type name)) - (let ((info (info :function :accessor-for name))) - (when info - (error "no expansion for ~S even though :ACCESSOR-FOR" - name)) - (etypecase info - (null - (find-free-really-function name)) - (sb!xc:structure-class - (find-structure-slot-accessor info name)) - (sb!xc:class - (if (typep (layout-info (info :type :compiler-layout - (sb!xc:class-name - info))) - 'defstruct-description) - (find-structure-slot-accessor info name) - (find-free-really-function name)))))))))))) + (find-free-really-function name)))))))) ;;; Return the LEAF structure for the lexically apparent function ;;; definition of NAME. diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp index 0a6e7e3..faef555 100644 --- a/src/compiler/proclaim.lisp +++ b/src/compiler/proclaim.lisp @@ -154,9 +154,8 @@ ;; definition yet, we know one is planned. (But if this ;; function name was already declared as a structure ;; accessor, then that was already been taken care of.) - (unless (info :function :accessor-for name) - (proclaim-as-fun-name name) - (note-name-defined name :function)) + (proclaim-as-fun-name name) + (note-name-defined name :function) ;; the actual type declaration (setf (info :function :type name) type diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp index 3dc0439..6febe33 100644 --- a/tests/interface.pure.lisp +++ b/tests/interface.pure.lisp @@ -49,9 +49,6 @@ ;; though, and I haven't figured out what does work ;; right. For now we just punt. (values)) - #+nil - ((sb-int:info :function :accessor-for ext-sym) - (values)) ((typep fun 'generic-function) (sb-pcl::generic-function-pretty-arglist fun)) (t diff --git a/version.lisp-expr b/version.lisp-expr index e776cb8..534e6c6 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.65" +"0.pre7.66" -- 1.7.10.4