乍听之下,不无道理;仔细揣摩,胡说八道

0%

在 Lisp 中使用 reader macro 支持 JSON 语法

什么是 reader macro?

Reader macro 是 Common Lisp 提供的众多有趣特性之一,它让语言的使用者能够自定义词法分析的逻辑,使其在读取源代码时,如果遇到了特定的一两个字符,可以调用相应的函数来个性化处理。此处所说的“特定的一两个字符”,被称为 macro character,而“相应的函数”则被称为 reader macro function。举个例子,单引号'就是一个 macro character,可以用函数get-macro-character来获取它对应的 reader macro function。

1
2
3
CL-USER> (get-macro-character #\')
#<FUNCTION SB-IMPL::READ-QUOTE>
NIL

借助单引号,可以简化一些代码的写法,例如表达一个符号HELLO本身可以写成这样。

1
2
CL-USER> 'hello
HELLO

而不是下面这种等价但更繁琐的形式。

1
2
CL-USER> (quote hello)
HELLO

Common Lisp 中还定义了由两个字符构成的 reader macro,例如用于书写simple-vector字面量的#(。借助它,如果想要表达一个依次由数字 1、2、3 构成的simple-vector类型的对象,不需要显式地调用函数vector并传给它 1、2、3,而是可以写成#(1 2 3)

支持 JSON 语法后有什么效果?

合法的 JSON 文本不一定是合法的 Common Lisp 源代码。例如,[1, 2, 3]在 JSON 标准看来是一个由数字 1、2、3 组成的数组,但在 Common Lisp 中,这段代码会触发 condition。(condition 就是 Common Lisp 中的“异常”、“出状况”了)

1
2
3
4
5
6
7
8
9
10
11
CL-USER> (let ((eof-value (gensym)))
(with-input-from-string (stream "[1, 2, 3]")
(block nil
(loop
(let ((expr (read stream nil eof-value)))
(when (eq expr eof-value)
(return))

(print expr))))))

[1 ; Evaluation aborted on #<SB-INT:SIMPLE-READER-ERROR "Comma not inside a backquote." {1003AAD863}>.

这是因为按照 Common Lisp 的读取算法,左方括号[和数字 1 都是标准中所指的 constituent character,它们可以组成一个 token,并且最终被解析为一个符号类型的对象。而紧接着的字符是逗号,它是一个 terminating macro char,按照标准,如果不是在一个反引号表达式中使用它将会是无效的,因此触发了 condition。

假如存在一个由两个字符#J定义的 reader macro、允许开发者使用 JSON 语法来描述紧接着的对象的话,那么就可以写出下面这样的代码。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
CL-USER> (progn
(print #jfalse)
(print #jtrue)
(print #j233.666)
(print #jnull)
(print #j[1, 2, [3], [4, 5]])
(print #j{"a": [1, 2, 3]})
(print (gethash "a" #j{"a": [1, 2, 3]})))

YASON:FALSE
YASON:TRUE
233.666d0
:NULL
#(1 2 #(3) #(4 5))
#<HASH-TABLE :TEST EQUAL :COUNT 1 {1003889963}>
#(1 2 3)
#(1 2 3)

显然,用上述语法表示一个哈希表,要比下面这样的代码简单得多

1
2
3
4
5
CL-USER> (let ((obj (make-hash-table :test #'equal)))
(setf (gethash "a" obj) #(1 2 3))
obj)

#<HASH-TABLE :TEST EQUAL :COUNT 1 {1003CB7643}>

如何用 reader macro 解析 JSON?

Common Lisp 并没有预置#J这个 reader macro,但这门语言允许使用者定义自己的 macro character,因此前面的示例代码是可以实现的。要自定义出#J这个读取器宏,需要使用函数set-dispatch-macro-character。它的前两个参数分别为构成 macro character 的前两个字符,即#J——其中J即便是写成了小写,也会被转换为大写后再使用。第三个参数则是 Lisp 的词法解析器在遇到了#J时将会调用的参数。set-dispatch-macro-character会传给这个函数三个参数:

  1. 用于读取源代码的字符输入流;
  2. 构成 macro character 的第二个字符(即J);
  3. 非必传的、夹在#J之间的数字。

百闻不如一见,一段能够实现上一个章节中的示例代码的set-dispatch-macro-character用法如下

1
2
3
4
5
6
7
8
9
10
11
12
13
(set-dispatch-macro-character
#\#
#\j
(lambda (stream char p)
(declare (ignorable char p))
(let ((parsed (yason:parse stream
:json-arrays-as-vectors t
:json-booleans-as-symbols t
:json-nulls-as-keyword t)))
(if (or (symbolp parsed)
(consp parsed))
(list 'quote parsed)
parsed))))

set-dispatch-macro-character的回调函数中,我是用了开源的第三方库yason提供的函数parse,从输入流stream中按照 JSON 语法解析出一个值。函数parse的三个关键字参数的含义参见这里,此处不再赘述。由于 reader macro 的结果会被用于构造源代码的表达式,因此如果函数parse返回了符号或者cons类型,为了避免被编译器求值,需要将它们“引用”起来,因此将它们放到第一元素为quote的列表中。其它情况下,直接返回parse的返回值即可,因此它们是“自求值”的,求值结果是它们自身。

尾声

本文我借助了现成的库yason来解析 JSON 格式的字符串,如果你对如何从零开始实现这样的 reader macro 感兴趣的话,可以参考这篇文章

全文完。

使用 call/cc 实现计数循环

什么是计数循环

计数循环就是从一个数字$i$开始一直遍历到另一个数字$j$为止的循环过程。例如,下面的 Python 代码就会遍历从 0 到 9 这 10 个整数并逐个打印它们

1
2
for i in range(10):
print(i)

如果是在 C 语言中实现同样的功能,代码会更显著一些

1
2
3
4
5
6
7
8
9
10
#include <stdio.h>

int main(int argc, char *argv[])
{
for (int i = 0; i < 10; i++) {
printf("%d\n", i);
}

return 0;
}

在 C 语言的例子中,显式地指定了计数器变量i从 0 开始并且在等于 10 的时候结束循环,比之 Python 版本更有循环的味道。

拆开循环计数的语法糖

使用 C 语言的while语句同样可以实现计数循环,示例代码如下

1
2
3
4
5
6
7
8
9
10
11
12
#include <stdio.h>

int main(int argc, char *argv[])
{
int i = 0;
while (i < 10) {
printf("%d\n", i);
i++;
}

return 0;
}

如果将while也视为ifgoto的语法糖的话,可以进一步将计数循环写成更原始的形式

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
#include <stdio.h>

int main(int argc, char *argv[])
{
int i = 0;
label0:
if (i >= 10) {
goto label1;
}
printf("%d\n", i);
i++;
goto label0;
label1:

return 0;
}

Common Lisp 中的 go 与续延

在 Common Lisp 中也有与 C 语言的goto特性相近的 special form,那就是tagbodygo。使用它们可以将 C 代码直白地翻译为对应的 Common Lisp 版本

1
2
3
4
5
6
7
8
9
10
(let ((i 0))
(tagbody
label0
(when (>= i 10)
(go label1))

(format t "~D~%" i)
(incf i)
(go label0)
label1))

聪明的你一定已经发现了,此处的第二个符号label1其实是丝毫不必要的,只要写成下面的形式即可

1
2
3
4
5
6
7
(let ((i 0))
(tagbody
label0
(when (< i 10)
(format t "~D~%" i)
(incf i)
(go label0))))

这个形式不仅仅是更简单了,而且它暴露出了一个事实:label0所表示的,其实就是在将变量i绑定为 0之后要执行的代码的位置。换句话说,它标识了一个续延(continuation)。

用 call/cc 重新实现计数循环

如果你用的语言中支持 first-class 的续延,那么便可以用来实现计数循环,例如233-lisp。在 233-lisp 中,提供了特殊操作符call/cc来捕捉当前续延对象,这个名字借鉴自 Scheme。借助这个操作符,即便没有tagbodygo,也可以实现计数循环。

用callcc模拟计数循环

在上面的代码中,call/cc捕捉到的续延就是“赋值给局部变量i”。在将这个续延k保存到变量next之后,用 0 初始化变量i。之后只要i还小于 10,就将它打印到标准输出,并启动保存在了变量next中的续延,回到给变量i赋值的地方。此时传递给续延的参数为(+ i 1),就实现了变量i的自增操作。当(< i 10)不再成立时,也就不会启动续延“回到过去”了,至此,进程结束。

在 233-lisp 中,将dotimes作为一个内置的宏用call/cc实现了一遍,参见这里,其代码如下

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
(defun expand-dotimes-to-call/cc (expr)
"将 DOTIMES 语句 EXPR 编译为等价的 CALL/CC 语句。"
(assert (eq (first expr) 'dotimes))
(destructuring-bind ((var count-form) &rest statements)
(rest expr)
(let ((a (gensym))
(count-form-result (gensym))
(next (gensym)))
`(let ((,count-form-result ,count-form)) ; 由于目前 LET 只支持一个绑定,因此这里要写多个 LET。
(let ((,next 0)) ; 由于 233-lisp 中尚未支持 NIL,因此这里填个 0
(let ((,var (call/cc (k)
(progn
(setf ,next k)
0)))) ; 计数循环从 0 开始。
(if (< ,var ,count-form-result)
(progn
,@statements
(,next (+ ,var 1)))
0))))))) ; 由于目前没有 NIL,因此返回一个数字 0 来代替。

变量count-form-resultnext分别表示在宏展开后的代码中的计数上限和被捕捉的续延。之所以让它们以(gensym)的方式来命名,是为了避免多次求值count-form表达式,以及避免存储续延的变量名恰好出乎意料地与statements中的变量名冲突了,这也算是编写 Common Lisp 的宏时的最佳实践了。

后记

直接用call/cc来一个个实现 Common Lisp 中的各种控制流还是太繁琐了,更好的方案是用call/cc先实现tagbodygo,然后再用后两者继续实现do,最后用do分别实现dolistdotimes。当然了,这些都是后话了。

clingon

clingon 是一个 Common Lisp 的命令行选项的解析器,它可以轻松地解析具有复杂格式的命令行选项。例如,下面的代码可以打印给定次数的打招呼信息

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
(ros:ensure-asdf)
#+quicklisp(ql:quickload '(clingon) :silent t)
)

(defpackage :ros.script.hello.3868869124
(:use :cl
:clingon))
(in-package :ros.script.hello.3868869124)

(defun top-level/handler (cmd)
(check-type cmd clingon:command)
(let ((count (clingon:getopt cmd :count))
(name (first (clingon:command-arguments cmd))))
(dotimes (_ count)
(declare (ignorable _))
(format t "Hello ~A!~%" name))))

(defun main (&rest argv)
(let ((app (clingon:make-command
:handler #'top-level/handler
:name "hello"
:options (list
(clingon:make-option
:integer
:description "number of greetings"
:initial-value 1
:key :count
:long-name "count")))))
(clingon:run app argv)))
;;; vim: set ft=lisp lisp:

稍微做一些解释。首先执行命令ros init hello生成上面的代码的雏形——加载依赖、包定义,以及空的函数main。为了加载 clingon,将其作为函数ql:quickload的参数。然后分别定义一个commandhandler,以及option

在 clingon 中,类clingon:command的实例对象表示一个可以在 shell 中被触发的命令,它们由函数clingon:make-command创建。每一个命令起码要有三个要素:

  1. :handler,负责使用命令行选项、实现业务逻辑的函数;
  2. :name,命令的名字,一般会被展示在命令的用法说明中;
  3. :options,该命令所接受的选项。

此处的:handler就是函数top-level/handler,它会被函数clingon:run调用(依赖注入的味道),并将一个合适的clingon:command对象传入。:options目前只承载了一个选项的定义,即

1
2
3
4
5
6
(clingon:make-option
:integer
:description "number of greetings"
:initial-value 1
:key :count
:long-name "count")

它定义了一个值为整数的选项,在命令行中通过--count指定。如果没有传入该选项,那么在使用函数clingon:getopt取值时,会获得默认值 1。如果要从一个命令对象中取出这个选项的值,需要以它的:key参数的值作为参数来调用函数clingon:getopt,正如上面的函数top-level/handler所示。

子命令

clingon 也可以实现诸如git addgit branch这样的子命令特性。像addbranch这样的子命令,对于 clingon 而言仍然是类clingon:command的实例对象,只不过它们不会传递给函数clingon:run调度,而是传递给函数clingon:make-command的参数:sub-command,如下列代码所示

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
(defun top-level/handler (cmd)
(declare (ignorable cmd)))

(defun main (&rest argv)
(let ((app (clingon:make-command
:handler #'top-level/handler
:name "cli"
:sub-commands (list
(clingon:make-command
:handler #'(lambda (cmd)
(declare (ignorable cmd))
(format t "Dropped the database~%"))
:name "dropdb")
(clingon:make-command
:handler #'(lambda (cmd)
(declare (ignorable cmd))
(format t "Initialized the database~%"))
:name "initdb")))))
(clingon:run app argv)))

选项与参数

在 clingon 中通过命令行传递给进程的信息分为选项和参数两种形态,选项是通过名字来引用,而参数则通过它们的下标来引用。例如在第一个例子中,就定义了一个名为--count的选项,它在解析结果中被赋予了:count这个关键字,可以通过函数clingon:getopt来引用它的值;与之相反,变量name是从命令行中解析了选项后、剩余的参数中的第一个,它是以位置来标识的。clingon 通过函数clingon:make-option来定义选项,它提供了丰富的控制能力。

选项名称

选项有好几种名字,一种叫做:key,是在程序内部使用的名字,用作函数clingon:getopt的参数之一;一种叫做:long-name,一般为多于一个字符的字符串,如"count",在命令行该名称需要带上两个连字符的前缀来使用,如--count 3;最后一种叫做:short-name,为一个单独的字符,如#\v,在命令行中带上一个连字符前缀来使用,如-v

必要性与默认值

通过传入参数:required t给函数clingon:make-option,可以要求一个选项为必传的。例如下面的命令的选项--n就是必传的

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
(defun top-level/handler (cmd)
(dotimes (i (clingon:getopt cmd :n))
(declare (ignorable i))
(format t ".")))

(defun main (&rest argv)
(let ((app (clingon:make-command
:handler #'top-level/handler
:name "dots"
:options (list
(clingon:make-option
:integer
:description "打印的英文句号的数量"
:key :n
:long-name "n"
:required t)))))
(clingon:run app argv)))

如果不希望在一些最简单的情况下也要繁琐地编写--n 1这样的命令行参数,可以用:initial-value 1来指定。除此之外,也可以让选项默认读取指定的环境变量中的值,使用:env-vars指定环境变量名即可

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(defun top-level/handler (cmd)
(format t "Hello ~A~%" (clingon:getopt cmd :username)))

(defun main (&rest argv)
(let ((app (clingon:make-command
:handler #'top-level/handler
:name "greet"
:options (list
(clingon:make-option
:string
:description "用户名"
:env-vars '("GREETER_USERNAME")
:key :username
:long-name "username")))))
(clingon:run app argv)))

可多次使用的选项

curl中的选项-H就是可以多次使用的,每指定一次就可以在请求中添加一个 HTTP 头部,如下图所示

curl多次传入-H的效果

在 clingon 中可以通过往函数clingon:make-option传入:list来实现。当用clingon:getopt取出类型为:list的选项的值时,得到的是一个列表,其中依次存放着输入的值的字符串。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(defun top-level/handler (cmd)
(let ((messages (clingon:getopt cmd :message)))
(format t "~{~A~^~%~}" messages)))

(defun main (&rest argv)
(let ((app (clingon:make-command
:handler #'top-level/handler
:name "commit"
:options (list
(clingon:make-option
:list
:description "提交的消息"
:key :message
:long-name "message"
:short-name #\m)))))
(clingon:run app argv)))

另一种情况是尽管没有值,但仍然多次使用同一个选项。例如命令ssh的选项-v,使用的次数越多(最多为 3 次),则ssh打印的调试信息也就越详细。这种类型的选项在 clingon 中称为:counter

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(defun top-level/handler (cmd)
(format t "Verbosity: ~D~%" (clingon:getopt cmd :verbose)))

(defun main (&rest argv)
(let ((app (clingon:make-command
:handler #'top-level/handler
:name "log"
:options (list
(clingon:make-option
:counter
:description "啰嗦程度"
:key :verbose
:long-name "verbose"
:short-name #\v)))))
(clingon:run app argv)))

信号选项

有一些选项只需要区分【有】和【没有】两种情况就可以了,而不需要在意这个选项的值——或者这类选项本身就不允许有值,例如docker run命令的选项-d--detach。这种选项的类型为:boolean/true,如果指定了这个选项,那么取出来的值始终为t。与之相反,类型:boolean/false取出来的值始终为nil

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
(defun top-level/handler (cmd)
(let ((rv (software-type)))
(when (clingon:getopt cmd :shout)
(setf rv (concatenate 'string (string-upcase rv) "!!!!111")))

(format t "~A~%" rv)))

(defun main (&rest argv)
(let ((app (clingon:make-command
:handler #'top-level/handler
:name "info"
:options (list
(clingon:make-option
:boolean/true
:description "大喊"
:key :shout
:long-name "shout")))))
(clingon:run app argv)))

选择型选项

如果一个选项尽管接受的是字符串,但并非所有输入都是有意义的,例如命令dot的选项-T。从dot的 man 文档可以看到,它所支持的图片类型是有限的,如pspdfpng等。比起声明一个:string类型的选项,让 clingon 代劳输入值的有效性检查来得更轻松,这里可以使用:choice类型

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(defun top-level/handler (cmd)
(format t "~A~%" (clingon:getopt cmd :hash-type)))

(defun main (&rest argv)
(let ((app (clingon:make-command
:handler #'top-level/handler
:name "digest"
:options (list
(clingon:make-option
:choice
:description "哈希类型"
:items '("MD5" "SHA1")
:key :hash-type
:long-name "hash-type")))))
(clingon:run app argv)))

在 Common Lisp 中,打印整数一般用函数format。例如,上面的代码会往标准输出中打印出233这个数字:

1
(format t "~D" 233)

除此之外,format还可以控制打印内容的宽度、填充字符、是否打印正负号等方面。例如,要控制打印的内容至少占据6列的话,可以用如下代码

1
(format t "~6D" 233)

如果不使用字符串形式的 DSL,而是以关键字参数的方式来实现一个能够达到同样效果的函数format-decimal,代码可能如下:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(defun format-decimal (n
&key
mincol)
"打印整数 N 到标准输出。

MINCOL 如果不为 NIL,则表示所打印的内容至少要占据的列数。"
;; 通过取余的方式得到 N 的每一位并逐个入栈,之后出栈的顺序就是从左到右打印的顺序了。
(let ((digits '()))
(cond ((zerop n)
(push 0 digits))
(t
(do ((n n (truncate n 10)))
((zerop n))
(push (rem n 10) digits))))
;; 打印出填充用的空格。
(when (and (integerp mincol) (> mincol (length digits)))
(dotimes (i (- mincol (length digits)))
(declare (ignorable i))
(princ #\Space)))

(dolist (digit digits)
(princ (code-char (+ digit (char-code #\0)))))))

(format-decimal 233 :mincol 6)

如果要求用数字0而不是空格来填充左侧的列,用format的写法如下:

1
(format t "~6,'0D" 233)

format-decimal想要做到同样的事情,可以这么写:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
(defun format-decimal (n
&key
mincol
(padchar #\Space))
"打印整数 N 到标准输出。

MINCOL 如果不为 NIL,则表示所打印的内容至少要占据的列数。
PADCHAR 表达式为了填充多余的列时所用的字符。"
(check-type mincol (or integer null))
(check-type padchar character)
;; 通过取余的方式得到 N 的每一位并逐个入栈,之后出栈的顺序就是从左到右打印的顺序了。
(let ((digits '()))
(cond ((zerop n)
(push 0 digits))
(t
(do ((n n (truncate n 10)))
((zerop n))
(push (rem n 10) digits))))
;; 打印出填充用的空格。
(when (and (integerp mincol) (> mincol (length digits)))
(dotimes (i (- mincol (length digits)))
(declare (ignorable i))
(princ padchar)))

(dolist (digit digits)
(princ (code-char (+ digit (char-code #\0)))))))

(format-decimal 233 :mincol 6 :padchar #\0)

-D默认是不会打印非负整数的符号的,可以用修饰符@来修改这个行为。例如,(format t "~6,'0@D" 233)会打印出00+233。稍微修改一下就可以在format-decimal中实现同样的功能

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
(defun format-decimal (n
&key
mincol
(padchar #\Space)
signed)
"打印整数 N 到标准输出。

MINCOL 如果不为 NIL,则表示所打印的内容至少要占据的列数。
PADCHAR 表达式为了填充多余的列时所用的字符。"
(check-type mincol (or integer null))
(check-type padchar character)
(flet ((to-digits (n)
;; 通过取余的方式得到 N 的每一位并逐个入栈,之后出栈的顺序就是从左到右打印的顺序了。
(let ((digits '()))
(cond ((zerop n)
(push #\0 digits))
(t
(do ((n n (truncate n 10)))
((zerop n))
(push (code-char (+ (rem n 10) (char-code #\0))) digits))))
digits)))
;; 通过取余的方式得到 N 的每一位并逐个入栈,之后出栈的顺序就是从左到右打印的顺序了。
(let ((digits (to-digits (abs n))))
(when (or signed (< n 0))
(push (if (< n 0) #\- #\+) digits))
;; 打印出填充用的空格。
(when (and (integerp mincol) (> mincol (length digits)))
(dotimes (i (- mincol (length digits)))
(declare (ignorable i))
(princ padchar)))

(dolist (digit digits)
(princ digit)))))

(format-decimal 233 :mincol 6 :padchar #\0 :signed t)

除了@之外,:也是一个~D的修饰符,它可以让format每隔3个数字就打印出一个逗号,方便阅读比较长的数字。例如,下列代码会打印出00+23,333

1
(format t "~9,'0@:D" 23333)

为此,给format-decimal新增一个关键字参数comma-separated来控制这一行为。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
(defun format-decimal (n
&key
comma-separated
mincol
(padchar #\Space)
signed)
"打印整数 N 到标准输出。

COMMA-SEPARATED 如果为 T,则每打印3个字符就打印一个逗号。
MINCOL 如果不为 NIL,则表示所打印的内容至少要占据的列数。
PADCHAR 表示填充多余的列时所用的字符。
SIGNED 控制是否显示非负整数的加号。"
(check-type comma-separated boolean)
(check-type mincol (or integer null))
(check-type padchar character)
(check-type signed boolean)
(flet ((to-digits (n)
;; 通过取余的方式得到 N 的每一位并逐个入栈,之后出栈的顺序就是从左到右打印的顺序了。
(let ((digits '()))
(cond ((zerop n)
(push #\0 digits))
(t
(do ((count 0 (1+ count))
(n n (truncate n 10)))
((zerop n))
(when (and comma-separated (> count 0) (zerop (rem count 3)))
(push #\, digits))
(push (code-char (+ (rem n 10) (char-code #\0))) digits))))
digits)))
;; 通过取余的方式得到 N 的每一位并逐个入栈,之后出栈的顺序就是从左到右打印的顺序了。
(let ((digits (to-digits (abs n))))
(when (or signed (< n 0))
(push (if (< n 0) #\- #\+) digits))
;; 打印出填充用的空格。
(when (and (integerp mincol) (> mincol (length digits)))
(dotimes (i (- mincol (length digits)))
(declare (ignorable i))
(princ padchar)))

(dolist (digit digits)
(princ digit)))))

(format-decimal -23333 :comma-separated t :mincol 9 :padchar #\0 :signed t)

事实上,打印分隔符的步长,以及作为分隔符的逗号都是可以定制的。例如,可以改为每隔4个数字打印一个连字符

1
(format t "~9,'0,'-,4@:D" 23333)

对于format-decimal来说这个修改现在很简单了

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
(defun format-decimal (n
&key
(commachar #\,)
(comma-interval 3)
comma-separated
mincol
(padchar #\Space)
signed)
"打印整数 N 到标准输出。

COMMACHAR 表示当需要打印分隔符时的分隔符。
COMMA-INTERVAL 表示当需要打印分隔符时需要间隔的步长。
COMMA-SEPARATED 如果为 T,则每打印3个字符就打印一个逗号。
MINCOL 如果不为 NIL,则表示所打印的内容至少要占据的列数。
PADCHAR 表示填充多余的列时所用的字符。
SIGNED 控制是否显示非负整数的加号。"
(check-type commachar character)
(check-type comma-interval integer)
(check-type comma-separated boolean)
(check-type mincol (or integer null))
(check-type padchar character)
(check-type signed boolean)
(flet ((to-digits (n)
;; 通过取余的方式得到 N 的每一位并逐个入栈,之后出栈的顺序就是从左到右打印的顺序了。
(let ((digits '()))
(cond ((zerop n)
(push #\0 digits))
(t
(do ((count 0 (1+ count))
(n n (truncate n 10)))
((zerop n))
(when (and comma-separated (> count 0) (zerop (rem count comma-interval)))
(push commachar digits))
(push (code-char (+ (rem n 10) (char-code #\0))) digits))))
digits)))
;; 通过取余的方式得到 N 的每一位并逐个入栈,之后出栈的顺序就是从左到右打印的顺序了。
(let ((digits (to-digits (abs n))))
(when (or signed (< n 0))
(push (if (< n 0) #\- #\+) digits))
;; 打印出填充用的空格。
(when (and (integerp mincol) (> mincol (length digits)))
(dotimes (i (- mincol (length digits)))
(declare (ignorable i))
(princ padchar)))

(dolist (digit digits)
(princ digit)))))


(format-decimal -23333 :commachar #\- :comma-interval 4 :comma-separated t :mincol 9 :padchar #\0 :signed t)

全文完。

众所周知,在 Java 语言中支持基于子类型的多态,例如某百科全书中就给了一个基于Animal及其两个子类的例子(代码经过我微微调整)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
abstract class Animal {
abstract String talk();
}

class Cat extends Animal {
String talk() {
return "Meow!";
}
}

class Dog extends Animal {
String talk() {
return "Woof!";
}
}

public class Example {
static void letsHear(final Animal a) {
System.out.println(a.talk());
}

public static void main(String[] args) {
letsHear(new Cat());
letsHear(new Dog());
}
}

基于子类型的多态要求在程序的运行期根据参数的类型,选择不同的具体方法——例如在上述例子中,当方法letsHear中调用了参数a的方法talk时,是依照变量a在运行期的类型(第一次为Cat,第二次为Dog)来选择对应的talk方法的实例的,而不是依照编译期的类型Animal

但在不同的语言中,在运行期查找方法时,所选择的参数的个数是不同的。对于 Java 而言,它只取方法的第一个参数(即接收者),这个策略被称为 single dispatch。

Java 的 single dispatch

要演示为什么 Java 是 single dispatch 的,必须让示例代码中的方法接收两个参数(除了方法的接收者之外再来一个参数)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
// 演示 Java 是 single dispatch 的。
abstract class Shape {}

class Circle extends Shape {}

class Rectangle extends Shape {}

class Triangle extends Shape {}

abstract class AbstractResizer
{
public abstract void resize(Circle c);
public abstract void resize(Rectangle r);
public abstract void resize(Shape s);
public abstract void resize(Triangle t);
}

class Resizer extends AbstractResizer
{
public void resize(Circle c) { System.out.println("缩放圆形"); }
public void resize(Rectangle r) { System.out.println("缩放矩形"); }
public void resize(Shape s) { System.out.println("缩放任意图形"); }
public void resize(Triangle t) { System.out.println("缩放三角形"); }
}

public class Trial1
{
public static void main(String[] args)
{
AbstractResizer resizer = new Resizer();
Shape[] shapes = {new Circle(), new Rectangle(), new Triangle()};
for (Shape shape : shapes)
{
resizer.resize(shape);
}
}
}

显然,类Resizer的实例方法resize就是接收两个参数的——第一个为Resizer类的实例对象,第二个则可能是Shape及其三个子类中的一种类的实例对象。假如 Java 的多态策略是 multiple dispatch 的,那么应当分别调用不同的三个版本的resize方法,但实际上并不是

通过 JDK 中提供的程序javap可以看到在main方法中调用resize方法时究竟用的是类Resizer中的哪一个版本,运行命令javap -c -l -s -v Trial1,可以看到调用resize方法对应的 JVM 字节码为invokevirtual

翻阅 JVM 规格文档可以找到对invokevirtual 指令的解释

显然,由于在 JVM 的字节码中,invokevirtual所调用的方法的参数类型已经解析完毕——LShape表示是一个叫做Shape的类,因此在方法接收者,即类Resizer中查找的时候,也只会命中resize(Shape s)这个版本的方法。变量s的运行期类型在查找方法的时候,丝毫没有派上用场,因此 Java 的多态是 single dispatch 的。

想要依据参数的运行期类型来打印不同内容也不难,简单粗暴的办法可以选择instanceOf

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
abstract class AbstractResizer 
{
public abstract void resize(Shape s);
}

class Resizer extends AbstractResizer
{
public void resize(Shape s) {
if (s instanceof Circle) {
System.out.println("缩放圆形");
} else if (s instanceof Rectangle) {
System.out.println("缩放矩形");
} else if (s instanceof Triangle) {
System.out.println("缩放三角形");
} else {
System.out.println("缩放任意图形");
}
}
}

或者动用 Visitor 模式。

什么是 multiple dispatch?

我第一次知道 multiple dispatch 这个词语,其实就是在偶然间查找 CLOS 的相关资料时看到的。在 Common Lisp 中,定义类和方法的语法与常见的语言画风不太一样。例如,下列代码跟 Java 一样定义了四个类

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
(defclass shape ()
())

(defclass circle (shape)
())

(defclass rectangle (shape)
())

(defclass triangle (shape)
())

(defclass abstract-resizer ()
())

(defclass resizer (abstract-resizer)
())

(defgeneric resize (resizer shape))

(defmethod resize ((resizer resizer) (shape circle))
(format t "缩放圆形~%"))

(defmethod resize ((resizer resizer) (shape rectangle))
(format t "缩放矩形~%"))

(defmethod resize ((resizer resizer) (shape shape))
(format t "缩放任意图形~%"))

(defmethod resize ((resizer resizer) (shape triangle))
(format t "缩放三角形~%"))

(let ((resizer (make-instance 'resizer))
(shapes (list
(make-instance 'circle)
(make-instance 'rectangle)
(make-instance 'triangle))))
(dolist (shape shapes)
(resize resizer shape)))

执行上述代码会调用不同版本的resize方法来打印内容

由于defmethod支持给每一个参数都声明对应的类这一做法是在太符合直觉了,以至于我丝毫没有意识到它有一个专门的名字叫做 multiple dispatch,并且在大多数语言中是不支持的。

后记

聪明的你应该已经发现了,在上面的 Common Lisp 代码中,其实与 Java 中的抽象类AbstractResizer对应的类abstract-resizer是完全没有必要的,defgeneric本身就是一种用来定义抽象接口的手段。

此外,在第三个版本的resize方法中,可以看到标识符shape同时作为了参数的名字和该参数所属的类的名字——没错,在 Common Lisp 中,一个符号不仅仅可以同时代表一个变量和一个函数,同时还可以兼任一个类型,它不仅仅是一门通常所说的 Lisp-2 的语言。