macros - 试图重写一个丑陋的宏

Question

我是 lisp 的新手，一直在尝试通过深入研究和编写一些代码来学习 Common Lisp。我已经阅读了大量有关该主题的文档，但需要一段时间才能真正理解。

我已经编写了几个宏(? 和 ??)来执行单元测试，但我遇到了一些困难。代码在帖子的末尾，以避免混淆实际问题。

这是一个用法示例:

(??
  (? "Arithmetic tests"
    (? "Addition"
        (= (+ 1 2) 3)
        (= (+ 1 2 3) 6)
        (= (+ -1 -3) -4))))

以及一个输出示例:

[Arithmetic tests]
  [Addition]
    (PASS) '(= (+ 1 2) 3)'
    (PASS) '(= (+ 1 2 3) 6)'
    (PASS) '(= (+ -1 -3) -4)'

Results: 3 tests passed, 0 tests failed

现在，现有代码可以工作了。不幸的是，(? ...)宏是丑陋的、冗长的、难以改变的——而且我很确定它的结构也很糟糕。例如，我真的必须使用列表来存储输出代码片段，然后在最后发出内容吗？

我想修改宏以允许描述字符串(或符号)有选择地跟在每个测试之后，然后它将替换输出中的测试文字，因此:

(??
  (? "Arithmetic tests"
    (? "Addition"
        (= (+ 1 2) 3)    "Adding 1 and 2 results in 3"
        (= (+ 1 2 3) 6)
        (= (+ -1 -3) -4))))

输出:

[Arithmetic tests]
  [Addition]
    (PASS) Adding 1 and 2 results in 3
    (PASS) '(= (+ 1 2 3) 6)'
    (PASS) '(= (+ -1 -3) -4)'

但不幸的是，我无法在宏中找到一个合理的位置来插入此更改。根据我放置它的位置，我会收到类似 you're not inside a backquote expression 的错误, label is not defined或 body-forms is not defined .我知道这些错误的含义，但我找不到避免它们的方法。

另外，我会想要处理测试中的异常，并将其视为失败。目前，没有异常处理代码——测试结果只是针对 nil 进行测试。同样，不清楚我应该如何添加此功能。

我在想，也许这个宏太复杂了，因为我没有编写宏的经验；也许如果我简化它，修改会更容易。我真的不想在没有充分理由的情况下将它分成几个较小的宏；但也许有更简洁的写法？

谁能帮帮我，好吗？

完整的代码 list 如下:

(defmacro with-gensyms ((&rest names) &body body)
    `(let ,(loop for n in names collect `(,n (gensym)))
         ,@body))

(defmacro while (condition &body body)
    `(loop while ,condition do (progn ,@body)))

(defun flatten (L)
  "Converts a list to single level."
  (if (null L)
    nil
    (if (atom (first L))
      (cons (first L) (flatten (rest L)))
      (append (flatten (first L)) (flatten (rest L))))))

(defun starts-with-p (str1 str2)
  "Determine whether `str1` starts with `str2`"
  (let ((p (search str2 str1)))
    (and p (= 0 p))))

(defmacro pop-first-char (string)
    `(with-gensyms (c)
        (if (> (length ,string) 0)
            (progn
                (setf c (schar ,string 0))
                (if (> (length ,string) 1)
                    (setf ,string (subseq ,string 1))
                    (setf ,string ""))))
    c))

(defmacro pop-chars (string count)
    `(with-gensyms (result)
        (setf result ())
        (dotimes (index ,count)
            (push (pop-first-char ,string) result))
        result))

(defun format-ansi-codes (text)
    (let ((result ()))
        (while (> (length text) 0)
            (cond
                ((starts-with-p text "\\e")
                    (push (code-char #o33) result)
                    (pop-chars text 2)
                )
                ((starts-with-p text "\\r")
                    (push (code-char 13) result)
                    (pop-chars text 2)
                )
                (t (push (pop-first-char text) result))
        ))
        (setf result (nreverse result))
        (coerce result 'string)))

(defun kv-lookup (values key)
    "Like getf, but works with 'keys as well as :keys, in both the list and the supplied key"
    (setf key (if (typep key 'cons) (nth 1 key) key))
    (while values
        (let ((k (pop values)) (v (pop values)))
            (setf k (if (typep k 'cons) (nth 1 k) k))
            (if (eql (symbol-name key) (symbol-name k))
                (return v)))))

(defun make-ansi-escape (ansi-name)
    (let ((ansi-codes '( :normal "\\e[00m" :white "\\e[1;37m" :light-grey "\\e[0;37m" :dark-grey "\\e[1;30m"
                                    :red "\\e[0;31m" :light-red "\\e[1;31m" :green "\\e[0;32m" :blue "\\e[1;34m" :dark-blue "\\e[1;34m"
                                    :cyan "\\e[1;36m" :magenta "\\e[1;35m" :yellow "\\e[0;33m"
                                    :bg-dark-grey "\\e[100m"
                                    :bold "\\e[1m" :underline "\\e[4m"
                                    :start-of-line "\\r" :clear-line "\\e[2K" :move-up "\\e[1A")))
    (format-ansi-codes (kv-lookup ansi-codes ansi-name))
    ))

(defun format-ansi-escaped-arg (out-stream arg)
    (cond
        ((typep arg 'symbol) (format out-stream "~a" (make-ansi-escape arg)))
        ((typep arg 'string) (format out-stream arg))
        (t (format out-stream "~a" arg))
    ))

(defun format-ansi-escaped (out-stream &rest args)
    (while args
        (let ((arg (pop args)))
            (if (typep arg 'list)
                (let ((first-arg (eval (first arg))))
                    (format out-stream first-arg (second arg))
                )
                (format-ansi-escaped-arg out-stream arg)
        ))
    ))

(defmacro while-pop ((var sequence &optional result-form) &rest forms)
    (with-gensyms (seq)
        `(let (,var)
            (progn
                (do () ((not ,sequence))
                    (setf ,var (pop ,sequence))
                    (progn ,@forms))
                ,result-form))))

