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 读取过程？如果是这样，怎么做？ （我很茫然。）

编辑：澄清空白：

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

(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 函数和普通的 read 签名相同，但是复制 readtable，然后安装宏函数，并调用 read。 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 "       ")