拆解嵌套的表达式

上一篇文章中,jjcc2函数已经可以处理加减乘除运算表达式中的变量了。也就是说,现在它可以处理如下的代码了

1
2
3
(progn
(setq a (+ 1 2))
(+ a a))

在我的电脑上,在SLIME中依次运行下面的代码

1
2
(defvar *globals* (make-hash-table))
(stringify (jjcc2 '(progn (setq a (+ 1 2)) (+ a a)) *globals*) *globals*)

会得到下列的汇编代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
        .data
A: .long 0
.section __TEXT,__text,regular,pure_instructions
.globl _main
_main:
MOVL $1, %EAX
MOVL $2, %EBX
ADDL %EBX, %EAX
MOVL %EAX, A(%RIP)
MOVL A(%RIP), %EAX
MOVL A(%RIP), %EBX
ADDL %EBX, %EAX
movl %eax, %edi
movl $0x2000001, %eax
syscall

现在所需要的,就是要实现一个功能(一般是一个函数),可以将

1
(+ (+ 1 2) (+ 1 2))

自动转换为上面所给出的progn的形式了。我这里给的例子不好,上面这段代码就算能够自动转换,也不会是最上面那段progn的形式的,起码会有两个变量哈哈。好了,那么怎么把上面的含有嵌套表达式的代码给转换成progn的形式呢?

跑个题,可以做个CPS变换呀。比如,你可以先把(+ (+ 1 2) (+ 1 2))写成这种形式

1
2
3
(+& 1 2 (lambda (a)
(+& 1 2 (lambda (b)
(+ a b)))))

上面的+&表示它是一个带continuation版本的加法运算,它会把两个操作相加之后调用它的continuation。这个写法如果没有记错的话,我是从PG的《On Lisp》里面学来的(逃

你看,这多简单呀。做完CPS变换之后,只要把每一个有continuation的函数调用都重写成setq,符号就用回调里的参数名,值就是带回调的表达式本身;没有回调的就继续没有。最后把这些setq放到一个progn里去就可以了

1
2
3
4
(progn
(setq a (+ 1 2))
(setq b (+ 1 2))
(+ a b))

很久以前还真的写过一个对表达式做CPS变换的玩意,有兴趣的请移步这篇文章

言归正传。因为jjcc2只需要处理两个参数的加减乘除运算,所以不需要做通用的CPS变换那么复杂。我是这么想的:既然只有两个参数,那么我就真的在代码里先处理第一个再处理第二个。对两个参数,我都把它们放到一个setq的求值部分,然后把原来的表达式中的对应位置用一个新的变量名来代替即可,新变量名也好办,只要用gensym来生成就可以了。

其实这样是不够的,因为作为加减乘除运算的操作数的表达式本身,也可能还有嵌套的子表达式。这里必然有一个递归的过程。新的办法是,我用一个栈来存放所有不再需要被拆解的setq表达式,然后把这个栈在每次递归调用的时候传进去。这样一来,当所有的递归都结束的时候,就得到了一个充满了setq表达式的栈,以及一个所有的嵌套表达式都被替换为变量名的“顶层”表达式。

好了,说完了思路,上代码吧

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
(defun inside-out/aux (expr result)
"将嵌套的表达式EXPR由内而外地翻出来"
(check-type expr list)
;; 出于简单起见,暂时只处理加法运算
(cond ((eq (first expr) '+)
(when (listp (second expr))
;; 第一个操作数也是需要翻出来的
;; 翻出来后,result中的第一个元素就是一个没有嵌套表达式的叶子表达式了,可以作为setq的第二个操作数
(let ((var (gensym)))
(setf result (inside-out/aux (second expr) result))
(let ((val (pop result)))
(push `(setq ,var ,val) result)
(setf (second expr) var))))
(when (listp (third expr))
(let ((var (gensym)))
(setf result (inside-out/aux (third expr) result))
(let ((val (pop result)))
(push `(setq ,var ,val) result)
(setf (third expr) var))))
(push expr result)
result)
(t
(push expr result)
result)))

(defun inside-out (expr)
(cons 'progn (nreverse (inside-out/aux expr '()))))

因为用的是栈(其实就是个list),所以最后需要用nreverse反转一下,才能拼上progn。现在,如果喂给inside-out一个嵌套的表达式

1
(inside-out '(+ (+ 1 2) (+ 3 4)))

就会得到一个由内而外地翻出来的版本

1
2
3
4
(PROGN
(SETQ #:G688 (+ 1 2))
(SETQ #:G689 (+ 3 4))
(+ #:G688 #:G689))

锵锵锵,Common Lisp中的unintern symbol再次登场。好了,现在即便是嵌套的加减乘除运算的表达式,只要先经过inside-out处理一下,再喂给jjcc2,也可以编译出结果来了,可喜可贺。

全文完。