X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffdefinition.lisp;h=0b72f217b54455d1cbcbc9e209e6ea7040095a70;hb=b8f63d9b4e978bec3bfc1f4fc471e5ed946781fd;hp=1c720c5374f2854c630396f4929b708406cddbc2;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp
index 1c720c5..0b72f21 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
@@ -120,25 +117,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 +149,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)