Setting function symbols lexically

Question

I'm looking for a way to easily, temporarily swap functions out. I know that I can manually set a function symbol like so:

CL-USER> (setf (symbol-function 'abcd) #'+)
#<FUNCTION +>
CL-USER> (abcd 1 2 4)
7

I also know that labels or flet can temporarily set names for functions defined in place:

CL-USER> (labels ((abcd (&rest x) 
                    (apply #'* x)))
            (abcd 1 2 4))
8

Is there a way to manually, lexically set a function name? Eg.:

CL-USER> (some-variant-of-labels-or-let ((abcd #'*))
            (abcd 1 2 4))
8

Note: I tried poking into the source of labels and flet, but both are special operators. No joy.

Answer 1

The bindings that you can modify with symbol-function aren't lexical bindings, so that sort of option doesn't really apply. The only way to establish lexically bound functions is through labels and flet, so you'll have to use those. That said, you can get kind of syntax you want pretty easily with a macro:

(defmacro bind-functions (binder bindings body)
  `(,binder ,(mapcar (lambda (binding)
                       (destructuring-bind (name function) binding
                         `(,name (&rest #1=#:args)
                                 (apply ,function #1#))))
                     bindings)
            ,@body))

(defmacro fflet ((&rest bindings) &body body)
  `(bind-functions flet ,bindings ,body))

(defmacro flabels ((&rest bindings) &body body)
  `(bind-functions labels ,bindings ,body))

Both fflet and flabels take function designators (a symbol or a function) and call apply with them and any additional arguments. Thus you could use #'* or '+.

(fflet ((product #'*)
        (sum '+))
  (list (product 2 4)
        (sum 3 4)))
;=> (8 7)

This does mean that you're introducing the overhead of apply, but it's not clear what you could do to avoid it. Since lambda expressions could refer to the bound names, we could either allow those references to be to the newly bound function, or to whatever is outside. This is the difference between flet and labels, as well, and that's why implemented versions based on each:

(fflet ((double (lambda (x)
                  (format t "~&outer ~a" x)
                  (list x x))))
  (fflet ((double (lambda (x)
                    (format t "~&inner ~a" x)
                    (double x))))                           ; not recursive
    (double 2)))
; inner 2
; outer 2
;=> 2 2

(flabels ((factorial (lambda (n &optional (acc 1))
                       (if (zerop n) acc
                           (factorial (1- n) (* acc n)))))) ; recursive
  (factorial 7))
;=> 5040  

---

Alternatives

After mulling over this for a while, it occurred to me that in Scheme, fflet is the same as let, since Scheme is a Lisp-1. To get the behavior of flabels, you have to use letrec in Scheme. Searching for implementations of letrec for Common Lisp turns up some interesting results.

Robert Smith's Letrec for Common Lisp includes this description and example:

LETREC:LETREC is a macro which aims to imitate Scheme's letrec form. It is a useful construct for functional programming in Common Lisp, where you have function-producing forms which need to be functionally bound to a symbol.

  (defun multiplier (n)
    (lambda (x) (* n x)))

  (letrec ((double (multiplier 2))
           (triple (multiplier 3)))
    (double (triple 5)))
  ;= 30

This has the same issue with apply, of course, and the notes include

Unforunately, the macro isn't a very efficient implementation. There is a level of indirection with the function calling. Essentially, a LETREC with the binding

(name fn)

is expanded to a LABELS binding of the form

(name (&rest args)
  (apply fn args))

which is somewhat abysmal.

Patches are welcome for implementation-specific ways of implementing the macro.

In 2005, user rhat asked on comp.lang.lisp about a Common Lisp equivalent to Scheme's letrec, and was pointed at labels.

Answer 2

You can set synonymous name for a globally defined function with symbol-function:

CL-USER> (setf (symbol-function 'factorial) #'!)
#<SYSTEM-FUNCTION !>
CL-USER> (factorial 5)
120

The problem with this is that you get it permanently and globally. But you can remove the definition with fmakunbound:

CL-USER> (fmakunbound 'factorial)
FACTORIAL
CL-USER> (factorial 5) ; now here is no such function
; Evaluation aborted on #<SYSTEM::SIMPLE-UNDEFINED-FUNCTION #x19F36199>.
CL-USER> (! 5) ; still works
120

I would like to propose this macro, based on said functions:

(defmacro with-synonyms (params &body body)
  `(prog2 (setf ,@(mapcan (lambda (x)
                            `((symbol-function ',(car x)) #',(cadr x)))
                          params))
     (progn ,@body)
     ,@(mapcar (lambda (x) `(fmakunbound ',(car x)))
               params)))

It works as you want:

CL-USER> (with-synonyms ((product *) (sum +))
           (product 2 (sum 2 3)))
10

Macroexpansion:

(PROG2 (SETF (SYMBOL-FUNCTION 'PRODUCT) #'*
             (SYMBOL-FUNCTION 'SUM)     #'+)
  (PROGN (PRODUCT 2 (SUM 2 3)))
  (FMAKUNBOUND 'PRODUCT)
  (FMAKUNBOUND 'SUM))

Outside of the macro body there are no such functions as product or sum.

NOTE: These synonymous functions are still defined globally (for short time, though), so this solution is not ideal.

---

P.S. Actually (setf symbol-function) is very-very evil thing.

CL-USER> (setf (symbol-function 'normal-plus) #'+)
#<SYSTEM-FUNCTION +>
CL-USER> (defun magic-plus (&rest rest)
           (if (every (lambda (x) (= 2 x)) rest)
               5
               (apply 'normal-plus rest)))
MAGIC-PLUS
CL-USER> (setf (symbol-function '+) #'magic-plus)
#<FUNCTION MAGIC-PLUS (&REST REST) (DECLARE (SYSTEM::IN-DEFUN MAGIC-PLUS))
  (BLOCK MAGIC-PLUS (IF (EVERY (LAMBDA (X) (= 2 X)) REST) 5
(APPLY 'NORMAL-PLUS REST)))>
CL-USER> (+ 2 3)
5
CL-USER> (+ 5 5)
10
CL-USER> (+ 2 2)
5