X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffdefinition.lisp;h=5e1fab5d2e1dcffb095460c5afbf37034f5a470f;hb=148e3820ad314a9b59d0133c1d60eaac4af9118b;hp=c7305fcfd1b0096ffd28cd859b23e4b0cee06aa3;hpb=b6aa15328871678a3475e82c150b251dffb49ba1;p=sbcl.git diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp index c7305fc..5e1fab5 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)) @@ -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)) + (lambda (&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) @@ -224,25 +220,26 @@ 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. + ;; *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)))) @@ -273,4 +270,5 @@ (let ((fdefn (fdefinition-object name nil))) (when fdefn (fdefn-makunbound fdefn))) + (sb!kernel:undefine-fun-name name) name)