Commonlisp

clingonclingon 是一个 Common Lisp 的命令行选项的解析器，它能够轻松地解析具备简单格局的命令行选项。例如，上面的代码能够打印给定次数的打招呼信息 #!/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的参数。而后别离定义一个command、handler，以及option。 ...

忆往昔峥嵘岁月稠在Python的语言规范的Comparisions章节中提到 Also unlike C, expressions like a < b < c have the interpretation that is conventional in mathematics也就是说，在C语言中要写成a < b && b < c的表达式，在Python中能够写成a < b < c。并且，规范中还提到 Comparisons can be chained arbitrarily, e.g., x < y <= z is equivalent to x < y and y <= z, except that y is evaluated only once (but in both cases z is not evaluated at all when x < y is found to be false).个别将这种性质成为短路。因而，像2 < 1 < (1 / 0)这样的表达式在Python中不会引发异样，而是返回False。 ...

在上一篇文章中，实现了对大于号（>）的处理，那么对if表达式的编译也就是信手拈来的事了，不解释太多。在本篇中，将会讲述一下如何产生可以调用来自于C语言标准库的exit(3)函数的汇编代码。 在Common Lisp中并没有一个叫做EXIT的内置函数，所以如同之前实现的_exit一样，我会新增一种需要识别的(first expr)，即符号exit。为了可以调用C语言标准库中的exit函数，需要遵循调用约定。对于exit这种只有一个参数的函数而言，情形比较简单，只需要跟对_exit一样处理即可。刚开始，我写下的代码是这样的 (defun jjcc2 (expr globals) ;; 省略不必要的内容 (cond ;; 省略不必要的内容 ((member (first expr) '(_exit exit)) ;; 暂时以硬编码的方式识别一个函数是否来自于C语言的标准库 `((movl ,(get-operand expr 0) %edi) (call :|_exit|)))))对(exit 1)进行编译，会得到如下的代码 .data .section __TEXT,__text,regular,pure_instructions .globl _main_main: MOVL $1, %EDI CALL _exit不过这样的代码经过编译链接之后，一运行就会遇到段错误（segmentation fault）。经过一番放狗搜索后，才知道原来在macOS上调用C函数的时候，需要先将栈对齐到16字节——我将其理解为将指向栈顶的指针对齐到16字节。于是乎，我将jjcc2修改为如下的形式 (defun jjcc2 (expr globals) ;; 省略不必要的内容 (cond ;; 省略不必要的内容 ((member (first expr) '(_exit exit)) ;; 暂时以硬编码的方式识别一个函数是否来自于C语言的标准库 `((movl ,(get-operand expr 0) %edi) ;; 据这篇回答（https://stackoverflow.com/questions/12678230/how-to-print-argv0-in-nasm）所说，在macOS上调用C语言函数，需要将栈对齐到16位 ;; 假装要对齐的是栈顶地址。因为栈顶地址是往低地址增长的，所以只需要将地址的低16位抹掉就可以了 (and ,(format nil "$0x~X" #XFFFFFFF0) %esp) (call :|_exit|)))))结果发现还是不行。最后，实在没辙了，只好先写一段简单的C代码，然后用gcc -S生成汇编代码，来看看究竟应当如何处理这个栈的对齐要求。一番瞎折腾之后，发现原来是要处理RSP寄存器而不是ESP寄存器——我也不晓得这是为什么，ESP不就是RSP的低32位而已么。 ...

原定的计划中这一篇应当是要讲如何编译if表达式的，但是我发现没什么东西可以作为if的test-form的部分的表达式，所以觉得，要不还是先实现一下比较两个数字这样子的功能吧。说干就干，我决定用大于运算符来作为例子——大于运算符就是指>啦。所以，我的目标是要编译下面这样的代码 (> 1 2)并且比较之后的结果要放在EAX寄存器中。鉴于现在这门语言还非常地简陋，没有布尔类型这样子的东西，所以在此仿照C语言的处置方式，以数值0表示逻辑假，其它的值表示逻辑真。所以上面的表达式在编译成汇编代码并最终运行后，应当可以看到EAX寄存器中的值为0。 为了编译大于运算符，并且将结果放入到EAX寄存器中，需要用到新的指令CMP、JG，以及JMP了。我的想法是，先将第一个操作数放入到EAX寄存器，将第二个操作数放入到EBX寄存器。然后，使用CMP指令比较这两个寄存器。如果EAX中的数值大于EBX，那么就使用JG指令跳到一个MOV指令上，这道MOV会将寄存器EAX的值修改为1；否则，JG不被执行，执行后续的一道MOV指令，将数值0写入到EAX寄存器，然后使用JMP跳走，避免又执行到了刚才的第一道MOV指令。思路还是挺简单的。 在修改jjcc2之前，还需要在inside-out/aux中对>予以支持，但没什么特别的，就是往member的参数中加入>这个符号而已。之后，将jjcc2改为如下的形式 (defun jjcc2 (expr globals) "支持两个数的四则运算的编译器" (check-type globals hash-table) (cond ((eq (first expr) '+) `((movl ,(get-operand expr 0) %eax) (movl ,(get-operand expr 1) %ebx) (addl %ebx %eax))) ((eq (first expr) '-) `((movl ,(get-operand expr 0) %eax) (movl ,(get-operand expr 1) %ebx) (subl %ebx %eax))) ((eq (first expr) '*) ;; 将两个数字相乘的结果放到第二个操作数所在的寄存器中 ;; 因为约定了用EAX寄存器作为存放最终结果给continuation用的寄存器，所以第二个操作数应当为EAX `((movl ,(get-operand expr 0) %eax) (movl ,(get-operand expr 1) %ebx) (imull %ebx %eax))) ((eq (first expr) '/) `((movl ,(get-operand expr 0) %eax) (cltd) (movl ,(get-operand expr 1) %ebx) (idivl %ebx))) ((eq (first expr) 'progn) (let ((result '())) (dolist (expr (rest expr)) (setf result (append result (jjcc2 expr globals)))) result)) ((eq (first expr) 'setq) ;; 编译赋值语句的方式比较简单，就是将被赋值的符号视为一个全局变量，然后将eax寄存器中的内容移动到这里面去 ;; TODO: 这里expr的second的结果必须是一个符号才行 ;; FIXME: 不知道应该赋值什么比较好，先随便写个0吧 (setf (gethash (second expr) globals) 0) (values (append (jjcc2 (third expr) globals) ;; 为了方便stringify函数的实现，这里直接构造出RIP-relative形式的字符串 `((movl %eax ,(get-operand expr 0)))) globals)) ((eq (first expr) '_exit) ;; 因为知道_exit只需要一个参数，所以将它的第一个操作数塞到EDI寄存器里面就可以了 ;; TODO: 更好的写法，应该是有一个单独的函数来处理这种参数传递的事情（以符合calling convention的方式） `((movl ,(get-operand expr 0) %edi) (movl #x2000001 %eax) (syscall))) ((eq (first expr) '>) ;; 为了可以把比较之后的结果放入到EAX寄存器中，以我目前不完整的汇编语言知识，可以想到的方法如下 (let ((label-greater-than (intern (symbol-name (gensym)) :keyword)) (label-end (intern (symbol-name (gensym)) :keyword))) ;; 根据这篇文章（https://en.wikibooks.org/wiki/X86_Assembly/Control_Flow#Comparison_Instructions）中的说法，大于号左边的数字应该放在CMP指令的第二个操作数中，右边的放在第一个操作数中 `((movl ,(get-operand expr 0) %eax) (movl ,(get-operand expr 1) %ebx) (cmpl %ebx %eax) (jg ,label-greater-than) (movl $0 %eax) (jmp ,label-end) ,label-greater-than (movl $1 %eax) ,label-end)))))然后便可以在REPL中运行下列代码了 ...

