X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcode%2Ffdefinition.lisp;h=607b8bba86df8471452a741cecd1abdbb56e7d46;hb=3b45a7b66afe95080562d266dd447b1286abece0;hp=1c720c5374f2854c630396f4929b708406cddbc2;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp
index 1c720c5..607b8bb 100644
--- a/src/code/fdefinition.lisp
+++ b/src/code/fdefinition.lisp
@@ -14,9 +14,6 @@
 
 (in-package "SB!IMPL")
 
-(file-comment
-  "$Header$")
-
 (sb!int::/show0 "fdefinition.lisp 22")
 
 ;;;; fdefinition (fdefn) objects
@@ -58,13 +55,7 @@
   "Return the fdefn object for NAME. If it doesn't already exist and CREATE
    is non-NIL, create a new (unbound) one."
   (declare (values (or fdefn null)))
-  (unless (or (symbolp name)
-	      (and (consp name)
-		   (eq (car name) 'setf)
-		   (let ((cdr (cdr name)))
-		     (and (consp cdr)
-			  (symbolp (car cdr))
-			  (null (cdr cdr))))))
+  (unless (legal-function-name-p name)
     (error 'simple-type-error
 	   :datum name
 	   :expected-type '(or symbol list)
@@ -120,25 +111,28 @@
 ;;;      back to the symbol which was used to indirect into the function,
 ;;;      so the undefined function handler can base its complaint on that.
 ;;;
-;;; Another problem with doing the simple thing: people will want to indirect
-;;; through something in order to get to SETF functions, in order to be able to
-;;; redefine them. What will they indirect through? This could be done with a
-;;; hack, making an anonymous symbol and linking it to the main symbol's
-;;; SB!KERNEL:SETF-FUNCTION property. The anonymous symbol could even point
-;;; back to the symbol it's the SETF function for, so that if the SETF function
-;;; was undefined at the time a call was made, the debugger could say which
-;;; function caused the problem. It'd probably be cleaner, though, to use a new
-;;; type of primitive object (SYMBOLOID?) instead. It could probably be like
-;;; symbol except that its name could be any object and its value points back
-;;; to the symbol which owns it. Then the setf functions for FOO could be on
-;;; the list (GET FOO 'SB!KERNEL:SYMBOLOIDS)
+;;; Another problem with doing the simple thing: people will want to
+;;; indirect through something in order to get to SETF functions, in
+;;; order to be able to redefine them. What will they indirect
+;;; through? This could be done with a hack, making an anonymous
+;;; symbol and linking it to the main symbol's SB!KERNEL:SETF-FUNCTION
+;;; property. The anonymous symbol could even point back to the symbol
+;;; it's the SETF function for, so that if the SETF function was
+;;; undefined at the time a call was made, the debugger could say
+;;; which function caused the problem. It'd probably be cleaner,
+;;; though, to use a new type of primitive object (SYMBOLOID?)
+;;; instead. It could probably be like symbol except that its name
+;;; could be any object and its value points back to the symbol which
+;;; owns it. Then the setf functions for FOO could be on the list (GET
+;;; FOO 'SB!KERNEL:SYMBOLOIDS)
 ;;;
-;;; FIXME: Oh, my. Now that I've started thinking about it, I appreciate more
-;;; fully how weird and twisted FDEFNs might be. Look at the calling sequence
-;;; for full calls. It goes and reads the address of a function object from its
-;;; own table of immediate values, then jumps into that. Consider how weird
-;;; that is. Not only is it not doing indirection through a symbol (which I'd
-;;; already realized) but it's not doing indirection through
+;;; FIXME: Oh, my. Now that I've started thinking about it, I
+;;; appreciate more fully how weird and twisted FDEFNs might be. Look
+;;; at the calling sequence for full calls. It goes and reads the
+;;; address of a function object from its own table of immediate
+;;; values, then jumps into that. Consider how weird that is. Not only
+;;; is it not doing indirection through a symbol (which I'd already
+;;; realized) but it's not doing indirection through
 
 ;;; The compiler emits calls to this when someone tries to funcall a symbol.
 (defun %coerce-name-to-function (name)
@@ -149,6 +143,11 @@
     (or (and fdefn (fdefn-function fdefn))
 	(error 'undefined-function :name name))))
 
+(defun %coerce-callable-to-function (callable)
+  (if (functionp callable)
+      callable
+      (%coerce-name-to-function callable)))
+
 ;;; This is just another name for %COERCE-NAME-TO-FUNCTION.
 #!-sb-fluid (declaim (inline raw-definition))
 (defun raw-definition (name)
@@ -170,7 +169,8 @@
 ;;;; definition encapsulation
 
 (defstruct (encapsulation-info (:constructor make-encapsulation-info
-					     (type definition)))
+					     (type definition))
+			       (:copier nil))
   ;; This is definition's encapsulation type. The encapsulated
   ;; definition is in the previous encapsulation-info element or
   ;; installed as the global definition of some function name.
@@ -341,7 +341,7 @@
 
 (defun fmakunbound (name)
   #!+sb-doc
-  "Make Name have no global function definition."
+  "Make NAME have no global function definition."
   (let ((fdefn (fdefinition-object name nil)))
     (when fdefn
       (fdefn-makunbound fdefn)))