事情是这样的,我的恋人@misaka18931在配置她的 Emacs 时陷入了苦恼。她在写循环,于是我建议她使用强大的 cl-loop 。可是她告诉我 cl-loop 也无法解决她的问题,因为她需要找到一个 alist 中 value 最大的 cons cell 的 key 。太糟糕了,这确实是 cl-loop 无法解决的问题。在 Common Lisp 中我一般会使用 Jonathan Amsterdam 的强大可扩展迭代器解决这类问题。于是我首先想到的是把 Jonathan Amsterdam 的强大可扩展迭代器 移植到 Elisp 里,但是这不太现实,因为它需要构建一个完整的 code walker 。那么退而求其次,能不能扩展 cl-loop ,让它支持 finding X maximizing Y 的功能呢?
我开始查找资料,但只在 cl-loop 的 Info Page 最末一节的倒数第二段找到这么两句:
While there is no high-level way to add user extensions to ‘cl-loop’,
this package does offer two properties called ‘cl-loop-handler’ and
‘cl-loop-for-handler’ which are functions to be called when a given
symbol is encountered as a top-level loop clause or ‘for’ clause,
respectively. Consult the source code in file ‘cl-macs.el’ for details.
…真是把我们 Lisp 程序员当肉编器用。好吧, M-. 打开 cl-macs.el ,在 cl-loop parser 的最末找到这么一个不情不愿的条件句:
(t
;; This is an advertised interface: (info "(cl)Other Clauses").
(let ((handler (and (symbolp word) (get word 'cl-loop-handler))))
(or handler (error "Expected a cl-loop keyword, found %s" word))
(funcall handler)))
注意到 word 就是存储当前 loop 关键字的变量。于是得出扩展 Loop clauses 的方法是:
(setf (get 'my-keyword 'cl-loop-handler) (lambda () ...))
注意到扩展函数接受 0 个参数,说明所有操作都要通过修改 dynamic variable (也就是 lexically bounded special variable,在词法作用域中绑定的特殊变量)进行。更头大的是这些变量一丁点说明和注释都没有:
;;; The "cl-loop" macro.
(defvar cl--loop-args) (defvar cl--loop-accum-var) (defvar cl--loop-accum-vars)
(defvar cl--loop-bindings) (defvar cl--loop-body) (defvar cl--loop-conditions)
(defvar cl--loop-finally)
(defvar cl--loop-finish-flag) ;Symbol set to nil to exit the loop?
(defvar cl--loop-first-flag)
(defvar cl--loop-initially) (defvar cl--loop-iterator-function)
(defvar cl--loop-name)
(defvar cl--loop-result) (defvar cl--loop-result-explicit)
(defvar cl--loop-result-var) (defvar cl--loop-steps)
(defvar cl--loop-symbol-macs)
注意到:
cl--loop-args是亟待处理的参数列表,使用pop提取下一个元素cl--loop-bindings是一个 let 参数列表的列表,是在运行时生效的词法绑定(即局部变量定义),使用push向后追加内容(最后会nreverse)cl--loop-result是一般情况下的返回值表达式cl--loop-result-explicit是通过finally return X或finally (return X)指定的返回值表达式cl--loop-accum-vars是收集器(accumulating clauses)所创建并使用的变量名,包括默认变量和通过into关键字创建的命名变量cl--loop-accum-var是未指定into时收集器的默认目标变量名(cl--loop-handle-accum [init-value])可用于创建收集器变量名,自动解析into关键字
cl--loop-body是循环体,是一个表达式列表,其中的任一表达式返回nil则终止整个 cl-loop 循环并开始返回。使用push向后追加内容(最后会nreverse)
本人注意力有限,其它变量的用法大家可以望文生一下义。
有了这些信息,我们就可以编写 cl-loop 的扩展啦~拿我们的 finding ,finding-expression maximizing ,maximizing-expression 为例,注意到我们可以通过如下方式实现:
(let (peak-score peak-value) ; bindings
(loop ...
(let ((this-score ,maximizing-expression)) ; body
(when (or (null peak-score)
(> this-score peak-score))
(setq peak-score this-score
peak-value ,finding-expression)))
...)
peak-value) ; return value
只需要在我们的函数中,将每个部分的代码一一 push 到对应的 cl--loop-* 变量里,我们的 cl-loop 扩展就完成啦w~
完整的 Jonathan Amsterdam 的强大可扩展迭代器之寻找者 - cl-loop 版 源代码如下:
(defun cal/cl-loop-finding-handler ()
"April's powerless finding handler that poorly imitating
Jonathan Amsterdam's powerful iteration facility"
(let* ((expr (pop cl--loop-args))
(kind (cl-case (pop cl--loop-args)
((maximize maximizing) 'max)
((minimize minimizing) 'min)
(such-that 'such-that)
(t (error "Invalid finding clause"))))
(test-expr (pop cl--loop-args))
(value (cl--loop-handle-accum nil)))
(if (eq kind 'such-that)
(let ((test-result (gensym "--cl-var--finder-test-result-")))
(push `((,test-result nil))
cl--loop-bindings)
(push `(progn (setq ,test-result ,(if (and (listp test-expr) (eq (car test-expr) 'function))
`(funcall ,test-expr ,expr)
test-expr))
(when ,test-result
(setq ,value ,expr))
(null ,test-result))
cl--loop-body))
(let ((peak-score (gensym "--cl-var--finder-peak-score-"))
(this-score (gensym "--cl-var--finder-this-score-")))
(push `((,peak-score nil) (,this-score nil))
cl--loop-bindings)
(push `(progn (setq ,this-score ,(if (and (listp test-expr) (eq (car test-expr) 'function))
`(funcall ,test-expr ,expr)
test-expr))
(when (or (null ,peak-score)
(,(if (eql kind 'max) '> '<) ,this-score ,peak-score))
(setq ,peak-score ,this-score
,value ,expr))
t)
cl--loop-body)))))
;; Install handler
(setf (get 'find 'cl-loop-handler) #'cal/cl-loop-finding-handler)
(setf (get 'finding 'cl-loop-handler) #'cal/cl-loop-finding-handler)
可以看到,虽然比 Jonathan Amsterdam 的强大可扩展迭代器 的 defmacro-driver 扩展接口要冗长一些,但依然是简短且可接受的,这充分证明了我们同样强大的 cl-loop 同样具有可扩展能力。下面让我们进行一些简单的测试:
(cl-loop for i from -10 by 0.3
finding i such-that #'cl-plusp) ; => 0.2000000000000009
(cl-loop for (key value) on '(:a 1 :c 3 :b 2) by #'cddr
finding key maximizing value) ; => :c
呃,似乎看到了一些不太干净的东西…不过不要紧,我们的寻找者基本正确工作!好诶!
经过我们戮力同心的探索,相信大家已经掌握如何扩展 cl-loop 啦w~需要注意的是, cl-loop 有两种扩展 handler :cl-loop-handler 和 cl-loop-for-handler ,后者可以用来实现诸如 loop for (key val) in-plist X 之类的功能,想必读者自证不难。如果大家有什么好点子,但自己的 Emacs buffer 篇幅有限写不太下,这边也提供工人智能无偿代写服务(
最后祝大家春节快乐, Happy Hacking! (っ´ω`)っ♡