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

后端 未结 1 815
旧巷少年郎
旧巷少年郎 2021-01-20 04:13

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?

1条回答
  •  离开以前
    2021-01-20 04:53

    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))))))
    

    0 讨论(0)
提交回复
热议问题