在上一篇文章中，新增了两个函数：inside-out以及inside-out/aux——曾经想过将inside-out/aux放到前者的函数中用labels来定义，但担心不好调试，所以剥离了出来成为一个独立的函数——inside-out基本上只是驱动了后者，真正地将嵌套表达式拆解开来的还是inside-out/aux。因此，为了让让这个编译器最终可以处理如下形式的代码 (_exit (+ (+ 1 2) 3))就需要先对inside-out/aux进行一番改造，使其可以处理上述代码。 在此之前，先处理一下inside-out/aux目前的一些问题。在之前的实现中，由于使用了setf对输入参数expr进行了修改，因此在example3中的列表实际上在第二次运行的时候已经不是代码中看到的那样子了。所以，先将inside-out/aux改写为更pure的形式 (defun inside-out/aux (expr result) "将嵌套的表达式EXPR由内而外地翻出来" (check-type expr list) ;; 出于简单起见，暂时只处理加法运算 (cond ((member (first expr) '(+ - * /)) (let ((operands '())) (if (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) (push var operands))) (push (second expr) operands)) (if (listp (third expr)) (let ((var (gensym))) (setf result (inside-out/aux (third expr) result)) (let ((val (pop result))) (push `(setq ,var ,val) result) (push var operands))) (push (third expr) operands)) (push (cons (first expr) (nreverse operands)) result) result)) (t (push expr result) result)))其实改动很简单，就是使用一个新的列表operands来承载被修改后的符号或原本的表达式而已。接下来可以开始支持_exit函数了。 ...

在上一篇文章中，jjcc2函数已经可以处理加减乘除运算表达式中的变量了。也就是说，现在它可以处理如下的代码了 (progn (setq a (+ 1 2)) (+ a a))在我的电脑上，在SLIME中依次运行下面的代码 (defvar *globals* (make-hash-table))(stringify (jjcc2 '(progn (setq a (+ 1 2)) (+ a a)) *globals*) *globals*)会得到下列的汇编代码 .dataA: .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 2) (+ 1 2))自动转换为上面所给出的progn的形式了。我这里给的例子不好，上面这段代码就算能够自动转换，也不会是最上面那段progn的形式的，起码会有两个变量哈哈。好了，那么怎么把上面的含有嵌套表达式的代码给转换成progn的形式呢？ ...

在上一篇文章中，jjcc2函数实现了对setq这个语句的编译。这么一来，便可以将加减乘除运算中的嵌套表达式都替换为变量了。比如，将 (+ (+ 1 2) 3)中的嵌套的表达式(+ 1 2)用一个变量G564代替，变成 (PROGN (SETQ #:G564 (+ 1 2)) (+ #:G564 3))PS：上面的结果中的#:G564只是打印出来的时候长这个样子而已，实际地输入这段代码的话，两个#:G564其实是不同的符号，会导致未绑定的变量的错误的。 言归正传。既然如此，现在就要来支持编译(+ #:G564 3)这样的表达式了。其实这个真的是太简单了，只需要将这个符号塞入到jjcc2的第二个参数的globals中，然后在生成的“汇编指令”的S表达式中，嵌入这个符号即可。 我刚开始的时候也是这么想的，后来发现这样出来的代码编译不过，哭 折腾了一小段时间后，才知道原来有一种叫做“RIP-relative”的东西——好吧，我的X64的汇编语言知识也是赶鸭子上架的，遇到什么问题就放狗搜，所以完全不成体系——总之，我找到了解决办法，就是将原本放入一个符号的操作数，替换为类似于下面这样的内容 G564(%RIP)所以对于操作数，实际上还需要先判断一下其类型。如果是整数，就按照原来的方式原样输出；如果是符号，就生成像上面这样的RIP-relative的结构。这部分太经常出现了，于是提炼出了一个专门处理四则运算的操作数的辅助函数get-operand (defun get-operand (expr n) "从EXPR中提取出第N个操作数，操作数的下标从0开始计算" (check-type expr list) (check-type n integer) (let ((e (nth (1+ n) expr))) (etypecase e (integer e) (symbol (format nil "~A(%RIP)" e)))))借助它重写jjcc2，结果如下 (defun jjcc2 (expr globals) "支持两个数的四则运算的编译器" (check-type globals hash-table) (cond ((eq (first expr) '+) `((movl ,(get-operand expr 0) %eax) (movl ,(get-operand expr 1) %ebx) (addl %ebx %eax))) ((eq (first expr) '-) `((movl ,(get-operand expr 0) %eax) (movl ,(get-operand expr 1) %ebx) (subl %ebx %eax))) ((eq (first expr) '*) ;; 将两个数字相乘的结果放到第二个操作数所在的寄存器中 ;; 因为约定了用EAX寄存器作为存放最终结果给continuation用的寄存器，所以第二个操作数应当为EAX `((movl ,(get-operand expr 0) %eax) (movl ,(get-operand expr 1) %ebx) (imull %ebx %eax))) ((eq (first expr) '/) `((movl ,(get-operand expr 0) %eax) (cltd) (movl ,(get-operand expr 1) %ebx) (idivl %ebx))) ((eq (first expr) 'progn) (let ((result '())) (dolist (expr (rest expr)) (setf result (append result (jjcc2 expr globals)))) result)) ((eq (first expr) 'setq) ;; 编译赋值语句的方式比较简单，就是将被赋值的符号视为一个全局变量，然后将eax寄存器中的内容移动到这里面去 ;; TODO: 这里expr的second的结果必须是一个符号才行 ;; FIXME: 不知道应该赋值什么比较好，先随便写个0吧 (setf (gethash (second expr) globals) 0) (values (append (jjcc2 (third expr) globals) ;; 为了方便stringify函数的实现，这里直接构造出RIP-relative形式的字符串 `((movl %eax ,(get-operand expr 0)))) globals))))现在，如果运行下面的这个example1函数 ...

Common Lisp中的setq类似于其它语言中的赋值语句，它可以给一个符号对象设定一个值，类似于将一个值赋值给一个变量一样。简单起见，在jjcc2中，我会将所有的符号都作为全局的一个label来实现。也就是说，如果代码中出现了 (setq a 1)这样的代码，那么在最后生成的代码中，就会相应的在.data段中有一个同名的label，其中存放着数值1。 既然都是全局变量，那么只需要准备一个容器来盛这些变量名即可。现阶段，暂时认为所有的变量都是数值类型即可。简单起见，这个容器直接用Common Lisp内置的HASH-TABLE来表示。 当在jjcc2函数中遭遇到setq这个符号时，整个表的形态是这样的 (setq var form)这时候，首先要将var放入到记录全局变量的哈希表中。然后，递归地调用jjcc2函数，先编译form，得到一系列的汇编代码。然后，生成一条mov语句，将eax寄存器中的内容放到var所指的内存位置中。最终的jjcc2的代码如下 (defun jjcc2 (expr globals) "支持两个数的四则运算的编译器" (check-type globals hash-table) (cond ((eq (first expr) '+) `((movl ,(second expr) %eax) (movl ,(third expr) %ebx) (addl %ebx %eax))) ((eq (first expr) '-) `((movl ,(second expr) %eax) (movl ,(third expr) %ebx) (subl %ebx %eax))) ((eq (first expr) '*) ;; 将两个数字相乘的结果放到第二个操作数所在的寄存器中 ;; 因为约定了用EAX寄存器作为存放最终结果给continuation用的寄存器，所以第二个操作数应当为EAX `((movl ,(second expr) %eax) (movl ,(third expr) %ebx) (imull %ebx %eax))) ((eq (first expr) '/) `((movl ,(second expr) %eax) (cltd) (movl ,(third expr) %ebx) (idivl %ebx))) ((eq (first expr) 'progn) (let ((result '())) (dolist (expr (rest expr)) (setf result (append result (jjcc2 expr globals)))) result)) ((eq (first expr) 'setq) ;; 编译赋值语句的方式比较简单，就是将被赋值的符号视为一个全局变量，然后将eax寄存器中的内容移动到这里面去 ;; TODO: 这里expr的second的结果必须是一个符号才行 ;; FIXME: 不知道应该赋值什么比较好，先随便写个0吧 (setf (gethash (second expr) globals) 0) (values (append (jjcc2 (third expr) globals) ;; 为了方便stringify函数的实现，这里直接构造出RIP-relative形式的字符串 `((movl %eax ,(format nil "~A(%RIP)" (second expr))))) globals))))然后还需要修改stringify函数，现在它需要处理传给jjcc2的全局变量的哈希表，将其转化为对应的.data段的声明。代码如下 ...

progn是什么玩意progn是Common Lisp里面的一个special operator，见这份文档的说明：http://clhs.lisp.se/Body/s_pr... 为嘛要编译这东西现在已经支持了二元四则运算了，但现在这里有一个大问题，就是这四个运算没办法嵌套着组合使用。比如，遇到下面这样的代码，jjcc2函数就懵逼了 (+ 1 (+ 2 3))那要编译这种代码的话怎么办呢？一个比较直观的做法，是引入临时变量，来保存嵌套在其中的表达式的求值结果，然后再用变量来代替原本嵌套的表达式。修改后的代码可能长这个样子 (setq a (+ 2 3))(+ 1 a)显然，这是有先后的时间依赖关系的两条语句，因此应当使用progn将它们包裹起来，结果如下 (progn (setq a (+ 2 3)) (+ 1 a))这样整个表达式的求值结果，或者说它被编译之后的运行结果，应当就是在寄存器EAX中放入整数6了。所以，本篇将来解决对progn的编译问题。 如何编译progn其实很简单，progn可能有不定数量的form在其中，那么只需要按照顺序对它们一个个进行编译，输出汇编代码就可以了，因此最终jjcc2被修改为如下的样子 (defun jjcc2 (expr) "支持两个数的四则运算的编译器" (cond ((eq (first expr) '+) `((movl ,(second expr) %eax) (movl ,(third expr) %ebx) (addl %ebx %eax))) ((eq (first expr) '-) `((movl ,(second expr) %eax) (movl ,(third expr) %ebx) (subl %ebx %eax))) ((eq (first expr) '*) ;; 将两个数字相乘的结果放到第二个操作数所在的寄存器中 ;; 因为约定了用EAX寄存器作为存放最终结果给continuation用的寄存器，所以第二个操作数应当为EAX `((movl ,(second expr) %eax) (movl ,(third expr) %ebx) (imull %ebx %eax))) ((eq (first expr) '/) `((movl ,(second expr) %eax) (cltd) (movl ,(third expr) %ebx) (idivl %ebx))) ((eq (first expr) 'progn) (let ((result '())) (dolist (expr (rest expr)) (setf result (append result (jjcc2 expr)))) result))))就酱就足够了。下一篇，是时候讲一下如何编译setq了。 ...

在上一篇文章中，初步搭建了一个输入Common Lisp代码，输出汇编代码的编译器的骨架，实现了二元整数的加法运算。在这个基础上，要想实现减法、乘法，以及除法就是手到擒来的事情了。只需依葫芦画瓢，补充更多的分支情况即可。 我自己模仿着x64的调用约定，规定四则运算的结果始终放在EAX这个寄存器中。在稍后给出的代码中，对于减法和除法运算，都是把运算符的左操作数放到EAX寄存器中，再从EAX中减去或者除掉右操作数。 在摸索除法的汇编代码怎么生成时，遇到了个费解的问题，最后才知道，原来需要把EAX寄存器的符号扩展到高位的EDX寄存器中去。对于as这个汇编器来说，需要用到CLTD指令。 最后，jjcc2和stringify两个函数被修改为如下的样子 (defun jjcc2 (expr) "支持两个数的四则运算的编译器" (cond ((eq (first expr) '+) `((movl ,(second expr) %eax) (movl ,(third expr) %ebx) (addl %ebx %eax))) ((eq (first expr) '-) `((movl ,(second expr) %eax) (movl ,(third expr) %ebx) (subl %ebx %eax))) ((eq (first expr) '*) ;; 将两个数字相乘的结果放到第二个操作数所在的寄存器中 ;; 因为约定了用EAX寄存器作为存放最终结果给continuation用的寄存器，所以第二个操作数应当为EAX `((movl ,(second expr) %eax) (movl ,(third expr) %ebx) (imull %ebx %eax))) ((eq (first expr) '/) `((movl ,(second expr) %eax) (cltd) (movl ,(third expr) %ebx) (idivl %ebx)))))(defun stringify (asm) "根据jjcc2产生的S表达式生成汇编代码字符串" (format t " .section __TEXT,__text,regular,pure_instructions~%") (format t " .globl _main~%") (format t "_main:~%") (dolist (ins asm) (cond ((= (length ins) 3) (format t " ~A ~A, ~A~%" (first ins) (if (numberp (second ins)) (format nil "$~A" (second ins)) (second ins)) (if (numberp (third ins)) (format nil "$~A" (third ins)) (third ins)))) ((= (length ins) 2) (format t " ~A ~A~%" (first ins) (if (numberp (second ins)) (format nil "$~A" (second ins)) (second ins)))) ((= (length ins) 1) (format t " ~A~%" (first ins))))) (format t " movl %eax, %edi~%") (format t " movl $0x2000001, %eax~%") (format t " syscall~%"))全文完。 ...

本文很水。 有一天，我心血来潮想要写一个将Common Lisp编译成汇编（x64那种）的编译器。我喜欢Common Lisp这门语言，它非常好玩，有许多有趣的特性（宏、condition system等），并且它的生态很贫瘠，有很多造轮子的机会。因为我懂的还不够多，所以没法从源代码一步到位生成可执行文件，只好先输出汇编代码，再利用现成的汇编器（比如as、nasm）从这些输出内容生成可执行文件。至于这东西是不是真的算是编译器，我也不是很在意。 好了，我要开始表演了。 你可能看过龙书，或者其它比较经典的编译原理和实践方面的书。那你应该会知道，编译器还蛮复杂的。但我水平有限，把持不住工业级的产品那么精妙的结构和代码，所以我的编译器很简陋——简陋到起码这个版本一眼就看到尽头了。 尽管简陋，但身为一名业余爱好者，尝试开发这么一个玩具还是很excited的。由于编译器本身也是用Common Lisp写的，所以就偷个懒不写front end的部分了，聚焦于从CL代码到汇编代码的实现。 先从最简单的一种情况——二元整数的加法入手，比如下面这段代码 (+ 1 2)对于加法，可以输出ADDL指令，两个参数则随便找两个寄存器放进去就好了。一段简单得不能再简单的代码一下子就写出来了 (defun jjcc2 (expr) "支持两个数的四则运算的编译器" (cond ((eq (first expr) '+) `((movl ,(second expr) %eax) (movl ,(third expr) %ebx) (addl %eax %ebx)))))(defun stringify (asm) "根据jjcc2产生的S表达式生成汇编代码字符串" (format t " .section __TEXT,__text,regular,pure_instructions~%") (format t " .globl _main~%") (format t "_main:~%") (dolist (ins asm) (format t " ~A ~A, ~A~%" (first ins) (if (numberp (second ins)) (format nil "$~A" (second ins)) (second ins)) (if (numberp (third ins)) (format nil "$~A" (third ins)) (third ins)))) (format t " movl %ebx, %edi~%") (format t " movl $0x2000001, %eax~%") (format t " syscall~%"))在 REPL 中像下面这样运行 ...

作为一名自诩的non-trivial的Common Lisp程序员，在编码的时候经常会遇到令人不愉快的地方，其中一个便是LET。一段典型的LET的示例代码如下(let ((a 1)) a)大多数时候，LET不会只有一个绑定。并且，也不会只是绑定一个常量这么简单，而应当是下面这样的(let ((a (foo x y)) (b (bar z))) (function1 a b) (function2 a b))有时候我会想看看某一个绑定的值——最好是在它计算完毕后立即查看。如果要查看foo函数的返回值，可以这样写(let ((a (foo x y)) (b (bar z))) (print a) (function1 a b) (function2 a b))如果调用foo和bar都顺利的话上面的代码也就够了。比较棘手的情况是，如果a的值不符合预期，会导致b的计算过程出状况（尽管在上面的代码中看似不会）。这种情况多出现在LET的使用中，如下面所示(let ((a (foo x y)) (b (bar a))) (function1 a b) (function2 a b))如果错误的a会导致bar的调用出错，那么在调用function1之前才调用print打印a已经为时过晚了——毕竟调用bar的时候就抛出condition往调用链的上游走了。一种方法是写成下面这样子(let* ((a (let ((tmp (foo x y))) (print tmp) tmp)) (b (bar a))) (function1 a b) (function2 a b))这也太丑了！要不然写成下面这样子？(let ((a (foo x y))) (print a) (let ((b (bar a))) (function1 a b) (function2 a b)))本来一个LET就可以做到的事情，这下子用了两个，还导致缩进更深了一级。如果有十个变量需要打印，就会增加十个LET和十层缩进。如果心血来潮想查看一个变量的值，还要大幅调整代码。问题大概就出在LET和LET*的语法上。以LET为例，它由截然分开的bindings和forms组成，两者不能互相穿插。因此，如果想在bindings中求值一段表达式，只能将bindings切开，写成两个LET的形式。好像写一个新的宏可以解决这个问题？是的，vertical-let就是。vertical-let是一个我自己写的宏，源代码在此。其用法如下(vertical-let :with a = 1 a)它借鉴了LOOP中绑定变量的方式（即:with和=），绑定变量和用于求值的代码还可以交织在一起，如下(vertical-let :with a = 1 (print a) :with b = 2 (+ a b))vertical-let最终会展开为LET，比如上面的代码，会展开为如下的代码(LET ((A 1)) (PRINT A) (LET ((B 2)) (+ A B)))vertical-let的算法很简单。它遍历表达式列表，当遇到:with时就把接下来的三个元素分别视为变量名、等号，以及待求值的表达式，将三者打包进一个列表中，再压栈；当遇到其它值时，就视为待求值的表达式（将会组成LET的forms部分），也放进列表中再压栈（具体方法参见源代码）。将所有值都遍历并压栈后，接下来要遍历这个栈中的元素。先准备两个空的栈——一个存放bindings，一个存放forms。接着，对于每一个从栈中弹出的元素，分为如下两种情况：如果表示binding，则直接压入存放bindings的栈，否则；如果是待求值的表达式，并且上一个出栈的元素是binding，则说明已经有一段完整的LET的内容被集齐。因此，将目前在两个栈中的内容全部弹出，组合为一个LET表达式再压入存放forms的栈中。然后将方才弹出的表达式也压入forms。重复上述过程直至所有元素都被处理，最后将还在两个栈中的内容也组合为一个LET表达式便结束了。全文完 ...

大学的时候挺喜欢解Project Euler上的题目的，尤其是它不在乎答题者使用哪一门编程语言，甚至还有很多参与者是使用pen&paper来解题的。去年开始重新开始做Project Euler上的题目，而第69题则是最近刚刚解决的一题。惭愧的是，因为不晓得欧拉函数的计算公式（甚至都没有想过欧拉函数有没有可以用来计算的公式），所以这一题我是用暴力计算的方法来解决的。尽管花了40分钟左右才找出了问题的答案，但欧拉函数的计算方法本身还是让我觉得挺有意思的，下面我就来讲讲我在计算欧拉函数方面做的一些尝试。69题本身很容易读懂，就是要找到一个不大于一百万的正整数n，这个n与以它为参的欧拉函数值的比值能够达到最大。欧拉函数的介绍可以看维基百科，简而言之，就是在不大于n的正整数中与n互质的数的个数，具体的例子可以参见69题描述中给出的表格。网上可以找到别人的解法，基本的思路是：按从小到大的顺序，对于一百万以内的每个素数，都计算出它们的倍数的欧拉函数值的一部分——即对于素数p计算出1-1/p并与这个位置上原来的值相乘。当遍历完一百万以内的所有素数后，也就计算出每一个位置上的欧拉函数值，再遍历一次就可以计算出比值最大的数字了。但我今天要讲的是笨方法。笨方法的关键就是乖巧地计算出每一个数字的欧拉函数值。而其中最笨的，当属挑出每一个不大于n的因数，计算它们与n的最大公约数，并根据这个最大公约数是否为1，来决定是否给某一个计数器加一。示例代码如下(defun phi (n) (let ((count 0)) (dotimes (i n count) (when (= (gcd (1+ i) n) 1) (incf count)))))这个phi可以稍微改进一下。例如，如果一个数a与n不是互质的，那么a的倍数（小于n的那一些）也一定不会与n互质。因此，每当遇到这么一个因数a，就知道后续的2a、3a等等，都不再需要计算其与n的最大公约数了。改进后的算法代码如下(defun phi (n) “通过将不互质的比特设置为1并计算为0的比特的个数来计算phi函数” (let ((bits (make-array n :element-type ‘bit :initial-element 0)) (count 0)) (dotimes (i n) (cond ((= (bit bits i) 1) ;; 该比特已经为1，说明已经在比它小的倍数被处理时一并被标记了 ) ((= i (1- n)) ;; 只处理比上界要小的数字 ) ((/= (gcd (1+ i) n) 1) ;; 除了当前这个不互质的数字之外，还需要将这个数字的倍数也一并处理 (dotimes (j (floor n (1+ i))) (let* ((j (1+ j)) (m (* (1+ i) j))) (setf (bit bits (1- m)) 1)))) (t (incf count)))) count))为了节省内存空间，这里用了一个bitmap来标记小于n的每一个数字是否与n互质——1表示不互质，0表示互质。其实并不需要遍历所有比n小的数字，只要遍历所有n的素因子即可。比如，将8分解为素因子，就是3个2，那么对于小于8的所有2的倍数（4和6）都是与8不互质的。基于这个方法，将所有的素因子的倍数所对应的位置为1，再数一下总共有多少个0比特即可。对每个n都进行质因数分解效率不高，先生成一个一百万以内的素数表吧(defun primep (n) (cond ((< n 2) nil) ((= 2 n) t) (t (let ((bnd (truncate (sqrt n)))) (labels ((rec (test) (cond ((> test bnd) t) ((= 0 (rem n test)) nil) (t (rec (1+ test)))))) (rec 2))))))(defvar primes-in-1000000 nil)(defun generate-primes-in-1000000 () (dotimes (i 1000000) (when (primep (1+ i)) (push (1+ i) primes-in-1000000))) (setf primes-in-1000000 (nreverse primes-in-1000000)))然后对于一个给定的n，遍历所有小于它的素数并对相应的倍数所在的比特置一就可以了，示例代码如下(defun phi3 (n) “直接用素数表来做筛法” (prog ((bits (make-array n :element-type ‘bit :initial-element 0))) (dolist (num primes-in-1000000) (cond ((> num n) (go :return)) ((zerop (mod n num)) (labels ((aux (i) (when (< i n) (setf (bit bits i) 1) (aux (+ i num))))) (aux (1- num)))))) :return (return-from phi3 (count-if (lambda (bit) (zerop bit)) bits))))PS：写这个phi3的时候发现Common Lisp提供了一个prog宏，这个宏倒是真的挺好用。改进了两轮，其实这仍然是笨方法。即便是用phi3，用来计算题目的答案也花了40多分钟。全文完 ...