用 Prolog 开发 Hello World 程序

发表于 2025-03-28 Disqus：

用 Prolog 开发 Hello World 程序

序言

本文演示如何用 Prolog 来实现经典的 Hello World 程序。

搭建开发环境

为了可以运行 Prolog 程序，需要先安装一个 Prolog 语言的实现。这里我选择的是 SWI-Prolog，到这里下载对应平台的安装包，安装完毕后，运行命令swipl --version可以看到相应的输出

1 2	➜ /tmp swipl --version SWI-Prolog version 9.0.4 for x86_64-darwin

接着再打开这个链接，给 VSCode 安装相应的插件，实现语法高亮，效果如下图所示

运行 Prolog 程序

使用 VSCode 将下列代码保存到名为hello_world.pl的文件中

:- initialization(main, main).

main(_) :-
    writeln("Hello, world!").

然后运行命令swipl ./hello_world.pl即可输出Hello, world!到屏幕上，如下图所示

展开说说

接下来对上述源文件hello_world.pl做一番讲解。

源文件命名

Prolog 源文件的后缀名通常为.pl，因此上文中的文件名为hello_world.pl。

程序入口

与 C 语言不同，Prolog 并没有规定程序启动的时候要调用哪一个函数，而是由开发者使用命令（Prolog 的术语为directive）:- initialization来指定的。可以将initialization视为一个两个参数的函数：

第一个参数为Goal，表示要调用的函数的名字。在这里就是main；
第二个参数为When，表示在什么时候调用Goal。当它的值为main的时候（注意，这里的main是一个固定的模式，与作为参数Goal的函数的名字无关），就表示是在程序启动的时候调用。

因此，:- initialization(main, main).的意思，就是在程序启动的时候，调用名为main的函数。

函数定义

在 Prolog 中，使用操作符:-来定义函数。它的左侧是函数的名字和参数列表，在上文的例子中，函数名为main，它有一个参数。由于这个参数在函数体中并未被用到，因此将其命名为_——这是 Prolog 中的匿名变量的意思，它可以避免触发编译器对于一个变量仅出现了一次的警告。而在:-的右侧直到英文句号（即.这个符号）的代码则属于函数体，在这里是writeln("Hello, world!")。

如果函数体中有多于一个语句，那么它们之间由英文逗号（即,这个符号）分隔。例如，将前文中的代码改写如下

:- initialization(main, main).

main(_) :-
    write("Hello, "),
    writeln("world!").

可以看到，两个语句之间正是由,分隔。

字符串

就像其它许多语言一样，SWI-Prolog 也支持以双引号的语法来表示一个字符串对象，因此上文中的"Hello, world!"是字符串类型，而不是一个 atom（atom 是 Prolog 中的一种数据类型，前文中的main就是一个 atom）。

输出

函数write和writeln都可以用于将字符串输出到屏幕，区别在于后者会在最后输出一个换行符。

用 Prolog 开发 WEB 服务

发表于 2025-02-19 更新于 2025-02-23 Disqus：

用 Prolog 开发 WEB 服务

序言

在绝大多数互联网行业开发者看来，Prolog 不是一门会被用在本职开发工作中的语言。更多的时候，谈论起 Prolog，人们联想到的往往是诸如“逻辑编程”、“人工智能”等词语，将它与 SQL 放在一起，视为一种 DSL，而非像 Java、Python 这样的通用编程语言。因此，我一直很好奇能否使用 Prolog 来开发一些更偏向于业务系统的程序。

答案是肯定的。基于 SWI-Prolog 这个实现和它的标准库，我开发出了一个简单的短链服务，验证了 Prolog 的确可以满足开发一个业务系统的各种功能需求。

Prolog 基础知识

由于本文的大多数读者对 Prolog 应当是比较陌生的，因此在开始讲解如何用它开发一个 WEB 应用之前，必须稍作科普，介绍一下 Prolog 的基础知识，包括但不限于：

Prolog 程序的基本结构；
运行 Prolog 脚本；
编译 Prolog 程序。

Hello World

Prolog 是一门语言而不是一个具体的解释器或者编译器，为了可以运行 Prolog 脚本或编译源代码，我选择使用 SWI-Prolog。有了它，就可以运行经典的 Hello World 程序了

:- initialization(main, main).

main(_) :-
    format("Hello, world!~n").

假设上述源代码被保存在文件hello_world.pl中，那么执行它的命令如下

