2
votes

I write a macro that accepts a list of lambdas to be called and generates a function. The lambdas are always evaluated in defun argument list, but not in defmacro. How can I avoid call to eval inside defmacro?

This code works:

(defmacro defactor (name &rest fns)
  (let ((actors (gensym)))
    `(let (;(,actors ',fns)
           (,actors (loop for actor in ',fns
                          collect (eval actor)))) ; This eval I want to avoid
       (mapcar #'(lambda (x) (format t "Actor (type ~a): [~a]~&" (type-of x) x)) ,actors)
       (defun ,name (in out &optional (pos 0))
         (assert (stringp in))
         (assert (streamp out))
         (assert (or (plusp pos) (zerop pos)))
         (loop for actor in ,actors
               when (funcall actor in out pos)
               return it)))))

;; Not-so-relevant use of defactor macros
(defactor invert-case
    #'(lambda (str out pos)
        (let ((ch (char str pos)))
          (when (upper-case-p ch)
            (format out "~a" (char-downcase ch))
            (1+ pos))))
  #'(lambda (str out pos)
      (let ((ch (char str pos)))
        (when (lower-case-p ch)
          (format out "~a" (char-upcase ch))
          (1+ pos)))))

This code evaluates as expected to:

Actor (type FUNCTION): [#<FUNCTION (LAMBDA (STR OUT POS)) {100400221B}>]
Actor (type FUNCTION): [#<FUNCTION (LAMBDA (STR OUT POS)) {100400246B}>]
INVERT-CASE

And its usage is:

;; Complete example
(defun process-line (str &rest actors)
  (assert (stringp str))
  (with-output-to-string (out)
    (loop for pos = 0 then (if success success (1+ pos))
          for len = (length str)
          for success = (loop for actor in actors
                              for ln = len
                              for result = (if (< pos len)
                                               (funcall actor str out pos)
                                               nil)
                              when result return it)
          while (< pos len)
          unless success do (format out "~a" (char str pos)))))

(process-line "InVeRt CaSe" #'invert-case) ; evaluates to "iNvErT cAsE" as expected

Without eval, the defactor above evaluates to:

Actor (type CONS): [#'(LAMBDA (STR OUT POS)
                        (LET ((CH (CHAR STR POS)))
                          (WHEN (UPPER-CASE-P CH)
                            (FORMAT OUT ~a (CHAR-DOWNCASE CH))
                            (1+ POS))))]
Actor (type CONS): [#'(LAMBDA (STR OUT POS)
                        (LET ((CH (CHAR STR POS)))
                          (WHEN (LOWER-CASE-P CH)
                            (FORMAT OUT ~a (CHAR-UPCASE CH))
                            (1+ POS))))]

and all the rest obviously doesn't work.

If I transform defmacro into defun, it doesn't need eval:

(defun defactor (name &rest fns)
  (defun name (in out &optional (pos 0))
    (assert (stringp in))
    (assert (streamp out))
    (assert (or (plusp pos) (zerop pos)))
    (loop for actor in fns
          when (funcall actor in out pos)
          return it)))

However, it always defines the function name instead of the passed function name argument (which should be quoted).

Is it possible to write defactor with the possibility to pass the function name unlike defun version, and without eval in macro version of it?

2
You can just replace the loop with (list ,@fns).jkiiski
@jkiiski, unfortunately this doesn't work: ; The LET binding spec (MAPCAR ; #'(LAMBDA (X) ; (FORMAT T "Actor (type ~a): [~a]~&" (TYPE-OF X) X)) ; #:G647) is malformed.Alexandru Popa
That sounds like you're missing a closing parenthesis for the let bindings, so it's taking the following MAPCAR form as a binding too.jkiiski
After commenting out format, same error: ; The LET binding spec (DEFUN INVERT-CASE (IN OUT &OPTIONAL (POS 0)) ... is malformed.Alexandru Popa
What does it do? Looks extremely complicated for the simple example.Rainer Joswig

2 Answers

6
votes

You're making things more complex than necessary with the first loop... just collect the parameters instead

(defmacro defactor (name &rest fns)
  (let ((actors (gensym)))
    `(let ((,actors (list ,@fns)))
       (mapcar #'(lambda (x) (format t "Actor (type ~a): [~a]~&" (type-of x) x)) ,actors)
       (defun ,name (in out &optional (pos 0))
         (assert (stringp in))
         (assert (streamp out))
         (assert (or (plusp pos) (zerop pos)))
         (loop for actor in ,actors
               when (funcall actor in out pos)
               return it)))))
1
votes

This mostly doesn’t need to be a macro as-is. You can mostly use a helper function:

(defun make-actor (&rest funs)
  (lambda (in out &optional (pos 0)
    (loop for actor in funs
      when (funcall actor in out pos) return it)))

And write a simple macro:

(defmacro defactor (name &rest funs)
  `(let ((f (make-actor ,@funs)))
      (defun ,name (in out &optional (pos 0)) (funcall f in out pos))))

However this doesn’t gain much in terms of expressivity (you practically call the macro like a function) or efficiency (the compiler has to be quite clever to work out how to improve the code by inclining a bunch of complicated things).


Here is another way one might implement something like this:

(defmacro defactor (name (in out pos) &rest actors)
  (let ((inv (gensym "IN"))
        (outv (gensym "OUT"))
        (posv (gensym "POS")))
    `(defun ,name (,inv ,outv &optional (,posv 0))
        ;; TODO: (declare (type ...) ...)
        (or ,@(loop for form in actors 
                 collect `(let ((,in ,inv) (,out ,outv) (,pos ,posv)) ,form)))))

And then use it like:

(defactor invert-case (in out pos)
  (let ((ch (char str pos)))
    (when (upper-case-p ch)
      (format out "~a" (char-downcase ch))
      (1+ pos)))
  (let ((ch (char str pos)))
    (when (lower-case-p ch)
      (format out "~a" (char-upcase ch))
      (1+ pos))))