控制特殊形式的打印（例如打印（函数+）作为#'+等）

Question

我希望一些阅读器宏打印为宏理解的缩短表达式。假设我想扩展 #' 宏以采用 #'~[rest-of-symbol] 并将其转换为（补充#'rest-of-symbol）。

什么控制着它的打印方式？例如，在 SBCL 上，'(function +) 打印为 #'+。我如何使'（补充#'listp）打印为#~listp？

我的第一个想法是

(defmethod print-object :around ((obj cons) stream)
  ;; if #'~fn-name / (complement (function fn-name))
  ;; => fn-name otherwise NIL  
  (let ((fn-name
         (ignore-errors
           (destructuring-bind (complement (function fn-name)) 
               obj
             (when (and (eq complement 'complement)
                        (eq function   'function))
               fn-name)))))
    (if fn-name
        (format stream "#'~~~S" fn-name)
      (call-next-method))))

只要

(print-object '(complement #'evenp) *standard-output*)

以我想要的方式打印它，它就可以工作，但 REPL 不会。

(print-object '#'+ *standard-output*)

也将其打印为 (function +)，因此 REPL 不使用打印对象。通过为用户定义的类定义 print-object 方法，REPL 总是选择新的定义。

这是我的第一篇文章，很抱歉我无法正确格式化代码。如果有人可以提供有关如何操作的链接，我将不胜感激。

Answer 1

要做到这一点，您需要了解漂亮的打印机。以前理解过，现在不完全理解了。它根据类型进行调度，像这样的技巧是你可以为conses树指定非常具体的类型，尽管这样做很冗长。

这是一个几乎可以肯定不完全正确的例子，但在这种情况下确实达到了你想要的效果：

(defparameter *ppd* (copy-pprint-dispatch))

(defun pprint-complement-function (s form)
  ;; This is the thing that the pretty printer will call.  It can
  ;; assume that the form it wants to print is already correct.
  (destructuring-bind (complement (function name)) form
    (declare (ignore complement function))
    (format s "#'~~~W" name)))

;;; Now set this in the table with a suitable hairy type specification
;;;
(set-pprint-dispatch '(cons (eql complement)
                            (cons (cons (eql function)
                                        (cons t null))
                                  null))
                     'pprint-complement-function
                     0
                     *ppd*)

现在

> (let ((*print-pprint-dispatch* *ppd*))
    (pprint '(complement (function foo)))
    (pprint '((complement (function foo)) (function foo))))

#'~foo
(#'~foo #'foo)

Answer 2

评价时间

您在示例中将代码与数据混合：

(function +)

是一种计算为函数对象的特殊形式，它允许更短的语法：

#'+

但是当你写作时：

'(function +)

或

'(complement fn)

然后在这两种情况下，您都在编写引用的文字列表，这些列表会自行评估（即以符号

function

或

complement

开头的列表，后跟符号

+

和

fn

）。

但是，您希望代码在运行时被评估为实际的函数对象；如果你在 REPL 中输入：

(complement #'alpha-char-p)

结果是一个值，打印如下：

#<FUNCTION (LAMBDA (&REST SB-IMPL::ARGUMENTS) :IN COMPLEMENT) {101AAC8D9B}>

你有一个实际的函数对象，你可以

funcall

。换句话说，当你到达

print-object

时，你无法再访问源代码，你正在运行时操作数据，而这恰好是函数。因此，您不能使用

destructuring-bind

来获取源代码中存在的

complement

符号。

您需要做的是将元数据附加到您的函数。多亏了元对象协议，在 Common Lisp 中有一种方法可以通过定义一种新型函数来做到这一点。

可调用对象

我依赖 Closer-MOP 来获取下面以

c2cl:

为前缀的所有符号。我定义了一个新的类，

annotated-fn

，它是一个带有附加数据的函数：

(defclass annotated-fn (c2cl:funcallable-standard-object) 
  ((data :initform :data :initarg :data :reader annotated-fn-data))
  (:metaclass c2cl:funcallable-standard-class))

注意这个类是一个

funcallable-standard-object

（就像通常的函数），它的元类是

funcallable-standard-class

。这样的对象有一个额外的隐式插槽，它是一个要调用的函数。

更准确地说，您必须调用

c2cl:set-funcallable-instance-function

来设置与对象关联的函数，稍后当您对对象使用

funcall

或

apply

时，将调用包装函数。所以你可以在你平时使用函数的地方透明地使用这个类的函数。它只是有额外的插槽（这里

data

）。

例如，这是我实例化它的方式，带有包装函数和附加数据：

(defun annotate-fn (function data)
  (let ((object (make-instance 'annotated-fn :data data)))
    (prog1 object
      (c2cl:set-funcallable-instance-function object function))))

来试试看：

(describe
 (annotate-fn (constantly 3)
              '(:category :constantly)))

#<ANNOTATED-FN {1006275C7B}>
  [funcallable-instance]


Lambda-list: UNKNOWN
Derived type: FUNCTION
Documentation:
  T
Source file: SYS:SRC;CODE;FUNUTILS.LISP

Slots with :INSTANCE allocation:
  DATA                           = (:CATEGORY :CONSTANTLY)

您也可以像使用任何其他函数一样使用此对象。

现在，您的阅读器宏可以扩展为对

annotate-fn

的调用，并向该函数添加您需要的任何类型的额外元数据。

漂亮的印刷

让我们定义一个通用函数，在给定其

:category

字段的情况下打印带注释的函数：

(defgeneric print-for-category (category data object stream))

(defmethod print-object ((o annotated-fn) s)
  (let* ((data (annotated-fn-data o))
         (category (getf data :category)))
    (print-for-category category data o s)))

然后，我们可以将它专门化为

:constantly

，这里我们还假设与函数关联的数据包含一个

:constant

字段：

(defmethod print-for-category ((_ (eql :constantly)) data o s)
  (format s "#[~s]" (getf data :constant)))

例如：

(let ((value (+ 8 6)))
  (annotate-fn (constantly value)
               `(:constant ,value
                 :category :constantly)))

以上打印为：

#[14]

这与您假设的阅读器宏相同。