1	swipl ./hello_world.pl

可以看到它打印出了所期望的文本

现在让我来稍微介绍一下上述代码中的细节。:- initialization(main, main).是一个给 SWI-Prolog 的“指示”，可以理解为其声明了程序启动后的入口是一个叫做main的函数。而

1 2	main(_) :- format("Hello, world!~n").

则是函数main的定义，它调用内置的函数format来打印一个字符串到标准输出。

编译 Prolog 程序

利用 SWI-Prolog 可以像运行 Python 脚本一般来运行 Prolog 程序，当然，也可以像 C 程序一样将其从文本形态的源代码编译为一个独立的可执行文件。仍然以前文的源文件hello_world.pl为例，编译的命令如下

1	swipl --stand_alone=true -o hello_world -c hello_world.pl

效果如下图所示

在 C 语言中，被编译的程序的入口是约定俗成的，即函数main。而由于在文件hello_world.pl中用指令:- initialization(main, main).

Prolog 的使用

在开发 WEB 服务的过程中，还会遇到许多与 WEB 无关的、Prolog 自身在其它领域的应用知识，例如：

如何读写磁盘文件；
如何处理 JSON 格式的数据；
如何读写 MySQL；
如何读写 Redis；

因此在这一章节中，将会分别介绍在 Prolog 中如何做到上面的这些事情。

读取磁盘文件

要读取磁盘文件的全部内容，可以使用 SWI-Prolog 的库提供的函数read_file_to_string/3。假设要读取的文件为/tmp/demo.txt，其内容如下

Shopping List:

- Milk
- Bread
- Eggs
- Apples
- Coffee

那么read_file_to_string/3的用法如下

:- use_module(library(readutil)).

:- initialization(main, main).

main(_) :-
    read_file_to_string("/tmp/demo.txt", String, []),
    format("file content is: ~s~n", [String]).

这样就可以将读到的文件内容完全打印到控制台上，如下图所示

写入磁盘文件

如果要将数据写入到磁盘文件中——例如，在每次处理完请求后记录日志，那么可以使用函数write。以将前文中的字符串Hello, world!写入到文件中为例，示例代码如下

:- initialization(main, main).

main(_) :-
    LogContent = "Hello, world!",
    open("/tmp/access.log", write, Stream),
    write(Stream, LogContent),
    close(Stream).

效果如下图所示

解析 JSON 格式

JSON 已经是应用最广泛的数据交互格式之一了，因此如果一门语言要能够投产于业务系统的开发，必然离不开对 JSON 数据的处理能力。假设要处理的 JSON 数据如下

{
    "mysql": {
        "driver_string": "DRIVER={MySQL ODBC 8.0 Driver};String Types=Unicode;password=1234567;port=3306;server=mysql;user=root"
    },
    "redis": {
        "hostname": "redis",
        "port": 6379
    }
}

这些内容存储在文件/tmp/config.json中，那么下列代码会取出其中的叶子节点来输出

:- use_module(library(http/json)).

:- initialization(main, main).

main(_) :-
    ConfigPath = "/tmp/config.json",
    read_file_to_string(ConfigPath, String, []),
    % 按照 JSON 格式反序列化为字典类型的数据。
    atom_json_dict(String, JSONDict, []),
    format("mysql.driver_string = ~s~n", [JSONDict.mysql.driver_string]),
    format("redis.hostname = ~s~n", [JSONDict.redis.hostname]),
    format("redis.port = ~d~n", [JSONDict.redis.port]).

上文中的函数atom_json_dict将字符串类型的变量String反序列化为变量JSONDict。从这里可以看到，SWI-Prolog 为字典类型提供一个中缀操作符.，使得我们可以像在多数主流语言中引用类的成员变量一般，用简单的语法来获取字典内的字段——即JSONDict.mysql.driver_string这样的代码。

上面的代码的运行效果如下图所示

自动导入的库

如果分别查看函数read_file_to_string和atom_json_dict的文档（分别在这里和这里），就会发现前者的页面上写着can be autoloaded，而后者没有

所以前文关于read_file_to_string的例子中，即便不写上:- use_module(library(readutil)).，也是可以正常调用的

事实与全局变量

在将磁盘上的配置文件的内容加载到内存中后，最好可以将其赋值为一个全局变量以便在所有的函数中访问到。要做到这一点，可以利用 Prolog 的一个特性：事实。

