如何在阅读器宏中评估Lisp代码？

Question

我在Common Lisp中编写自己的x86-64汇编程序,它为x86-64的子集生成正确的二进制代码.我使用自定义阅读器宏将汇编代码转换为语法树,并按预期工作.

我试图完成的是允许在汇编代码中使用Lisp代码,这样我可以使用Lisp作为汇编程序的宏语言.我#a用作宏调度字符并#e为读者发出信号.内部读者#l更改为Lisp模式并#a返回到汇编模式#e(对于读取器宏的信号结束)应该在两种模式下都有效.

我不明白的是如何将评估代码的结果输出回输入流(在其余代码之前处理),或者如何再次读取Lisp代码输出,以便输出可以适当地处理Lisp代码(它将是汇编代码)(与汇编代码的其余部分相同).我怎样才能实现这一目标？

旁注:这是我的第一个读者宏,因此可能存在设计缺陷.我认为我将Lisp代码读入字符串的方法不一定是最好的方法,如果有一些更短和更惯用的方法来做到这一点.

这是我的阅读器宏的简化版本:

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun get-last-character-string (my-string)
    "This function returns a string consisting of the last character of the input string."
    (subseq my-string (1- (length my-string))))

  (defun get-string-without-last-character (my-string) 
    "This function returns a string without the last character of the input string."
    (subseq my-string 0 (1- (length my-string))))

  (defun get-string-without-invalid-last-character (my-string invalid-last-characters)
    "If the last character of the string is invalid, the string is returned without it, otherwise completely." 
    (loop for invalid-last-character in invalid-last-characters
          do (if (equal (get-last-character-string my-string) invalid-last-character)
               (setf my-string (get-string-without-last-character my-string))))
    my-string)

  (defun transform-code-to-string (stream sub-char numarg)
    "This function converts assembly code into a string.
     #l marks change to Lisp code. #a marks return to asm. #e marks end.
     Partially based on: http://weitz.de/macros.lisp"
    (declare (ignore sub-char numarg))
    (let*
      ((invalid-last-characters (list "'" " " "(" ")"))
       (current-mode "asm")
       (is-there-code-on-this-line nil)
       (current-phase "beginning-of-line")
       (my-string "(list ")
       (lisp-code-string ""))
      ;; loop through stream.
      (loop for my-char = (coerce (list (read-char stream t nil t)) 'string)
            do (cond
                 ((equal current-mode "asm")
                  (cond
                    ((equal current-phase "hash-sign-read")
                     ;; is character e ?
                     ;; if yes, we're done, fix closing parentheses and return.
                     (cond
                       ((equal my-char "e")
                        (return-from transform-code-to-string
                                     (concatenate 'string (get-string-without-invalid-last-character
                                                            (get-string-without-invalid-last-character
                                                              my-string invalid-last-characters)
                                                            invalid-last-characters) "))")))
                       ;; is character l ?
                       ;; if yes, change to Lisp mode.
                       ((equal my-char "l")
                        ;; could Lisp code could be read and evaluated here
                        ;; without reading it into a string?
                        (progn
                          (setf current-mode "Lisp") 
                          (setf is-there-code-on-this-line nil)
                          (setf lisp-code-string "")
                          (setf current-phase "beginning-of-line")))
                       ;; otherwise, print error.
                       (t (error "in asm mode undefined control character after #"))))
                    ;; is character # ?
                    ;; if yes, mark hash sign read.
                    ((equal my-char "#")
                     (setf current-phase "hash-sign-read"))
                    ;; is character newline?
                    ((equal my-char (coerce (list #\Newline) 'string))
                     (progn
                       (cond
                         ;; is there _no_ code on this line?
                         ;; if true, do not output anything.
                         ((not is-there-code-on-this-line)
                          (setf current-phase "beginning-of-line"))
                         ;; are we inside instruction or inside a parameter?
                         ;; if true, output ")
                         ((or (equal current-phase "inside-instruction")
                              (equal current-phase "inside-parameters"))
                          (progn
                            (setf current-phase "beginning-of-line")
                            (setf is-there-code-on-this-line nil)
                            (setf my-string (concatenate 'string my-string "\")"))))
                         ;; otherwise output )
                         (t (progn
                              (setf current-phase "beginning-of-line")
                              (setf is-there-code-on-this-line nil)
                              (setf my-string (concatenate 'string my-string ")")))))))
                    ;; are we inside a comment?
                    ;; if yes, don't output anything.
                    ((equal current-phase "inside-comment")
                     nil)
                    ;; are we in the beginning of the line?
                    ((equal current-phase "beginning-of-line")
                     (cond
                       ;; is this a space in the beginning of the line?
                       ;; if yes, do not output anything.
                       ((equal my-char " ")
                        nil)
                       ;; is this the first character of instruction and not ( or ) ?
                       ;; if yes, mark there is code on this line, mark first character as printed, output " and current character.
                       ((and
                          (not (equal my-char "("))
                          (not (equal my-char ")")))
                        (progn
                          (setf current-phase "inside-instruction")
                          (setf is-there-code-on-this-line t)
                          (setf my-string (concatenate 'string my-string "'(\"" my-char))))
                       (t nil)))
                    ;; is character ; ?
                    ;; if yes, don't output anything, begin comment.
                    ((equal my-char ";")
                     (setf current-phase "inside-comment"))
                    ;; is character space or comma?
                    ((or (equal my-char " ")
                         (equal my-char ","))
                     (cond
                       ;; is character space or comma, and last character was _not_ space, comma or opening parenthesis?
                       ;; if yes, output " and space.
                       ((and
                          (not (equal (get-last-character-string my-string) " "))
                          (not (equal (get-last-character-string my-string) ","))
                          (not (equal (get-last-character-string my-string) "(")))
                        (progn
                          (setf current-phase "in-space")
                          (setf my-string (concatenate 'string my-string "\" "))))
                       (t nil)))
                    ;; is instruction printed and this is the 1st character of a parameter?
                    ((and
                       (not (equal current-phase "inside-instruction"))
                       (or (equal (get-last-character-string my-string) " ")
                           (equal (get-last-character-string my-string) ",")))
                     (cond
                       ;; mark we're inside parameters, output " and current character.
                       (t (progn
                            (setf current-phase "inside-parameters")
                            (setf my-string (concatenate 'string my-string "\"" my-char))))))
                    ;; otherwise output the character.
                    (t (setf my-string (concatenate 'string my-string my-char)))))
                 ((equal current-mode "Lisp")
                  ;; in Lisp mode, read text until #e or #a is reached and eval it.
                  (cond
                    ((equal current-phase "hash-sign-read")
                     (cond
                       ;; is character e ?
                       ;; if yes, we're done, fix closing parentheses and return.
                       ((equal my-char "e")
                        (progn
                          (concatenate 'string "#a" (eval lisp-code-string) "#e") ; this should be something different.
                          (return-from transform-code-to-string
                                       (concatenate 'string (get-string-without-invalid-last-character
                                                              (get-string-without-invalid-last-character
                                                                my-string invalid-last-characters)
                                                              invalid-last-characters) "))"))))
                       ;; is character a ?
                       ;; if yes, change to asm mode.
                       ((equal my-char "a")
                        (progn
                          (setf current-mode "asm")
                          (setf is-there-code-on-this-line nil)
                          (setf current-phase "beginning-of-line")
                          (concatenate 'string "#a" (eval lisp-code-string) "#e") ; this should be something different.
                          ;; otherwise, add # and the character to the Lisp code to be evaluated.
                          (t (progn
                               (setf current-phase "")
                               (setf my-string (concatenate 'string lisp-code-string "#" my-char))))))
                       ;; is character # ?
                       ;; if yes, mark hash sign read.
                       ((equal my-char "#")
                        (setf current-phase "hash-sign-read"))
                       ;; otherwise add the character to the Lisp code to be evaluated.
                       (t (setf my-string (concatenate 'string lisp-code-string my-char)))))
                    (t (error "invalid current mode"))))))

      ;;; #a is the input which starts the custom reader.
      (set-dispatch-macro-character #\# #\a #'transform-code-to-string))

这里有一些没有Lisp代码的汇编代码,有效:

(defparameter *example-code-x64*
  #a
  inc r10     ; increment register r10.
  mov r11,r12 ; store value of r12 into r11.
  #e)

这里有一些里面有Lisp代码的汇编代码,失败了(请参阅下面的编译错误).在这一个中,Lisp代码在汇编代码之后,但是应该允许汇编和Lisp代码使用#a和#l作为分隔符自由混合.

(defparameter *example-code-x64-with-lisp-fails*
  #a
  inc r10     ; increment register r10.
  mov r11,r12 ; store value of r12 into r11.
  #l
  (loop for current-instruction in (list "inc" "dec")
        do (loop for current-arg in (list "r13" "r14" "r15")
                 do (princ (concatenate 'string
                                        current-instruction
                                        " "
                                        current-arg
                                        (coerce (list #\Newline) 'string)))))
  #e)

上面代码的Lisp部分应该在自定义阅读器中进行评估,这样它应该产生与下面代码相同的结果:

(defparameter *example-code-x64-with-lisp-fails*
  #a
  inc r10     ; increment register r10.
  mov r11,r12 ; store value of r12 into r11.
  inc r13
  inc r14
  inc r15
  dec r13
  dec r14
  dec r15
  #e)

但是编译失败了:

CL-USER> ; compiling file "/home/user/code/lisp/lisp-asm-reader-for-stackoverflow.lisp" (written 28 MAR 2014 10:11:29 PM):
; 
; caught ERROR:
;   READ error during COMPILE-FILE:
;   
;     The value -1 is not of type (MOD 4611686018427387901).
;   
;     (in form starting at line: 1, column: 0, file-position: 0)
; 
; compilation unit aborted
;   caught 1 fatal ERROR condition
;   caught 1 ERROR condition
; compilation aborted after 0:00:00.004

1 compiler notes:

/home/user/code/lisp/lisp-asm-reader-for-stackoverflow.lisp:10487
  read-error: READ error during COMPILE-FILE:

  The value -1 is not of type (MOD 4611686018427387901).

  (in form starting at line: 1, column: 0, file-position: 0)

CL-USER>

Answer 1

从读取器宏中读取lisp代码的惯用方法是调用cl:read.在您的示例中,在使用#L之后调用read将返回其car为循环的列表,并且该列表可以传递给eval.

要收集在eval期间创建的输出,可以绑定*standard-output*.因此,选择是在您的阅读器宏中使用类似于以下内容的内容:

(let ((lisp-printed-string
       (with-output-to-string (*standard-output*)
         (eval (read stream t t t)))))
  ;; concatenate the lisp printed string onto your 
  ;; hand parsed string here
  )

另一种方法是让用户输入一个返回字符串的lisp表单{eg(concatenate"bar""baz")},并收集eval的返回值而不是其打印输出.