一种基于Common Lisp的用lambda从头构建逻辑、整数、算数、斐波拉契的方案

绪论

本文参考视频教程，教程给出了一系列编程题目。该教程作者裘香莲已经基于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*))

程序分析

对于算数加，以以下步骤考虑：

1. 考虑num1+num2，其中num2=0，则结果为num1
2. 考虑num1+num2，其中num2≠0，则结果可以转换为(num1+1)+(num2-1)
3. 递归进行第2步的转换，直到符合第1步的情形

类似地，实现算数减。

对于算数乘，以以下步骤考虑：

1. 考虑num1*num2，其中num2=0，则结果为0
2. 考虑num1*num2，其中num2=1，则结果为num1
3. 考虑num1*num2，其中num2≠0且num2≠1，则问题可以转换为num1+num1*(num2-1)
4. 递归进行第3步的转换，直到符合第2步的情形

对于算数除，以以下步骤考虑：

1. 考虑num1/num2，其中num2=0，则不可能存在结果，但为了程序的鲁棒性，规定结果为0
2. 考虑num1/num2，其中num2≠0，且num1<num2，则结果为0（大小判断符号基于减号实现）
3. 考虑num1/num2，其中num2≠0，且num1≥num2，则问题可以转换为1+(num1-num2)/num2
4. 递归进行第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)

说明

尽管上述代码能够构造一种类似于链表的数据结构，但实际上并不是链表，而可以看成一种数组。

这是因为，链表的实现通常需要依靠类似与指针或者引用的概念，但lambda演算中并没有这种概念。要想有类似的概念，需要首先构造出一个模拟内存，这会产生难以接受的复杂程度。

本文构造出的类链表数据结构，存在以下缺陷：

1. 不能在指定位置删除结点
2. 不能在指定位置插入结点
3. 不能替换指定节点
4. 不能将链表的尾部指向自己的头部

由于整个构造是以函数为基础的，而我们无法修改已经定义的匿名函数内已经存在的内容。因此，在进行删除、插入、替换操作时，需要将结点重新生成；另一方面，这种构造是一种嵌套的形式，表明需要将大片结点拆除、重建。