Reputation: 47
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?
Upvotes: 2
Views: 143
Reputation: 4360
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))))
Upvotes: 1
Reputation: 114481
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)))))
Upvotes: 6