在很多 Prolog 的入门教程中，都会介绍经典的、如何用 Prolog 来回答两个人是否为某种关系的例子。例如，在这个教程中，就给出了如何判断两个人是否为朋友的示例，如下图所示

其中，像

friend(john, julia).
friend(john, jack).
friend(julia, sam).
friend(julia, molly).

这样的代码就是 Prolog 中的“事实”。其中，friend在 Prolog 中被称为“谓词”，也就是前文中一直提到的函数。因此，如果想要定义一个全局变量，可以：

用dynamic/1声明一个只有一个参数的“动态”谓词；
用asserta/1新增一个事实；
在别的位置，用通常的归一语法就可以绑定全局的值到一个变量上了。

就像下面这样子

:- initialization(main, main).

% 声明为动态的以便允许使用 asserta 修改。
:- dynamic odbc_driver_string/1.

main(_) :-
    asserta(odbc_driver_string("This is a global variable")),
    odbc_driver_string(DriverString),
    format("DriverString = ~s~n", [DriverString]).

效果如下

用 findall 找到所有的解

在前一小节的截图中，可以看到我们可以询问 Prolog 一个事实是否成立。其实，我们还可以让 Prolog 遍历它的“知识库”，来找出符合我们所查询的问题的“答案”。例如，我先准备好一份内容如下的文件friend.pl

friend(john, julia).
friend(john, jack).
friend(julia, sam).
friend(julia, molly).

接着我在 Prolog 的 REPL 中加载它，如下图所示

然后我向 Prolog 提问，代码如下

1	friend(john, X), write(X), nl, fail.

在 Prolog 中，英文逗号是一个二元操作符，它就像是 C 语言中的&&或 Python 中的and，只有当操作符的左右两边都成立时，整个表达式才成立。由于上面的代码以fail结尾，因此始终不会成立。Prolog 在遍历知识库、寻找变量X的值的过程中，遇到表达式无法成立时就会“回溯”，继续寻找下一个可能匹配的X。通过调用谓词write，就可以看到 Prolog 回溯的过程了，如下图所示

可以看到 Prolog 尝试用julia和jack来作为变量X的值，但终究无法让查询成立——当然了，因为最后一个值为fail。如果我们希望将变量X的所有值都收集到列表中，可以借助内置的谓词findall/3，示例代码如下

1	findall(X, friend(john, X), L).

效果如下图所示

在 Docker 中运行 Prolog

在之后的例子中，我还会介绍如何使用 Prolog 来读写数据库。但在摸索的过程中，我发现在 macOS 上无法运行成功，只有在 Docker 内才可行，因此这一节将会先介绍如何在 Docker 中运行 Prolog。

以前文中的 Hello World 程序为例，在已经有了源文件hello_world.pl的前提下，准备如下的hello_world.dockerfile文件

FROM swipl:stable

COPY . /app/
WORKDIR /app

# 编译源代码
RUN swipl --goal=main --stand_alone=true -o hello_world -c hello_world.pl \
  && cp ./hello_world /bin/

CMD [ "hello_world" ]

然后基于这份配置来构建镜像

1	docker build -f ./hello_world.dockerfile -t hello_world .

如果无法拉取镜像docker.io/library/swipl:stable，可以先通过 DaoCloud 下载，然后替换掉标签

1 2	docker pull docker.m.daocloud.io/library/swipl:stable docker tag b84634ddb907 docker.io/library/swipl:stable # 此处的镜像 ID b84634ddb907 是在我的机器上的效果。

然后就可以运行这个镜像了

1	docker run hello_world

效果如下图所示

读写数据库

如果一门语言无法读写数据库，尤其是关系型数据库，那么用它来开发业务系统必然是捉襟见肘的。这一章中，将会介绍如何用 SWI-Prolog 读写 MySQL 中的数据。

连接 MySQL

通过 SWI-Prolog 的文档我们可以了解到，要操作关系型数据库，需要用到 ODBC，这一小节以连接 MySQL、调用函数version为例进行讲解。首先需要有一个 DSN 字符串来指定 MySQL 的连接参数，假设：

密码为1234567；
端口号为3306；
主机名为mysql；
用户名为root；

那么这串 DSN 可以是DRIVER={MySQL ODBC 8.0 Driver};String Types=Unicode;password=1234567;port=3306;server=mysql;user=root。将其传递给谓词odbc_driver_connect即可连接上 MySQL。然后可以用谓词odbc_query来提交 SQL 语句给 MySQL，并获取执行结果。完整的代码如下所示（其中数据库的密码被我替换为了星号）

