lisp - Lisp 读取过程可以读取这个吗？如何读取？

Question

我正在编写一个我打算在 Lisp 读取过程中实现的语法，即一次从可变的输入源读取一个表达式。大多数语法就像 Lisp，但两个相关的变化是:

空格被读取并且是结果语法的一部分。连续的空白被组合在一起，就像连续的非空白字符被分组为标识符一样，读取这样一个字符串的结果是一个“空白对象”，它存储了读取的字符的确切序列。当空白对象出现在列表中时，求值器会忽略它们(换句话说，如果 foo 是空白对象，则 (eval '(+ 3 foo 4)) 等同于 (eval '( + 3 4))), 如果要求直接评价一个，就是自评价。

其次，如果除空白标记外的多个标记出现在同一行，则将这些标记收集到一个列表中，该列表就是读取的结果。

例如，

+ 3 4 5
(+ 3 4 5)
+ 3 4 (+ 1 4)
(+ 3 4 (+ 1 4))

全部产生值 12。

是否有可能将此读取器实现为遵循读取过程的典型期望的 Lisp 读取过程？如果是这样，如何？ (我不知所措。)

编辑:对空格的澄清:

如果我们说“空白对象”只是一个字符串并读取，那么读取以下片段:

(foo bar   baz)

生成如下语法对象:

'(foo " " bar "   " baz)

换句话说，标记之间的空格存储在生成的语法对象中。

假设我写了一个名为 -> 的宏，它接受一个语法对象(方案样式宏)，而 whitespace? 是一个标识空白语法对象的谓词

(define-macro (-> stx)
  (let* ((stxl (syntax-object->list stx))
         (obj (car stxl))
     (let proc ((res empty))
                (lst (cdr stxl)))
       (let ((method (car lst)))
          (if (whitespace? method)
              ; skip whitespace, recur immediately
              (proc res (cdr lst))
              ; Insert obj as the second element in method
              (let ((modified-method (cons (car method)
                                           (cons obj (cdr method)))))
                ; recur
                (proc (cons res modified-method) (cdr lst))))))))

Answer 1

本文的阅读部分非常简单。您只需要一个空白测试，然后您的读取函数将安装一个自定义读取器字符宏，该宏检测空白并将连续的空白序列读取到单个对象中。首先，空白测试和一个空白对象；这些非常简单:

(defparameter *whitespace*
  #(#\space #\tab #\return #\newline)
  "A vector of whitespace characters.")

(defun whitespace-p (char)
  "Returns true if CHAR is in *WHITESPACE*."
  (find char *whitespace* :test 'char=))

(defstruct whitespace-object
  characters)

现在宏字符函数:

(defun whitespace-macro-char (stream char)
  "A macro character function that consumes characters from
stream (including CHAR), until a non-whitespace character (or end of
file) is encountered.  Returns a whitespace-object whose characters
slot contains a string of the whitespace characters."
  (let ((chars (loop for c = (peek-char nil stream nil #\a)
                  while (whitespace-p c)
                  collect (read-char stream))))
    (make-whitespace-object
     :characters (coerce (list* char chars) 'string))))

现在读取函数只是具有与普通读取相同的签名，但复制可读表，然后安装宏函数，并调用读取。返回read的结果，恢复readtable:

(defun xread (&optional (stream *standard-input*) (eof-error-p t) eof-value recursive-p)
  "Like READ, but called with *READTABLE* bound to a readtable in
which each whitespace characters (that is, each character in
*WHITESPACE*) is a macro characters whose macro function is
WHITESPACE-MACRO-CHAR."
  (let ((rt (copy-readtable)))
    (map nil (lambda (wchar)
               (set-macro-character wchar #'whitespace-macro-char))
         *whitespace*)
    (unwind-protect (read stream eof-error-p eof-value recursive-p)
      (setf *readtable* rt))))

例子:

(with-input-from-string (in "(+ 1    2  (* 3    
                                         4))")
  (xread in))

(+ #S(WHITESPACE-OBJECT :CHARACTERS " ") 1
   #S(WHITESPACE-OBJECT :CHARACTERS "    ") 2
   #S(WHITESPACE-OBJECT :CHARACTERS "  ")
   (* #S(WHITESPACE-OBJECT :CHARACTERS " ") 3
      #S(WHITESPACE-OBJECT
         :CHARACTERS "  
                                         ")
      4))

现在，要实现您想要的 eval 对应项，您需要能够从列表中删除空白对象。这并不难，我们可以编写一个稍微更通用的实用函数来为我们完成它:

(defun remove-element-if (predicate tree)
  "Returns a new tree like TREE, but which contains no elements in an
element position which ssatisfy PREDICATE.  An element is in element
position if it is the car of some cons cell in TREE."
  (if (not (consp tree))
      tree
      (if (funcall predicate (car tree))
          (remove-element-if predicate (cdr tree))
          (cons (remove-element-if predicate (car tree))
                (remove-element-if predicate (cdr tree))))))

CL-USER> (remove-element-if (lambda (x) (and (numberp x) (evenp x))) '(+ 1 2 3 4))
(+ 1 3)

CL-USER> (with-input-from-string (in "(+ 1  2 (* 3
                                                 4))")
           (remove-element-if 'whitespace-object-p (xread in)))
(+ 1 2 (* 3 4))

现在求值函数是eval的简单包装:

(defun xeval (form)
  (eval (remove-element-if 'whitespace-object-p form)))

CL-USER> (with-input-from-string (in "(+ 1  2 (* 3
                                                 4))")
           (xeval (xread in)))
15

让我们确保独立的空白对象仍然按预期显示:

CL-USER> (with-input-from-string (in "       ")
           (let* ((exp (xread in))
                  (val (xeval exp)))
             (values exp val)))
#S(WHITESPACE-OBJECT :CHARACTERS "       ")
#S(WHITESPACE-OBJECT :CHARACTERS "       ")