(defun report-start (form)
    (format t "(    ) '~a'~%" form))

(defun report-result (result form)
        (format-ansi-escaped t "(" (if result :green :red) `("~:[FAIL~;PASS~]" ,result) :normal `(") '~a'~%" ,form))
        result)

(defmacro ? (name &body body-forms)
    "Run any number of test forms, optionally nested within further (?) calls, and print the results of each test"
    (with-gensyms (result indent indent-string)
        (if (not body-forms)
            :empty
            (progn
                (setf result () indent 0 indent-string "  ")
                (cond
                    ((typep (first body-forms) 'integer)
                        (setf indent (pop body-forms))))
                `(progn
                    (format t "~v@{~A~:*~}" ,indent ,indent-string)
                    (format-ansi-escaped t "[" :white ,name :normal "]~%")
                    (with-gensyms (test-results)
                        (setf test-results ())
                        ,(while-pop (body-form body-forms `(progn ,@(nreverse result)))
                            (cond
                                ( (EQL (first body-form) '?)
                                    (push `(progn
                                        (setf test-results (append test-results (? ',(nth 1 body-form) ,(1+ indent) ,@(nthcdr 2 body-form))))
                                        (format t "~%")
                                        test-results
                                    ) result)
                                )
                                (t
                                    (push `(progn
                                        (format t "~v@{~A~:*~}" ,(1+ indent) ,indent-string)
                                        (report-start ',body-form)
                                        (with-gensyms (result label)
                                            (setf result ,body-form)
                                            (format-ansi-escaped t :move-up :start-of-line :clear-line)
                                            (format t "~v@{~A~:*~}" ,(1+ indent) ,indent-string)
                                            (push (report-result result ',body-form) test-results)
                                            test-results
                                    )) result))))))))))

(defun ?? (&rest results)
    "Run any number of tests, and print a summary afterward"
    (setf results (flatten results))
    (format-ansi-escaped t "~&" :white "Results: " :green `("~a test~:p passed" ,(count t results)) :normal ", "
        (if (find NIL results) :red :normal) `("~a test~:p failed" ,(count NIL results))
        :yellow `("~[~:;, ~:*~a test~:p not run~]" ,(count :skip results))
        :brown `("~[~:;, ~:*~a empty test group~:p skipped~]" ,(count :empty results))
        :normal "~%"))

Answer 1

就我而言，? 宏技术性很强，很难理解格式化函数背后的逻辑。因此，我不想跟踪错误，而是想提出我自己的尝试，也许它会有用。

我认为实际上您的 ?? 不想评估任何内容，而是将其主体视为单独的测试或部分。如果正文包含以 ? 开头的列表，则此列表代表一个部分；其他元素是测试形式，可选地后跟描述。所以在我的实现中 ?? 将是一个宏，而 ? 将只是一个符号。

我从一厢情愿的想法开始。我想我可以使用 make-test-item 函数创建单独的测试，并使用 make-test-section 函数创建测试部分(它们的实现目前并不重要)，即我可以使用辅助函数 display-test 显示它们，并使用函数 results 计算结果，该函数返回两个值:测试总数和通过的测试数。那我要代码

(??
  (? "Arithmetic tests"
     (? "Addition"
        (= (+ 1 2) 3) "Adding 1 and 2 results in 3"
        (= (+ 1 2 3) 6)
        (= (+ -1 -3) 4))
     (? "Subtraction"
        (= (- 1 2) 1)))
  (= (sin 0) 0) "Sine of 0 equals 0")

扩展成类似的东西

(let ((tests (list (make-test-section :header "Arithmetic tests"
                                      :items (list (make-test-section :header "Addition"
                                                                      :items (list (make-test-item :form '(= (+ 1 2) 3)
                                                                                                   :description "Adding 1 and 2 results in 3"
                                                                                                   :passp (= (+ 1 2) 3))
                                                                                   (make-test-item :form '(= (+ 1 2 3) 6)
                                                                                                   :passp (= (+ 1 2 3) 6))
                                                                                   (make-test-item :form '(= (+ -1 -3) 4)
                                                                                                   :passp (= (+ -1 -3) 4))))
                                                   (make-test-section :header "Subtraction"
                                                                      :items (list (make-test-item :form '(= (- 1 2) 1)
                                                                                                   :passp (= (- 1 2) 1))))))
                   (make-test-item :form '(= (sin 0) 0)
                                   :passp (= (sin 0) 0)
                                   :description "Sine of 0 equals 0"))))
  (loop for test in tests
        with total = 0
        with passed = 0
        do (display-test test 0 t)
        do (multiple-value-bind (ttl p) (results test)
             (incf total ttl)
             (incf passed p))
        finally (display-result total passed t)))

这里创建了一个测试列表；然后我们遍历它打印每个测试(0 表示缩进的零级别，t 与 format 中的一样)并跟踪结果，最后显示总结果。我认为这里不需要明确的 eval。

这可能不是有史以来最精美的一段代码，但它似乎易于管理。我在下面提供了缺少的定义，它们相当微不足道(并且可以改进)并且与宏无关。

现在我们转到宏。将两段代码都视为数据，那么我们需要一个列表处理函数，将第一段代码转换为第二段代码。一些辅助功能会派上用场。

主要任务是解析 ?? 的主体并生成要进入 let 的测试列表。

(defun test-item-form (form description)
  `(make-test-item :form ',form :description ,description :passp ,form))

(defun test-section-form (header items)
  `(make-test-section :header ,header :items (list ,@items)))

(defun parse-test (forms)
  (let (new-forms)
    (loop
      (when (null forms)
        (return (nreverse new-forms)))
      (let ((f (pop forms)))
        (cond ((and (listp f) (eq (first f) '?))
               (push (test-section-form (second f) (parse-test (nthcdr 2 f))) new-forms))
              ((stringp (first forms))
               (push (test-item-form f (pop forms)) new-forms))
              (t (push (test-item-form f nil) new-forms)))))))

这里的parse-test本质上吸收了??的语法。每次迭代消耗一个或两个表单并收集相应的 make-... 表单。这些函数可以在 REPL 中轻松测试(当然，我在编写时确实测试了它们)。

现在宏变得非常简单:

(defmacro ?? (&body body)
  `(let ((tests (list ,@(parse-test body))))
     (loop for test in tests
           with total = 0
           with passed = 0
           do (display-test test 0 t)
           do (multiple-value-bind (ttl p) (results test)
                (incf total ttl)
                (incf passed p))
           finally (display-result total passed t))))

它在变量 namespace 和函数一中捕获了一些符号(扩展可能包含 make-test-item 和 make-test-section ).使用 gensyms 的干净解决方案会很麻烦，所以我建议将所有定义移动到一个单独的包中并仅导出 ?? 和 ?。

为了完整起见，这里是测试 API 的实现。实际上，这就是我开始编写代码并继续进行的工作，直到我确保大型 let 形式有效；然后我转到宏观部分。这个实现相当草率；特别是，它不支持终端颜色，display-test 甚至无法将部分输出到字符串中。

(defstruct test-item form description passp)

(defstruct test-section header items)

(defun results (test)
  (etypecase test
    (test-item (if (test-item-passp test)
                   (values 1 1)
                   (values 1 0)))
    (test-section (let ((items-count 0)
                        (passed-count 0))
                    (dolist (i (test-section-items test) (values items-count passed-count))
                      (multiple-value-bind (i p) (results i)
                        (incf items-count i)
                        (incf passed-count p)))))))

(defparameter *test-indent* 2)

(defun display-test-item (i level stream)
  (format stream "~V,0T~:[(FAIL)~;(PASS)~] ~:['~S'~;~:*~A~]~%"
          (* level *test-indent*)
          (test-item-passp i)
          (test-item-description i)
          (test-item-form i)))

(defun display-test-section-header (s level stream)
  (format stream "~V,0T[~A]~%"
          (* level *test-indent*)
          (test-section-header s)))

(defun display-test (test level stream)
  (etypecase test
    (test-item (display-test-item test level stream))
    (test-section
      (display-test-section-header test level stream)
      (dolist (i (test-section-items test))
        (display-test i (1+ level) stream)))))

(defun display-result (total passed stream)
  (format stream "Results: ~D test~:P passed, ~D test~:P failed.~%" passed (- total passed)))

所有代码均在 WTFPL 下获得许可。