Common Lisp macro let-curry - not working

Question

I found myself calling lots of methods whose first argument is a complex object from a given class. Whilst with-slots and with-accessors are useful, generic methods cannot be bound in this way. So I thought: if we could locally curry any functions, slots + accessors + generic functions + functions could all be addressed with the same construct.

Example of code I want to clean up:

(defun clox-string (scanner)
  "Parse string into a token and add it to tokens"
  (loop while (and (char/= #\" (peek scanner))
                   (not (at-end-p scanner)))
        do
           (if (char= #\Newline (peek scanner)) (incf (line scanner))
               (advance scanner)))
  (when (at-end-p scanner)
    (clox.error::clox-error (line scanner) "Unterminated string.")
    (return-from clox-string nil))
  (advance scanner) ;; consume closing "
  (add-token scanner 'STRING (subseq (source scanner)
                                     (1+ (start scanner))
                                     (1- (current scanner)))))

This would be cleaner (I'm imitating this in CL https://craftinginterpreters.com/scanning.html#reserved-words-and-identifiers but I often end up with more verbose and less readable code than in Java - specially when using this classes a lot). As in CL methods don't belong to classes you end up declaring such arguments over and over. This would be a bit better:

(defun clox-string (scanner)
  "Parse string into a token and add it to tokens"
  (let-curry scanner (peek at-end-p line source start current advance add-token)
   (loop while (and (char/= #\" (peek))
                    (not (at-end-p)))
         do
            (if (char= #\Newline (peek)) (incf (line))
                (advance)))
   (when (at-end-p)
     (clox.error::clox-error (line) "Unterminated string.")
     (return-from clox-string nil))
   (advance) ;; consume closing "
   (add-token 'STRING (subseq (source)
                              (1+ (start))
                              (1- (current)))))

sketch of macro (not working):

;; Clearly not as I don't understand macros very well :) non-working code:
(defmacro let-curry (obj functions &body body)
  "Locally curry all functions"
  (let ((fn (gensym)))
    `(flet (loop
             for ,fn in ,functions
             collect (list ,fn (&rest args)
                           (funcall ,fn ,obj args))) 
       ,@body)))

EDIT (ADD): Notice that scanner is a class; start, source, line, etc., accessors to the slots with the same name; add-token a generic function of more than one argument, advance a generic method of one argument:

(defclass scanner ()
  ((source
    :initarg :source
    :accessor source)
   ...
   (...)))

(defmethod advance ((scanner scanner)) ...)
(defmethod add-token ((scanner scanner) token-type) ...)

---

Simpler Example with error:

;; With 
(defun add (x y) (+ x y))

(defun mul (x y) (* x y))

;; I want to have this:
(let-curry 1000 (add mul)
  (print (add 3))
  (print (mul 3)))


;; expanding to:
(flet ((add (y) (add 1000 y))
       (mul (y) (mul 1000 y)))
  (print (add 3))
  (print (mul 3)))

;; but instead I'm getting:
Execution of a form compiled with errors.
Form:
  (FLET (LOOP
       FOR
       #1=#:G777
       IN
       (ADD MUL
         )
       COLLECT
       (LIST #1#
         (&REST ARGS)
         (FUNCALL #1# 1000 ARGS)))
  (PRINT (ADD 3))
  (PRINT (MUL 3)))
Compile-time error:
  The FLET definition spec LOOP is malformed.
   [Condition of type SB-INT:COMPILED-PROGRAM-ERROR]

Thanks! The basic question is: is it possible to make such macro work?

Answer 1

Your version didn't expand to what you wanted but:

(flet (loop for #:g8307 in (add mul) collect (list #:g8307 (&rest args) (funcall #:g8307 1000 args))) 
  (print (add 3)) (print (mul 3)))

Now the loop needs to be done at macro expansion time. Here is a working version:

(defmacro let-curry (obj (&rest functions) &body body)
  "Locally curry all functions"
  `(flet ,(loop for fn in functions
                collect `(,fn (&rest args)
                            (apply #',fn ,obj args))) 
     ,@body))

;; test it using add and mul from OP
(macroexpand-1 '(let-curry 10 (add mul) (list (add 5) (mul 5))))
;; ==> 
(flet ((add (&rest args) (apply #'add 10 args)) 
       (mul (&rest args) (apply #'mul 10 args))) 
  (list (add 5) (mul 5)))

(let-curry 10 (add mul) (list (add 5) (mul 5)))
;; ==> (15 50)

• Using gensym is only needed if you are in danger of shadowing/colliding something or to ensure evaluation order is least surprising, but in your case you actually want to shadow the original names with the curried version so it makes sense to just use the original name.
• If you want to have more than one argument you should use apply
• since you know the function is in the function namespace you need to call #'symbol instead of symbol.
• I've done (&rest functions) instead of functions in the prototype that with bad usage (not a list) you get a compile time error and it is more preciese.