X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffdefinition.lisp;h=59ca173532865ce091fe65306917db1b1322fbce;hb=bfe145acc01eb7a43790173db4f08610ae9cb07a;hp=364e7e947651d6ba69351ad67c919e5824ff8eac;hpb=cd71fa005a6168cf9c79eca38459210bdd9a6c4b;p=sbcl.git diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp index 364e7e9..59ca173 100644 --- a/src/code/fdefinition.lisp +++ b/src/code/fdefinition.lisp @@ -54,12 +54,7 @@ ;;; CREATE is non-NIL, create a new (unbound) one. (defun fdefinition-object (name create) (declare (values (or fdefn null))) - (unless (legal-fun-name-p name) - (error 'simple-type-error - :datum name - :expected-type '(or symbol list) - :format-control "invalid function name: ~S" - :format-arguments (list name))) + (legal-fun-name-or-type-error name) (let ((fdefn (info :function :definition name))) (if (and (null fdefn) create) (setf (info :function :definition name) (make-fdefn name)) @@ -88,7 +83,7 @@ (type definition)) (:copier nil)) ;; This is definition's encapsulation type. The encapsulated - ;; definition is in the previous encapsulation-info element or + ;; definition is in the previous ENCAPSULATION-INFO element or ;; installed as the global definition of some function name. type ;; the previous, encapsulated definition. This used to be installed @@ -97,8 +92,8 @@ (definition nil :type function)) ;;; Replace the definition of NAME with a function that binds NAME's -;;; arguments a variable named argument-list, binds name's definition -;;; to a variable named basic-definition, and evaluates BODY in that +;;; arguments to a variable named ARG-LIST, binds name's definition +;;; to a variable named BASIC-DEFINITION, and evaluates BODY in that ;;; context. TYPE is whatever you would like to associate with this ;;; encapsulation for identification in case you need multiple ;;; encapsulations of the same name. @@ -117,8 +112,8 @@ ;; an encapsulation that no longer exists. (let ((info (make-encapsulation-info type (fdefn-fun fdefn)))) (setf (fdefn-fun fdefn) - (lambda (&rest argument-list) - (declare (special argument-list)) + (named-lambda encapsulation (&rest arg-list) + (declare (special arg-list)) (let ((basic-definition (encapsulation-info-definition info))) (declare (special basic-definition)) (eval body))))))) @@ -126,6 +121,7 @@ ;;; This is like FIND-IF, except that we do it on a compiled closure's ;;; environment. (defun find-if-in-closure (test fun) + (declare (type function test)) (dotimes (index (1- (get-closure-length fun))) (let ((elt (%closure-index-ref fun index))) (when (funcall test elt) @@ -139,7 +135,7 @@ ;;; When removing an encapsulation, we must remember that ;;; encapsulating definitions close over a reference to the -;;; encapsulation-info that describes the encapsulating definition. +;;; ENCAPSULATION-INFO that describes the encapsulating definition. ;;; When you find an info with the target type, the previous info in ;;; the chain has the ensulating definition of that type. We take the ;;; encapsulated definition from the info with the target type, and we @@ -224,40 +220,42 @@ This is SETF'able." (let ((fun (%coerce-name-to-fun name))) (loop - (let ((encap-info (encapsulation-info fun))) - (if encap-info - (setf fun (encapsulation-info-definition encap-info)) - (return fun)))))) + (let ((encap-info (encapsulation-info fun))) + (if encap-info + (setf fun (encapsulation-info-definition encap-info)) + (return fun)))))) (defvar *setf-fdefinition-hook* nil #!+sb-doc - "This holds functions that (SETF FDEFINITION) invokes before storing the - new value. These functions take the function name and the new value.") + "A list of functions that (SETF FDEFINITION) invokes before storing the + new value. The functions take the function name and the new value.") (defun %set-fdefinition (name new-value) #!+sb-doc "Set NAME's global function definition." (declare (type function new-value) (optimize (safety 1))) - (let ((fdefn (fdefinition-object name t))) - ;; *SETF-FDEFINITION-HOOK* won't be bound when initially running - ;; top level forms in the kernel core startup. - (when (boundp '*setf-fdefinition-hook*) - (dolist (f *setf-fdefinition-hook*) - (funcall f name new-value))) - - (let ((encap-info (encapsulation-info (fdefn-fun fdefn)))) - (cond (encap-info - (loop - (let ((more-info - (encapsulation-info - (encapsulation-info-definition encap-info)))) - (if more-info - (setf encap-info more-info) - (return - (setf (encapsulation-info-definition encap-info) - new-value)))))) - (t - (setf (fdefn-fun fdefn) new-value)))))) + (with-single-package-locked-error (:symbol name "setting fdefinition of ~A") + (let ((fdefn (fdefinition-object name t))) + ;; *SETF-FDEFINITION-HOOK* won't be bound when initially running + ;; top level forms in the kernel core startup. + (when (boundp '*setf-fdefinition-hook*) + (dolist (f *setf-fdefinition-hook*) + (declare (type function f)) + (funcall f name new-value))) + + (let ((encap-info (encapsulation-info (fdefn-fun fdefn)))) + (cond (encap-info + (loop + (let ((more-info + (encapsulation-info + (encapsulation-info-definition encap-info)))) + (if more-info + (setf encap-info more-info) + (return + (setf (encapsulation-info-definition encap-info) + new-value)))))) + (t + (setf (fdefn-fun fdefn) new-value))))))) ;;;; FBOUNDP and FMAKUNBOUND @@ -270,8 +268,10 @@ (defun fmakunbound (name) #!+sb-doc "Make NAME have no global function definition." - (let ((fdefn (fdefinition-object name nil))) - (when fdefn - (fdefn-makunbound fdefn))) - (sb!kernel:undefine-fun-name name) - name) + (with-single-package-locked-error + (:symbol name "removing the function or macro definition of ~A") + (let ((fdefn (fdefinition-object name nil))) + (when fdefn + (fdefn-makunbound fdefn))) + (sb!kernel:undefine-fun-name name) + name))