Gwa*_*Kim 3 macros common-lisp
我试图用另一个lisp表达式包装一个lisp表达式.我想,一个宏应该这样做,但我没有得到诀窍.有人可以帮助我,谁知道怎么做?
我的实际目标是编写一个宏,它with-open-file
围绕一些宏体代码包装一批表达式.
(我想编写一个脚本/程序,它打开一个或两个输入文件,逐行处理它们,但也将处理结果输出到几个不同的独立输出文件中.为此,我希望将with-open-file
宏调用堆积起来处理和写入独立输出文件的代码 - 全部为宏体代码打开.
由于with-open-file
需要输入或输出流的符号(处理程序)和输出(或输入)文件的路径变量,以及一些附加信息(文件的方向等),我想将它们放入列表中.
;; 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)
Run Code Online (Sandbox Code Playgroud)
我多么希望被称为宏:
(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))
Run Code Online (Sandbox Code Playgroud)
宏调用应扩展到什么:
(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))))
Run Code Online (Sandbox Code Playgroud)
作为一步,我认为我必须使一个s表达式包装另一个s表达式.
我的第一个问题是:如何用另一个s表达式包装一个s表达式?但是我现在还不能管它.我所能做的只是编写一个函数,它只会溢出一个未执行的表达式.如何编写一个执行相同操作的宏,但在以这种方式扩展后执行代码?
(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)))
Run Code Online (Sandbox Code Playgroud)
这使:
(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)))
Run Code Online (Sandbox Code Playgroud)
通过这种方式,wrap
连续应用函数,循环输入列表,我可以构建代码...
但是,这些函数只生成代码但不执行它.并且我最终会被迫使用该eval
函数来评估构建的代码......(但不知怎的,我知道这不应该像这样做.而我只是不明白如何编写宏来做这样的事情......实际上,宏可以解决这些问题......)
随着执行,我刚遇到了大麻烦.而且由于人们无法调用funcall
或apply
使用宏(而不是函数名称),因此我没有看到明显的解决方案.有人有这种情况的经验吗?
当完成通过另一个s表达式在宏中包装s表达式并让它进行评估时,接下来的问题是,如何处理列表以使代码扩展到所需的代码然后进行评估?我只是试了几个小时,但没有走远.
我需要有经验的人帮助编写这样的宏...
请注意,在Lisp中,"handler"通常是一个函数,而不是一个符号.你的命名令人困惑.
如果要生成代码,则应使用宏,而不是函数.这假设您在编译时知道将使用哪些文件和流变量:
最简单的方法是使用递归:
(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)))
Run Code Online (Sandbox Code Playgroud)
测试:
(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))
Run Code Online (Sandbox Code Playgroud)
如果您在编译时不知道流和文件是什么,例如,它们存储在*handler*
变量中,则不能使用上面的简单宏 - 您必须使用自己
progv
的绑定进行绑定并
gensym
避免变量捕获.注意let
内部反引号如何避免多次评估(即参数streams
,file-names
并且options
要评估一次,而不是多次评估):
(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))))))
Run Code Online (Sandbox Code Playgroud)
这里,流变量和文件列表都在运行时进行评估.
这里一个重要的实际注意事项是静态版本更加健壮,因为它保证所有流都是关闭的,而动态版本将无法关闭剩余的流,例如,如果第一个close
引发异常(这可以修复,但它这不是微不足道的:我们不能仅仅ignore-errors
因为它们应该被报告,而应该报告哪个错误?&c&c).
另一个观察是,如果在编译时不知道您的流变量列表,body
那么使用它们的代码将无法正确编译(变量将使用动态绑定和c undefined-variable
编译)由编译时警告指示.
基本上,动态版本是宏观的练习,而静态版本是你应该在实践中使用的.
如果我理解你的要求,你可以做这样的事情(未经测试!):
(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))))))
Run Code Online (Sandbox Code Playgroud)