绪论
本文参考视频教程，教程给出了一系列编程题目。该教程作者裘香莲已经基于JavaScript，用lambda运算从头构建了一系列编程基础概念。本文则对其编程题以Common Lisp语言另外给出答案。
逻辑与判断的实现
代码展示
(defparameter *t*
(lambda (opt1 opt2)
`,opt2 (funcall opt1)))
(defparameter *f*
(lambda (opt1 opt2)
`,opt1 (funcall opt2)))
;(defun *if* (cnd opt1 opt2) ;非惰性求值，使用时需要在选项处手动增加lambda封装
; (funcall cnd opt1 opt2))
(defmacro lazy-if (cnd opt1 opt2) ;惰性求值
`(funcall ,cnd
(lambda () ,opt1)
(lambda () ,opt2)))
(defun op-not(cnd)
(lazy-if cnd *f* *t*))
(defun op-or (cnd1 cnd2)
(lazy-if cnd1
*t*
(lazy-if cnd2 *t* *f*)))
(defun op-and (cnd1 cnd2)
(lazy-if cnd1
(lazy-if cnd2 *t* *f*)
*f*))
程序分析
其中，原*if*（已被注释）以函数作为参数，这是《实用Common Lisp编程》中展示的一种编程特色，即某函数foo本身只提供抽象框架，具体功能依靠以参数形式输入的函数method决定。因此，可以通过控制函数method，显著改变函数foo的功能，从而实现高度可定制化。
考虑原*if*、*t*、*f*的一种简单实现方式：
(defparameter *t*
(lambda (opt1 opt2) `,opt1))
(defparameter *f*
(lambda (opt1 opt2) `,opt2))
(defun *if* (cnd opt1 opt2)
(funcall cnd opt1 opt2))
其中由于*if*是一个函数，opt1、opt2的值在*if*分支中，首先直接求值，然后将值传递进入函数*if*。但这种实现方式有着重大问题：
- 在实际使用中，往往不希望if的某一分支实际执行
- 更多情形下，往往是为了避免某些操作的执行、减少意外，所以才使用if语句
为了解决这个问题，引入惰性求值，即传入*if*函数的实际上是以lambda表达式包裹而形成的函数；而在设计*t*、*f*函数时，函数体中应当实际执行该lambda表达式，从而释放出被包裹的表达式。
(defparameter *t*
(lambda (opt1 opt2)
`,opt2 (funcall opt1)))
(defparameter *f*
(lambda (opt1 opt2)
`,opt1 (funcall opt2)))
(defun *if* (cnd opt1 opt2)
(funcall cnd opt1 opt2))
但该实现仍然存在不便之处：引入惯性加载后，*if*的分支需要手动用lambda表达式包裹，否则会导致执行错误。
为了解决这个问题，引入Common Lisp的概念：宏。与其它语言一样，Common Lisp的宏同样是一种文本替换。但由于Lisp语法本身的特点，Lisp语言的宏获得了极大的灵活性。甚至有人声称，Lisp宏具有无穷的可定制性。定义宏lazy-if：
(defmacro lazy-if (cnd opt1 opt2) ;惰性求值
`(funcall ,cnd
(lambda () ,opt1)
(lambda () ,opt2)))
进而，可以借助lazy-if来实现逻辑非、逻辑或、逻辑与。至此，逻辑与判断部分实现完毕。
自然数
代码展示
;;;; 自然数
(defparameter *0*
(lambda (o)
`(,o)))
(defun *0*-p (num)
(if (eql num *0*)
*t* *f*))
(defmacro *1*+ (自然数)
`(lambda ()
,自然数))
(defun *1*- (自然数)
(lazy-if (*0*-p 自然数)
*0*
(funcall 自然数)))
(defparameter *1* (*1*+ *0*))
(defparameter *2* (*1*+ *1*))
(defparameter *3* (*1*+ *2*))
(defparameter *4* (*1*+ *3*))
(defparameter *5* (*1*+ *4*))
(defparameter *6* (*1*+ *5*))
(defparameter *7* (*1*+ *6*))
(defparameter *8* (*1*+ *7*))
(defparameter *9* (*1*+ *8*))
程序分析
对于自然数零的定义，是任意的。关键在于定义自然数后继的规则。
可以通过lambda表达式的一层包裹来代替后继。
(defmacro *1*+ (自然数)
`(lambda ()
,自然数))
类似地，前继则通过剥离lambda表达式来实现。其中，定义零的前继也是零。
(defun *1*- (自然数)
(lazy-if (*0*-p 自然数)
*0*
(funcall 自然数)))
至此，自然数部分构建完毕。
算数
代码展示
(defun *1*-p (num)
(lazy-if (*0*-p num) *f*
(lazy-if (*0*-p (*1*- num))
*t* *f*)))
(defun *+* (num1 num2)
(lazy-if (*0*-p num2)
num1
(*+* (*1*+ num1) (*1*- num2))))
(defun *-* (num1 num2)
(lazy-if (*0*-p num2)
num1
(*-* (*1*- num1) (*1*- num2))))
(defun *mul* (num1 num2)
(labels ((multi-not-*0* (base times sum)
(lazy-if (*1*-p times)
sum
(multi-not-*0* base
(*1*- times)
(*+* base sum)))))
(lazy-if (*0*-p num2)
*0*
(multi-not-*0* num1 num2 num1))))
(defun *div* (num1 num2)
(labels ((loop-er (num1 num2 商)
(lazy-if (*<* num1 num2)
商
(let ((剩余 (*-* num1 num2)))
(loop-er 剩余
num2
(*1*+ 商))))))
(lazy-if (*0*-p num2) *0* ; 任何数除以0均为0，可以接受
(loop-er num1 num2 *0*))))
(defun *eql* (num1 num2)
(lazy-if (op-and (*0*-p (*-* num1 num2))
(*0*-p (*-* num2 num1)))
*t* *f*))
(defun *<* (num1 num2)
(lazy-if (op-not (*0*-p (*-* num2 num1)))
*t* *f*))
(defun *>* (num1 num2)
(lazy-if (op-not (*0*-p (*-* num1 num2)))
*t* *f*))
程序分析
对于算数加，以以下步骤考虑：
- 考虑
num1+num2，其中num2=0，则结果为num1 - 考虑
num1+num2，其中num2≠0，则结果可以转换为(num1+1)+(num2-1) - 递归进行第2步的转换，直到符合第1步的情形
类似地，实现算数减。
对于算数乘，以以下步骤考虑：
- 考虑
num1*num2，其中num2=0，则结果为0 - 考虑
num1*num2，其中num2=1，则结果为num1 - 考虑
num1*num2，其中num2≠0且num2≠1，则问题可以转换为num1+num1*(num2-1) - 递归进行第3步的转换，直到符合第2步的情形
对于算数除，以以下步骤考虑：
- 考虑
num1/num2，其中num2=0，则不可能存在结果，但为了程序的鲁棒性，规定结果为0 - 考虑
num1/num2，其中num2≠0，且num1<num2，则结果为0（大小判断符号基于减号实现） - 考虑
num1/num2，其中num2≠0，且num1≥num2，则问题可以转换为1+(num1-num2)/num2 - 递归进行第4步的转换，直到符合第2步的情形
根据以上步骤，每种算术都能以简洁、美观的递归形式写出。但为了考虑到利用Common Lisp的尾递归优化，所以笔者在函数内通过labels宏定义了内部函数loop-er。有些Common Lisp实现具有尾递归优化机制，例如笔者使用的SBCL。为了利用尾递归优化，所必须的是，函数体内在递归调用结束后不存在后续操作。
通过减法来实现大小判断符号，这里不再赘述。
斐波那契
(defun 展现-01 (自然数)
(labels ((loop-er (自然数 disp-num)
(lazy-if (*0*-p 自然数)
disp-num
(loop-er (*1*- 自然数) (1+ disp-num)))))
(loop-er 自然数 0)))
(defun 构造 (digit)
(labels ((loop-er (自然数 digit)
(if (> digit 0)
(loop-er (*1*+ 自然数) (1- digit))
自然数)))
(loop-er *0* digit)))
(defun 斐波那契 (第几个月)
(lazy-if (op-or (*0*-p 第几个月)
(*1*-p 第几个月))
*1*
(*+* (斐波那契 (*-* 第几个月 *1*)) (斐波那契 (*-* 第几个月 *2*)))))
; (展现-01 (斐波那契 (构造 10)))
; => 89
链表
;; 双空间储物柜
(defmacro 柜 (物1 物2)
`(lambda (勺) (funcall 勺 ,物1 ,物2)))
(defparameter 勺1 (lambda (物1 物2) 物2 物1))
(defparameter 勺2 (lambda (物1 物2) 物1 物2))
(defun 取1 (柜) (funcall 柜 勺1)) ; 精简指令
(defun 取2 (柜) (funcall 柜 勺2))
; (取1 (柜 'foo 'bar))
; => foo
; (取1 (取2 (柜 'foo (柜 'bar 'baz))))
; => bar
;; 链表
(defun 插 (链 elem) (柜 链 elem))
(defun 创-链 () (柜 *t* *t*))
(defun empty-p (链)
(if (eql (取1 链) *t*) ; lazy-if 不能处理*t*, *f*以外的值
*t* *f*))
; 展现-链 原实现方式: 已删除
(defun exist-链 (链 cond-p)
(lazy-if (empty-p 链) *f*
(let ((elem (取2 链))
(子 (取1 链)))
(lazy-if (funcall cond-p elem) *t*
(exist-链 子 cond-p)))))
(defun find-链 (链 cond-p)
(lazy-if (empty-p 链) *f*
(let ((elem (取2 链))
(子 (取1 链)))
(lazy-if (funcall cond-p elem) elem
(find-链 子 cond-p)))))
; map-链, 逆-链 原实现方式: 已删除
;; 优化
(defun reduce-链* (链 method init)
"链表聚合；符合尾递归的写法"
(labels ((loop-er (链 value)
(lazy-if (empty-p 链) value ; 判断为空链
(let* ((子 (取1 链))
(elem (取2 链))
(new-value (funcall method elem value)))
(loop-er 子 new-value)))))
(loop-er 链 init)))
; (展现-01 (reduce-链* *12345* (lambda (pre next) (*+* pre next)) *0*))
; => 15
(defun 展现-链* (链)
"符合尾递归形式的展现链表
tail(原head) 被置于最后，这只是很小的一个代价"
(reduce-链* 链
(lambda (elem value) (cons elem value))
'(tail)))
; (展现-链* (插(插(插(插(插(创-链) '上) '海) '自) '来) '水))
; => (上 海 自 来 水 TAIL)
(defun map-链* (链 cond-p)
"符合尾递归形式的映射链表
逻辑的值并不直观（显示为函数的内存地址），所以改以符号的形式显示"
(reduce-链* 链
(lambda (elem value)
(let ((elem-boolean (if (eql *t* (funcall cond-p elem))
'*t* '*f*)))
(cons elem-boolean value)))
'(tail)))
; (defvar *12345* (插(插(插(插(插 (创-链) *1*) *2*) *3*) *4*) *5*))
; (map-链* *12345* (lambda (elem) (*>* elem *2*)))
; => (*F* *F* *T* *T* *T* TAIL)
(defun 逆-链* (链)
"符合尾递归形式的逆序链表"
(reduce-链* 链
(lambda (elem value) (插 value elem))
(创-链)))
; (展现-链* (逆-链* (插(插(插(插(插(创-链) '上) '海) '自) '来) '水)))
; => (水 来 自 海 上 TAIL)