From: Douglas K. <sn...@us...> - 2014-04-19 21:18:01
|
The branch "master" has been updated in SBCL: via 189dd8be262c6abddd9c85d67aa1dfbe0efcdc8d (commit) from c6909a95b6f67412d28c2ae3443a092ef2f074cb (commit) - Log ----------------------------------------------------------------- commit 189dd8be262c6abddd9c85d67aa1dfbe0efcdc8d Author: Douglas Katzman <do...@go...> Date: Sat Apr 19 17:12:30 2014 -0400 Rename SYMBOL-FDEFINITION to SYMBOL-FDEFN and similarly INFO-VECTOR- This is to avoid a false connotation that SYMBOL-FDEFINITION is just FDEFINITION but restricted to symbols (which would be SYMBOL-FUNCTION) --- package-data-list.lisp-expr | 6 ++-- src/code/fdefinition.lisp | 50 ++++++++++++++++----------------- src/code/fop.lisp | 4 +- src/code/symbol.lisp | 2 +- src/compiler/generic/target-core.lisp | 2 +- src/compiler/info-vector.lisp | 6 ++-- tests/info.impure.lisp | 8 ++-- 7 files changed, 38 insertions(+), 40 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index fc1e353..1c4c83b 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -949,12 +949,12 @@ possibly temporarily, because it might be used internally." "+FDEFN-TYPE-NUM+" "CLEAR-INFO" "DEFINE-INFO-TYPE" - "FIND-FDEFINITION" + "FIND-FDEFN" "GET-INFO-VALUE-INITIALIZING" "INFO" "INFO-FIND-AUX-KEY/PACKED" "INFO-GETHASH" - "INFO-VECTOR-FDEFINITION" + "INFO-VECTOR-FDEFN" "MAKE-INFO-ENVIRONMENT" "PACKED-INFO-FIELD" "UPDATE-SYMBOL-INFO" @@ -1526,7 +1526,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "FDOCUMENTATION" "FILENAME" "FIND-AND-INIT-OR-CHECK-LAYOUT" "FIND-DEFSTRUCT-DESCRIPTION" - "FIND-OR-CREATE-FDEFINITION" + "FIND-OR-CREATE-FDEFN" "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS" "FLOAT-FORMAT-NAME" "FLOAT-FORMAT-MAX" "FLOAT-INT-EXPONENT" diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp index 22e8f37..244001e 100644 --- a/src/code/fdefinition.lisp +++ b/src/code/fdefinition.lisp @@ -54,22 +54,21 @@ ;; Signal an error if name isn't valid. ;; Assume that exists-p implies LEGAL-FUN-NAME-P. ;; -(declaim (ftype (sfunction ((or symbol list)) (or fdefn null)) - find-fdefinition)) -(defun find-fdefinition (name0) +(declaim (ftype (sfunction ((or symbol list)) (or fdefn null)) find-fdefn)) +(defun find-fdefn (name0) ;; Since this emulates GET-INFO-VALUE, we have to uncross the name. (let ((name (uncross name0))) (declare (optimize (safety 0))) (when (symbolp name) ; Don't need LEGAL-FUN-NAME-P check - (return-from find-fdefinition (sb!impl::symbol-fdefinition name))) + (return-from find-fdefn (symbol-fdefn name))) ;; Technically the ALLOW-ATOM argument of NIL isn't needed, but ;; the compiler isn't figuring out not to test SYMBOLP twice in a row. (with-globaldb-name (key1 key2 nil) name :hairy - ;; INFO-GETHASH returns NIL or a vector. INFO-VECTOR-FDEFINITION accepts + ;; INFO-GETHASH returns NIL or a vector. INFO-VECTOR-FDEFN accepts ;; either. If fdefn isn't found, fall through to the legality test. - (awhen (info-vector-fdefinition (info-gethash name *info-environment*)) - (return-from find-fdefinition it)) + (awhen (info-vector-fdefn (info-gethash name *info-environment*)) + (return-from find-fdefn it)) :simple (progn (awhen (symbol-info-vector key1) @@ -84,17 +83,16 @@ (setq field-idx 0 descriptor-idx (1+ descriptor-idx))) (when (eql (packed-info-field it descriptor-idx field-idx) +fdefn-type-num+) - (return-from find-fdefinition + (return-from find-fdefn (aref it (1- (the index data-idx)))))))) (when (eq key1 'setf) ; bypass the legality test - (return-from find-fdefinition nil)))) + (return-from find-fdefn nil)))) (legal-fun-name-or-type-error name))) -(declaim (ftype (sfunction (t) fdefn) find-or-create-fdefinition)) -(defun find-or-create-fdefinition (name) - (or (find-fdefinition name) - ;; If the name was not legal, FIND-FDEFINITION signals an error, - ;; so there is no additional pre-creation check. +(declaim (ftype (sfunction (t) fdefn) find-or-create-fdefn)) +(defun find-or-create-fdefn (name) + (or (find-fdefn name) + ;; We won't reach here if the name was not legal (let ((name (uncross name))) (get-info-value-initializing :function :definition name (make-fdefn name))))) @@ -115,18 +113,18 @@ ;;; something. SETFable. #!-sb-fluid (declaim (inline %coerce-name-to-fun)) (defun %coerce-name-to-fun (name) - (!coerce-name-to-fun find-fdefinition name)) + (!coerce-name-to-fun find-fdefn name)) (defun (setf %coerce-name-to-fun) (function name) (maybe-clobber-ftype name) - (let ((fdefn (find-or-create-fdefinition name))) + (let ((fdefn (find-or-create-fdefn name))) (setf (fdefn-fun fdefn) function))) -#!-sb-fluid (declaim (inline symbol-fdefinition)) +#!-sb-fluid (declaim (inline symbol-fdefn)) ;; Return SYMBOL's fdefinition, if any, or NIL. SYMBOL must already ;; have been verified to be a symbol by the caller. -(defun symbol-fdefinition (symbol) +(defun symbol-fdefn (symbol) (declare (optimize (safety 0))) - (sb!c::info-vector-fdefinition (symbol-info-vector (uncross symbol)))) + (info-vector-fdefn (symbol-info-vector (uncross symbol)))) ;; CALLABLE is a function-designator, not an extended-function-designator, ;; i.e. it is a function or symbol, and not a generalized function name. @@ -136,7 +134,7 @@ (defun %coerce-callable-to-fun (callable) (etypecase callable (function callable) - (symbol (!coerce-name-to-fun symbol-fdefinition callable)))) + (symbol (!coerce-name-to-fun symbol-fdefn callable)))) ;;;; definition encapsulation @@ -159,7 +157,7 @@ ;;; encapsulation for identification in case you need multiple ;;; encapsulations of the same name. (defun encapsulate (name type function) - (let ((fdefn (find-fdefinition name))) + (let ((fdefn (find-fdefn name))) (unless (and fdefn (fdefn-fun fdefn)) (error 'undefined-function :name name)) (when (typep (fdefn-fun fdefn) 'generic-function) @@ -207,7 +205,7 @@ (defun unencapsulate (name type) #!+sb-doc "Removes NAME's most recent encapsulation of the specified TYPE." - (let* ((fdefn (find-fdefinition name)) + (let* ((fdefn (find-fdefn name)) (encap-info (encapsulation-info (fdefn-fun fdefn)))) (declare (type (or encapsulation-info null) encap-info)) (when (and fdefn (typep (fdefn-fun fdefn) 'generic-function)) @@ -238,7 +236,7 @@ ;;; Does NAME have an encapsulation of the given TYPE? (defun encapsulated-p (name type) - (let ((fdefn (find-fdefinition name))) + (let ((fdefn (find-fdefn name))) (when (and fdefn (typep (fdefn-fun fdefn) 'generic-function)) (return-from encapsulated-p (encapsulated-generic-function-p (fdefn-fun fdefn) type))) @@ -319,7 +317,7 @@ ;; FIXME: This is a good hook to have, but we should probably ;; reserve it for users. - (let ((fdefn (find-or-create-fdefinition name))) + (let ((fdefn (find-or-create-fdefn name))) ;; *SETF-FDEFINITION-HOOK* won't be bound when initially running ;; top level forms in the kernel core startup. (when (boundp '*setf-fdefinition-hook*) @@ -346,7 +344,7 @@ (defun fboundp (name) #!+sb-doc "Return true if name has a global function definition." - (let ((fdefn (find-fdefinition name))) + (let ((fdefn (find-fdefn name))) (and fdefn (fdefn-fun fdefn) t))) (defun fmakunbound (name) @@ -354,7 +352,7 @@ "Make NAME have no global function definition." (with-single-package-locked-error (:symbol name "removing the function or macro definition of ~A") - (let ((fdefn (find-fdefinition name))) + (let ((fdefn (find-fdefn name))) (when fdefn (fdefn-makunbound fdefn))) (undefine-fun-name name) diff --git a/src/code/fop.lisp b/src/code/fop.lisp index 90fb645..e0c2d1c 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -550,8 +550,8 @@ (define-fop (fop-small-code 59 :stackp nil) (load-code (read-byte-arg) (read-halfword-arg))) -(define-fop (fop-fdefinition 60) - (find-or-create-fdefinition (pop-stack))) +(define-fop (fop-fdefinition 60) ; should probably be 'fop-fdefn' + (find-or-create-fdefn (pop-stack))) (define-fop (fop-known-fun 65) (%coerce-name-to-fun (pop-stack))) diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp index afe606a..575723a 100644 --- a/src/code/symbol.lisp +++ b/src/code/symbol.lisp @@ -80,7 +80,7 @@ distinct from the global value. Can also be SETF." (defun symbol-function (symbol) #!+sb-doc "Return SYMBOL's current function definition. Settable with SETF." - (!coerce-name-to-fun symbol-fdefinition symbol)) + (!coerce-name-to-fun symbol-fdefn symbol)) (defun (setf symbol-function) (new-value symbol) (declare (type symbol symbol) (type function new-value)) diff --git a/src/compiler/generic/target-core.lisp b/src/compiler/generic/target-core.lisp index 43046a1..32e9ed8 100644 --- a/src/compiler/generic/target-core.lisp +++ b/src/compiler/generic/target-core.lisp @@ -111,7 +111,7 @@ (reference-core-fun code-obj index (cdr const) object)) (:fdefinition (setf (code-header-ref code-obj index) - (find-or-create-fdefinition (cdr const)))) + (find-or-create-fdefn (cdr const)))) (:known-fun (setf (code-header-ref code-obj index) (%coerce-name-to-fun (cdr const))))))))))) diff --git a/src/compiler/info-vector.lisp b/src/compiler/info-vector.lisp index e7a713b..915a88c 100644 --- a/src/compiler/info-vector.lisp +++ b/src/compiler/info-vector.lisp @@ -503,7 +503,7 @@ (defconstant-eqx +nil-packed-infos+ #(0) #'equalp) ;; FDEFINITIONs have a type-number that admits slightly clever logic -;; for INFO-VECTOR-FDEFINITION. Do not change this constant without +;; for INFO-VECTOR-FDEFN. Do not change this constant without ;; careful examination of that function. (defconstant +fdefn-type-num+ info-type-mask) @@ -1046,8 +1046,8 @@ This is interpreted as ;; Given Info-Vector VECT, return the fdefn that it contains for its root name, ;; or nil if there is no value. NIL input is acceptable and will return NIL. -(declaim (inline info-vector-fdefinition)) -(defun info-vector-fdefinition (vect) +(declaim (inline info-vector-fdefn)) +(defun info-vector-fdefn (vect) (when vect ;; This is safe: Info-Vector invariant requires that it have length >= 1. (let ((word (the fixnum (svref vect 0)))) diff --git a/tests/info.impure.lisp b/tests/info.impure.lisp index cefb167..180677e 100644 --- a/tests/info.impure.lisp +++ b/tests/info.impure.lisp @@ -136,11 +136,11 @@ (test-util:with-test (:name :globaldb-info-iterate) (show-info '*)) -(test-util:with-test (:name :find-fdefinition-agreement) - ;; Shows that GET-INFO-VALUE agrees with FIND-FDEFINITION on all symbols, +(test-util:with-test (:name :find-fdefn-agreement) + ;; Shows that GET-INFO-VALUE agrees with FIND-FDEFN on all symbols, ;; since they use diffent code. Something would have crashed long before here... (flet ((try (x) - (assert (eq (find-fdefinition x) (info :function :definition x))))) + (assert (eq (find-fdefn x) (info :function :definition x))))) (do-all-symbols (s) (try s) (try `(setf ,s)) @@ -448,7 +448,7 @@ (let ((result (make-array (length names) :initial-element nil))) (dotimes (iter 3) (loop for i below (length names) - do (pushnew (find-fdefinition (aref names i)) (aref result i)))) + do (pushnew (find-fdefn (aref names i)) (aref result i)))) ;; The thread shall observe either nil or an fdefn, and at most one fdefn. (loop for list across result for i from 0 ----------------------------------------------------------------------- hooks/post-receive -- SBCL |