How to wrap and execute a lisp s-expression by another s-expression? - macros

Question

I tried to wrap a lisp expression by another lisp expression. I guess, a macro should do it, but I don't get the trick. Can someone help me, who knows how to do it?
My actual aim is to write a macro which wraps a batch of with-open-file expressions around some macro-body code.
(I want to write a script/program, which opens one or two input files, process them line by line, but also outputs the processing result in several different independent output files. For that I would love to have the with-open-file macro calls piled up around the code which processes and writes to the independent output files - all opened for the macro-body code).
Since the with-open-file requires a symbol (handler) for the input or output stream and the path variable to the output (or input) file, and some additional information (direction of the file etc.), I want to put them into lists.
;; Output file-paths:
(defparameter *paths* '("~/out1.lisp" "~/out2.lisp" "~/out3.lisp"))
;; stream handlers (symbols for the output streams)
(defparameter *handlers* '(out1 out2 out3))
;; code which I would love to execute in the body
(print "something1" out1)
(print "something2" out2)
(print "something3" out3)
How I would love the macro to be called:
(with-open-files (*handlers* *paths* '(:direction :output :if-exists :append))
;; the third macro argument should be what should be passed to the
;; individual `with-open-file` calls
;; and it might be without `quote`-ing or with `quote`-ing
;; - is there by the way a good-practice for such cases? -
;; - is it recommended to have `quote`-ing? Or how would you do that? -
;; and then follows the code which should be in the macro body:
(print "something1" out1)
(print "something2" out2)
(print "something3" out3))
To what the macro call should expand:
(with-open-file (out1 "~/out1.lisp" :direction :output :if-exists :append)
(with-open-file (out2 "~/out2.lisp" :direction :output :if-exists :append)
(with-open-file (out3 "~/out3.lisp" :direction :output :if-exists :append)
(print "something1" out1)
(print "something2" out2)
(print "something3" out3))))
As one step, I thought I have to make an s-expression wrap another s-expression.
My first question was: How to wrap an s-expression by another s-expression? But I just couldn't manage it already at this point.
All I could do was to write a function which just spills out an un-executed expression. How to write a macro which does the same but also executes the code after expanding it in this way?
(defun wrap (s-expr-1 s-expr-2)
(append s-expr-1 (list s-expr-2)))
(wrap '(func1 arg1) '(func2 arg2))
;; => (FUNC1 ARG1 (FUNC2 ARG2))
(wrap '(with-open-files (out1 "~/out1.lisp" :direction :output :if-exists :append))
'(with-open-files (out2 "~/out2.lisp" :direction :output :if-exists :append)
(print "something1" out1)
(print "something2" out2)
(print "something3" out3)))
Which gives:
(WITH-OPEN-FILES (OUT1 "~/out1.lisp" :DIRECTION :OUTPUT :IF-EXISTS :APPEND)
(WITH-OPEN-FILES (OUT2 "~/out2.lisp" :DIRECTION :OUTPUT :IF-EXISTS :APPEND)
(PRINT "something1" OUT1)
(PRINT "something2" OUT2)
(PRINT "something3" OUT3)))
In this way, applying wrap function successively, looping over the input-lists, I could build the code maybe ...
However, these functions would generate only code but don't execute it.
And I would be forced at the end to use the eval function to evaluate the built code ... (But somehow I know this shouldn't be done like this. And I just didn't really understood how to write macros which do such things ... Actually, macros are there for solving exactly such problems ... )
With the execution, I just came into big trouble. And since one cannot call funcall or apply on macros (instead of function-names) I don't see an obvious solution. Did someone had experience with such kind of situations?
And when accomplished wrapping an s-expression in a macro by another s-expression and let it be evaluated, the next question would be, how to process the list to let the code to expand to the desired code and then be evaluated? I just tried hours and didn't came far.
I need help from someone who has experience to write such kind of macros ...

Answer 1

Please note that in Lisp, "handler" is normally a function, not a symbol. Your naming is confusing.
Static
If you are generating code, you should use macros, not functions.
This assumes that you know at compile time what files and stream
variable you will use:
The simplest approach is to use recursion:
(defmacro with-open-files ((streams file-names &rest options &key &allow-other-keys) &body body)
(if (and streams file-names)
`(with-open-file (,(pop streams) ,(pop file-names) ,#options)
(with-open-files (,streams ,file-names ,#options)
,#body))
`(progn ,#body)))
Test:
(macroexpand-1
'(with-open-files ((a b c) ("f" "g" "h") :direction :output :if-exists :supersede)
(print "a" a)
(print "b" b)
(print "c" c)))
==>
(WITH-OPEN-FILE (A "f" :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
(WITH-OPEN-FILES ((B C) ("g" "h") :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
(PRINT "a" A) (PRINT "b" B) (PRINT "c" C)))
(macroexpand-1
'(with-open-files ((a) ("f") :direction :output :if-exists :supersede)
(print "a" a)))
==>
(WITH-OPEN-FILE (A "f" :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
(WITH-OPEN-FILES (NIL NIL :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
(PRINT "a" A)))
(macroexpand-1
'(with-open-files (nil nil :direction :output :if-exists :supersede)
(print nil)))
==>
(PROGN (PRINT NIL))
Dynamic
If you do not know at compile time what the streams and files are, e.g.,
they are stored in the *handler* variable, you cannot use the simple
macro above - you will have to roll your own using
progv for binding and
gensym to avoid variable
capture. Note how the let inside backtick avoids multiple
evaluation (i.e., arguments streams, file-names and options are to
be evaluated once, not multiple times):
(defmacro with-open-files-d ((streams file-names &rest options &key &allow-other-keys) &body body)
(let ((sv (gensym "STREAM-VARIABLES-"))
(so (gensym "STREAM-OBJECTS-"))
(ab (gensym "ABORT-"))
(op (gensym "OPTIONS-")))
`(let* ((,sv ,streams)
(,ab t)
(,op (list ,#options))
(,so (mapcar (lambda (fn) (apply #'open fn ,op)) ,file-names)))
(progv ,sv ,so
(unwind-protect (multiple-value-prog1 (progn ,#body) (setq ,ab nil))
(dolist (s ,so)
(when s
(close s :abort ,ab))))))))
(macroexpand-1
'(with-open-files-d ('(a b c) '("f" "g" "h") :direction :output :if-exists :supersede)
(print "a" a)
(print "b" b)
(print "c" c)))
==>
(LET* ((#:STREAM-VARIABLES-372 '(A B C))
(#:ABORT-374 T)
(#:OPTIONS-375 (LIST :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE))
(#:STREAM-OBJECTS-373
(MAPCAR (LAMBDA (FN) (APPLY #'OPEN FN #:OPTIONS-375)) '("f" "g" "h"))))
(PROGV
#:STREAM-VARIABLES-372
#:STREAM-OBJECTS-373
(UNWIND-PROTECT
(MULTIPLE-VALUE-PROG1 (PROGN (PRINT "a" A) (PRINT "b" B) (PRINT "c" C))
(SETQ #:ABORT-374 NIL))
(DOLIST (S #:STREAM-OBJECTS-373)
(WHEN S
(CLOSE S :ABORT #:ABORT-374))))))
Here both stream variables and file list are evaluated at run time.
Important
An important practical note here is that the static version is more robust in that it guarantees that all streams are closed, while the dynamic version will fail to close remaining streams if, say, the first close raises an exception (this can be fixed, but it is not trivial: we cannot just ignore-errors because they should in fact be reported, but which error should be reported? &c &c).
Another observation is that if your list of stream variables is not known at compile time, the code in the body that uses them will not be compiled correctly (the variables will be compiled with dynamic binding &c) indicated by undefined-variable compile-time warnings.
Basically, the dynamic version is an exercise in macrology, while the static version is what you should use in practice.
Your specific case
If I understood your requirements correctly, you can do something like
this (untested!):
(defun process-A-line (line stream)
do something with line,
stream is an open output stream)
(defun process-file (input-file processors)
"Read input-file line by line, calling processors,
which is a list of lists (handler destination ...):
handler is a function like process-A-line,
destination is a file name and the rest is open options."
(with-open-file (inf input-file)
(let ((proc-fd (mapcar (lambda (p)
(cons (first p)
(apply #'open (rest p))))
processors))
(abort-p t))
(unwind-protect
(loop for line = (read-line inf nil nil)
while line
do (dolist (p-f proc-fd)
(funcall (car p-f) line (cdr p-f)))
finally (setq abort-p nil))
(dolist (p-f proc-fd)
(close (cdr p-f) :abort abort-p))))))