:- use_module(library(odbc)).

:- initialization(main, main).

main(_) :-
    Dsn = "DRIVER={MySQL ODBC 8.0 Driver};String Types=Unicode;password=******;port=3306;server=host.docker.internal;user=root",
    odbc_driver_connect(Dsn, Connection, []),
    Sql = "SELECT VERSION()",
    odbc_query(Connection, Sql, row(Version)),
    odbc_disconnect(Connection),
    format("Version is ~s~n", [Version]).

为了运行它，还得在容器中安装 MySQL 的驱动。修改后的完整 Dockerfile 文件如下

FROM swipl:stable

RUN apt-get clean \
  && apt-get update \
  && apt-get install -y unixodbc-dev

COPY . /app/
WORKDIR /app
# 下列代码来自[这里](https://stackoverflow.com/questions/68590463/linux-installing-mysql-odbc-driver-error)，在容器内安装 ODBC 驱动程序。
RUN tar -C /tmp/ -xzvf mysql-connector-odbc-8.4.0-linux-glibc2.28-aarch64.tar.gz \
  && cd /tmp/ \
  && cp -r ./mysql-connector-odbc-8.4.0-linux-glibc2.28-aarch64/bin/* /usr/local/bin \
  && cp -r ./mysql-connector-odbc-8.4.0-linux-glibc2.28-aarch64/lib/* /usr/local/lib \
  && myodbc-installer -a -d -n "MySQL ODBC 8.0 Driver" -t "Driver=/usr/local/lib/libmyodbc8w.so"

# 编译源代码
RUN swipl --goal=main --stand_alone=true -o query_version -c query_version.pl \
  && cp ./query_version /bin/

CMD [ "query_version" ]

然后构建镜像并运行即可，效果如下图所示

执行 SELECT 语句

通过查阅odbc_query/4的文档，可以看到要想从表中查询出一行记录，需要在该谓词的第三个参数RowOrAffected中传入row(Lemma)这样的复合表达式。以查询短链的内容为例，假设存储着原始链接与短链的 ID 的关系的表的结构如下

CREATE TABLE `t_url` (
    `id` BIGINT NOT NULL AUTO_INCREMENT,
    `url` VARCHAR(256) NOT NULL COMMENT '短链对应的原始链接',
    `ctime` TIMESTAMP DEFAULT CURRENT_TIMESTAMP,
    `mtime` TIMESTAMP DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
    PRIMARY KEY (`id`),
    UNIQUE INDEX `ux__url` (`url`)
) AUTO_INCREMENT=1000001;

往其中添加一行测试用的数据

1	INSERT INTO `t_url` SET `url` = 'https://example.com/';

接着便可以在 Prolog 中用下列代码将其查询出来

:- use_module(library(odbc)).

:- initialization(main, main).

main(_) :-
    Dsn = "DRIVER={MySQL ODBC 9.2 Unicode Driver};String Types=Unicode;password=1234567;port=3306;server=localhost;user=root",
    odbc_driver_connect(Dsn, Connection, []),
    Sql = "SELECT `id`, `url` FROM `test`.`t_url` WHERE `url` = ?",
    odbc_prepare(Connection, Sql, [default], Statement),
    odbc_execute(Statement, ["https://example.com/"], row(Id, Url)),
    odbc_disconnect(Connection),
    format("Id is ~d~n", [Id]),
    format("Id is ~s~n", [Url]),

查询结果如下图所示

odbc_execute/3的第三个参数与谓词odbc_query/4是相同的，从后者的文档可以看出，如果要接收查询结果中的多列，那么就需要相应地填上多少个变量。例如，前文中 SELECT 语句要查询的列为id和url，因此这里用的是row/2，其值是两个变量Id和Url。以此类推，如果将列ctime也查询出来，那么就要在row的对应位置新增一个变量来承载这一列的值。

如果希望从数据库中查出多行记录并组织为列表的形式——这是一个很常见的需求，那么可以使用谓词odbc_prepare的Options参数。它等价于odbc_query的Options参数，因此可以传入findall(info(Id, Url), row(Id, Url))来将查询结果中的前两列按照info(Id, Url)的格式组成一个列表，最终赋值到一个变量中，示例代码如下

:- use_module(library(odbc)).

:- initialization(main, main).

main(_) :-
    Dsn = "DRIVER={MySQL ODBC 9.2 Unicode Driver};String Types=Unicode;password=1234567;port=3306;server=localhost;user=root",
    odbc_driver_connect(Dsn, Connection, []),
    Sql = "SELECT `id`, `url` FROM `test`.`t_url` WHERE `id` > ?",
    odbc_prepare(Connection, Sql, [default], Statement, [findall(info(Id, Url), row(Id, Url))]),
    odbc_execute(Statement, [0], Rows),
    odbc_disconnect(Connection),
    length(Rows, Length),
    format("Length of Rows is ~d~n", [Length]),
    write(Rows).

最终效果如下

单测要用 Redis 集群？教你用 docker 一键部署

发表于 2024-06-30 Disqus：

序言

在目前我参与开发的代码仓库中，当需要使用 Redis 时，基本上用的都是 Redis 集群。因此，我在办公电脑上也搭建了一个 Redis 集群，以便让我为这些仓库编写的单元测试能成功运行起来。

尽管 Redis 官方提供了部署集群的指引，但这要求团队内的每位成员都要依次执行如下操作：

用 Homebrew 安装 Redis；
创建 6 个目录；
创建 6 份redis.conf配置文件；
启动 6 个redis-server进程；
用redis-cli创建集群。

为了可以让更多的人愿意执行单元测试，必须要降低部署 Redis 集群的操作难度。因此，本文旨在提供一种基于 Docker 的、一键部署 Redis 集群的办法。

启动单个 Redis 容器

Redis 集群需要至少 6 个实例，那么首先要解决的问题便是如何启动单个 Redis 容器。从前文提到的部署集群的指引中可以知道，要启动一个集群模式的 Redis 实例，所需要的配置文件redis.conf的内容如下

port 8000
cluster-enabled yes
cluster-config-file nodes.conf
cluster-node-timeout 5000
appendonly yes

参考官方的 redis 镜像的文档的方式，让redis-server读取来自于宿主机的配置文件，示例代码如下

1
2

# 选项 --rm 使该容器在退出后（例如按下 ctrl-c）可以被删除，毕竟这里只是先做个演示，不需要留下它。
sudo docker run --rm -v "`pwd`:/usr/local/etc/redis" redis redis-server "/usr/local/etc/redis/redis.conf"

效果如下图所示

启动 6 个 Redis 容器

接下来以相似的方式启动全部的 6 个 Redis 容器。首先创建 6 个目录

1 2	# 这里我用 Redis 监听的端口号作为目录名，但这并非强制要求。 mkdir 8000 8001 8002 8003 8004 8005

然后在每一个目录中都创建配置文件redis.conf

for port in 8000 8001 8002 8003 8004 8005 ;
do
    cat << EOF > "./${port}/redis.conf"
port ${port}
cluster-enabled yes
cluster-config-file nodes.conf
cluster-node-timeout 5000
appendonly yes
EOF
done

最后启动它们

# 创建出名为 some-network 的容器间网络。
docker network create some-network

for port in 8000 8001 8002 8003 8004 8005 ;
do
    # --name 选项让这 6 个容器拥有确定的且不同的主机名，以便之后可以在 redis-cli 中指定它们。
    # --network 选项让这 6 个容器处于同一个网络下，以便集群内的节点可以互相通信。
    docker run --name "some-redis-${port}" --network some-network --rm -d -v "`pwd`/${port}:/usr/local/etc/redis" redis redis-server '/usr/local/etc/redis/redis.conf'
done

效果如下图所示

创建集群

此时 6 个运行中的 Redis 实例还不构成一个集群，还需要执行redis-cli的命令--cluster create才行。

1
2

# 给 redis-cli 的选项 --cluster-yes 使其默认接受集群内节点的分配情况。这在脚本执行、无法通过标准输出敲入 yes 的时候很有用。
docker run --network some-network --rm -i -t redis redis-cli --cluster create some-redis-8000:8000 some-redis-8001:8001 some-redis-8002:8002 some-redis-8003:8003 some-redis-8004:8004 some-redis-8005:8005 --cluster-replicas 1 --cluster-yes

但命令--cluster create并非幂等的，只能在创建集群的时候使用一次。因此，如果希望通过脚本一键搭建、启动集群，则必须在创建前先检查集群是否曾经被创建过。借助redis-cli的命令--cluster check可以实现

docker run --network some-network --rm -i -t redis redis-cli --cluster check some-redis-8000:8000 | grep 'All 16384 slots covered.' > /dev/null
if [[ "$?" == '0' ]]; then
    echo "Redis 集群已经创建好了。"
else
    echo "开始创建 Redis 集群。"
    docker run --network some-network --rm -i -t redis redis-cli --cluster create some-redis-8000:8000 some-redis-8001:8001 some-redis-8002:8002 some-redis-8003:8003 some-redis-8004:8004 some-redis-8005:8005 --cluster-replicas 1 --cluster-yes
fi

创建成功后，只要新的容器也使用网络some-network，就可以读写集群中的数据了

1	docker run --network some-network --rm -i -t redis redis-cli -c -h some-redis-8000 -p 8000

效果如下图所示

总结

我将上面的内容集成到了redis_cluster这个 GitHub 仓库中，只需要克隆到本地并执行脚本start.sh即可，效果如下图所示

全文完。

从 Ruby 的 method_missing 到杂鱼 Common Lisp

发表于 2024-05-05 Disqus：

从 Ruby 的 method_missing 到杂鱼 Common Lisp

在 Ruby 中当调用一个对象不存在的方法时，会触发解释器调用该对象的method_missing方法。例如下面的代码

# -*- encoding: UTF-8 -*-
class A
    def method_missing(m, *args, &block)
        puts 'now you see me'
    end
end


A.new().demo()

运行到方法调用demo()时，由于该方法未定义，于是解释器会转而调用方法method_missing，并将相同的方法名（即demo）、参数列表等传递给它。其运行结果便是在标准输出中打印出now you see me这句话。

在 Python 中有method_missing的等价物——__getattr__方法。与 Ruby 不同的是，调用不存在的方法对于 Python 解释器而言，只是一次寻常的AttributeError异常，然后解释器会调用对象的__getattr__方法。与前文的 Ruby 代码类似的写法如下

class A:
    def __getattr__(self, name):
        def replacement(*args, **kwargs):
            print('now you see me')

        return replacement


A().demo()

利用__getattr__可以实现一个透明缓存。例如，假设有一个类Slow，它提供了a、b，以及c等几个比较耗时的方法。那么可以实现一个类Cached，由它来代理对Slow类的实例方法的调用、将结果缓存起来加速下一次的调用，再返回给调用方，示例代码如下

import json
import time


class Slow:
    def a(self):
        time.sleep(1)
        return 2

    def b(self):
        time.sleep(1)
        return 23

    def c(self):
        time.sleep(1)
        return 233


class Cached:
    def __init__(self, slow: Slow):
        self._slow = slow

        self._cache = {}

    def __getattr__(self, name):
        f = getattr(self._slow, name)
        def replacement(*args, **kwargs):
            key = json.dumps([args, kwargs])
            if key in self._cache:
                return self._cache[key]

            v = f(*args, **kwargs)
            self._cache[key] = v
            return v

        return replacement


def run_and_timing(f, label):
    begin_at = time.time()
    v = f()
    duration = time.time() - begin_at
    print('%s 耗时 %s 秒' % (label, duration))


if __name__ == '__main__':
    cached = Cached(Slow())
    run_and_timing(lambda: cached.a(), '第一次')
    run_and_timing(lambda: cached.a(), '第二次')

在我的机器上运行的结果为

1 2	第一次耗时 1.0018281936645508 秒第二次耗时 2.8848648071289062e-05 秒

在 Common Lisp 中有没有与__getattr__对应的特性呢？有的，那便是广义函数slot-missing。但可惜的是，它并不适用于调用一个不存在的方法的场景，因为在 Common Lisp 中方法并不属于作为第一个参数的实例对象，而是属于广义函数的（即 Common Lisp 不是单派发、而是多派发的，可以参见这篇文章）。所以调用一个不存在的方法不会导致调用slot-missing，而是会调用no-applicable-method。如下列代码所示

(defgeneric demo-gf (a)
  (:documentation "用于演示的广义函数。"))

(defclass A ()
  ())


(defclass B ()
  ())


(defmethod demo-gf ((a A))
  (format t "这是类 A 的实例方法。~%"))


(defmethod no-applicable-method ((gf (eql #'demo-gf)) &rest args)
  (declare (ignorable args gf))
  (format t "now you see me"))


(defun main ()
  (let ((a (make-instance 'B)))
    (demo-gf a)))


(main)

假设上述代码保存在文件no_applicable_method_demo.lisp中，可以像下面这样运行它们

1 2	$ ros run --load ./no_applicable_method_demo.lisp -q now you see me

当代码运行到(demo-gf a)时，由于没有为广义函数demo-gf定义过参数列表的类型为(B)的方法，因此 SBCL 调用了广义函数no-applicable-method，后者有applicable 的方法，因此会调用它并打印出now you see me。

如果想利用这一特性来实现透明缓存，那么必须：

为每一个需要缓存的广义函数都编写其no-applicable-method方法；
手动检查参数列表的第一个参数的类型是否为特定的类。

如下列代码所示

(defgeneric a (a))
(defgeneric b (a))
(defgeneric c (a))


(defclass Slow ()
  ())


(defclass Cached ()
  ((cache
    :accessor cached-cache
    :initform (make-hash-table :test #'equal))
   (slow
    :accessor cached-slow
    :initarg :slow)))


(defmethod a ((a Slow))
  (sleep 1)
  2)
(defmethod b ((a Slow))
  (sleep 1)
  23)
(defmethod c ((a Slow))
  (sleep 1)
  233)


(defmethod no-applicable-method ((gf (eql #'a)) &rest args)
  (let ((instance (first args)))
    (if (typep instance 'Cached)
        (let ((slow (cached-slow instance))
              (key (rest args)))
          (multiple-value-bind (v foundp)
              (gethash key (cached-cache instance))
            (if foundp
                v
                (let ((v (apply gf slow (rest args))))
                  (setf (gethash key (cached-cache instance)) v)
                  v))))
        (call-next-method))))

在我的机器上运行的结果为

CL-USER> (time (a *cached*))
Evaluation took:
  1.001 seconds of real time
  0.001527 seconds of total run time (0.000502 user, 0.001025 system)
  0.20% CPU
  2,210,843,642 processor cycles
  0 bytes consed
  
2
CL-USER> (time (a *cached*))
Evaluation took:
  0.000 seconds of real time
  0.000015 seconds of total run time (0.000014 user, 0.000001 system)
  100.00% CPU
  29,024 processor cycles
  0 bytes consed
  
2

如果想要让透明缓存对函数b和c也起作用，则需要重新定义b和c各自的no-applicable-method方法。通过编写一个宏可以简化这部分重复的代码，示例如下

(defmacro define-cached-method (generic-function)
  "为函数 GENERIC-FUNCTION 定义它的缓存版本的方法。"
  (let ((gf (gensym))
        (args (gensym)))
    `(defmethod no-applicable-method ((,gf (eql ,generic-function)) &rest ,args)
       (let ((instance (first ,args)))
         (if (typep instance 'Cached)
             (let ((slow (cached-slow instance))
                   (key ,args))
               (multiple-value-bind (v foundp)
                   (gethash key (cached-cache instance))
                 (if foundp
                     v
                     (let ((v (apply ,gf slow (rest ,args))))
                       (setf (gethash key (cached-cache instance)) v)
                       v))))
             (call-next-method))))))

然后就可以直接用这个新的宏来为函数a、b、c定义相应的带缓存的方法了，示例代码如下

1
2
3

(define-cached-method #'a)
(define-cached-method #'b)
(define-cached-method #'c)

用函数b演示一下，效果如下

CL-USER> (time (b *cached*))

Evaluation took:
  1.003 seconds of real time
  0.002518 seconds of total run time (0.001242 user, 0.001276 system)
  0.30% CPU
  2,216,371,640 processor cycles
  334,064 bytes consed
  
23
CL-USER> (time (b *cached*))
Evaluation took:
  0.000 seconds of real time
  0.000064 seconds of total run time (0.000063 user, 0.000001 system)
  100.00% CPU
  135,008 processor cycles
  0 bytes consed
  
23

全文完。

在CommonLisp中支持JSON语法

发表于 2023-05-23 Disqus：

在 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 中的“异常”、“出状况”了）

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 语法来描述紧接着的对象的话，那么就可以写出下面这样的代码。

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)

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

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会传给这个函数三个参数：

用于读取源代码的字符输入流；
构成 macro character 的第二个字符（即J）；
非必传的、夹在#和J之间的数字。

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

(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 感兴趣的话，可以参考这篇文章。

全文完。