The Little Schemer

1) Toys

atom是什么? - 字符串 - 符号 - 数字 - 字符

(atom? 'atom)

#t

(atom? 123)

#t

(atom? (quote a))

#t

(atom? "abc")

#t

list是什么? - 括号包围? - 一组括号包围的atom? - 一组括号包围的S-expression

car, 列表第一个元素 cdr, 列表除第一个外的元素列表

(cons a. b), a为任一S-expression, b为任一列表.

(list? '(atom))

#t

(list? '(atom turkey or))

#t

(list? '())

#t

(atom? '()) ;; '() 表示空, 和空列表的意义重叠了

#t

(list? '(() () () ()))

#t

(car '(((hotdogs)) (and) (pickle) relish))

((hotdogs))

(car '()) ;; car处理非空列表

Traceback (most recent call last):
  File "In [16]", line 1, col 1, in 'car'
  File "In [16]", line 1, col 1
RunTimeError: car called on non-pair ()

(cdr '()) ;; cdr处理非空列表

Traceback (most recent call last):
  File "In [17]", line 1, col 1, in 'cdr'
  File "In [17]", line 1, col 1
RunTimeError: cdr called on non-pair ()

(cdr '((a b c) x y z))

(x y z)

(define s '((help) this))
(define l '(is very ((hard) to learn)))
(cons s l)

(((help) this) is very ((hard) to learn))

S-expression是什么? - atom - list

Scheme里的所有东西都是S-expression?

https://www.quora.com/In-Scheme-is-everything-an-expression

什么为空, 空的判定:

• '()代表空

• (null? ..)判定是否为空

(null? '())

#t

(eq? ..)的定义: 比较两个参数是否相等, 参数必须都是非数值的atom.

实际中不做这个严格定义.

(eq? 1 1)

#t

(eq? '() '())

#t

(eq? '(a b) '(a b))

#f

(eq? 'a 'a)

#t

2) Do it, Do it again, and again…

定义(lat? )方法, 用于判断列表元素是否都是atom.

用到了递归, 递归的核心是发现一个问题内在的结构, 逐步缩小问题规模, 直到停止条件.

(define (lat? l)
  (cond
   ((null? l) #t)
   ((atom? (car l))
    (lat? (cdr l)))
   (else #f)))

(lat? '(a b c))

#t

(lat? '((Jack) tom sprat)) ;; '(Jack) 是列表, 不是atom

#f

定义(member? a lat)方法, 用来判断一个atom是否是一个列表的元素.

(define (member? a lat)
  (cond
   ((null? lat) #f)
   ((eq? a (car lat)) #t)
   (else (member? a (cdr lat)))))

(member? 'a '(b a c))

#t

3) Cons the Magnificent

定义(rember a lat)方法, 从一个列表中移除一个元素.

cons加递归, 不断构建新列表的时候, 在原始列表元素等于查询a时, 跳过它, 从而在最终生成的列表中移除了a.

这里实际实现的是后面的multirember方法.

(define (rember a lat)
  (cond
    ((null? lat) lat)
    ((eq? a (car lat)) (rember a (cdr lat)))
    (else
     (cons (car lat) (rember a (cdr lat))))))

(rember 'a '(b a c d))

(b c d)

(rember 'a '(b a c a d a))

(b c d)

定义(first l), 从一个元素均为列表的列表中, 提取每个元素的第一个元素, 组成一个新的列表.

缺点是对与(() (..) (..))之类存在空列表元素的情况没有处理.

这里一个所谓重要”教条”是, cons构建列表时, 第一个参数是典型基本元素, 第二个参数是一个递归过程.

(define (first l)
  (cond
   ((null? l) l)
   (else
    (cons (car (car l)) (first (cdr l))))))

(first '((five plums) (four) (eleven green oranges)))

(five four eleven)

(cons '() '(1))

(() 1)

定义(insertR new old lat)方法, 在old右侧, 插入new.

两个步骤:

• 找到old, 找到后插入new, 然后终止递归程序.

• 构建新列表

(define (insertR new old lat)
  (cond
   ((null? lat) lat)
   ((eq? old (car lat))
    (cons
     (cons (car lat) new)
     (cdr lat)))
   (else
    (cons (car lat) (insertR new old (cdr lat))))))

(insertR 'e 'd '(a b c d f g d h))

(a b c (d . e) f g d h)

对应的也能写出insertL, 略.

4) Numbers Games

数值是什么?

• 整数

  • 14

  • -3

• 实数

  • 3.14159

数值是atom.

假设我们有两个基本操作add1, sub1, 依靠这两个基本操作构建自然数计算系统.

(define (add1 x)
  (+ x 1))

(define (sub1 x)
  (- x 1))

(zero? 0)

#t

(define (plus n m)
  (cond
   ((zero? m) n)
   (else
    (plus (add1 n) (sub1 m)))))

(plus 1 3)

4

(define (minus n m)
  (cond
   ((zero? m) n)
   (else
    (minus (sub1 n) (sub1 m)))))

(minus 3 2)

1

plus, minus方法都不能处理负数的情况, 终止条件不对.

给出tuple的定义, 一个元素都是相同类型的列表. 其它语言中, tuple可能还有不可变等特点, scheme中list本身是不变的, 因此不用强调.

此处tuple和list本质上是一类东西, 操作, 和递归条件的判定都是一致的.

定义(addtup tup)方法, 将tuple中的数字加和.

(define (addtup tup)
  (cond
   ((null? tup) 0)
   (else
    (+ (car tup) (addtup (cdr tup))))))

(addtup '(1 2 3 4 5))

15

定义乘法.

(define (multiply n m)
  (cond
   ((zero? m) 0)
   ((eq? m 1) n)
   (else
    (+ n (multiply n (- m 1))))))

(multiply 3 5)

15

定义(tup+ t1 t2)方法, 计算两个tuple相加的结果.

(define (tup+ t1 t2)
  (cond
   ((null? t1) t2)
   ((null? t2) t1)
   (else
    (cons (+ (car t1) (car t2))
          (tup+ (cdr t1) (cdr t2))))))

(tup+ '(1 2 3 8) '(4 5 6))

(5 7 9 8)

(define (gt? n m)  ;; >
  (cond
   ((zero? n) #f)
   ((zero? m) #t)
   (else (gt? (sub1 n) (sub1 m)))))

(gt? 3 3)

#f

(define (lt? n m)
  (cond
   ((zero? m) #f)
   ((zero? n) #t)
   (else (lt? (sub1 n) (sub1 m)))))

(lt? 3 4)

#t

(define (eq_? n m)
  (cond
   ((gt? n m) #f)
   ((lt? n m) #f)
   (else #t)))

(eq_? 3 3)

#t

(define (pow n m)
  (cond
   ((eq? m 0) 1)
   ((eq? m 1) n)
   (else
    (multiply n (pow n (sub1 m))))))

(pow 2 3)

8

定义除法(divide n m)

(define (divide n m)
  (cond
   ((lt? n m) 0)
   (else
    (add1 (divide (- n m) m)))))

(divide 10 3)

3

(length '(1 2))

2

定义函数(eqan? s1 s2), 用于添加比较两个数相等的逻辑.

(define (eqan? s1 s2)
  (cond
   ((and (number? s1) (number? s2))
    (= s1 s2))
   ((or (number? s1) (number? s2))
    #f)
   (else
    (eq? s1 s2))))

(eqan? "1" "1")

#t

5) Oh My Gawd: It’s Full of Stars

rember*表示遍历整个结构, 去掉a, 而非rember,只是去掉首层的a.

对一个子结构递归, 就是深入到了其中.

相比较之前的rember等递归函数.

检查条件由:

1. (null? )

2. (else cdr)

变成了:

1. (null? )

2. (atom? car)

3. (else cdr)

这个结构大体是通用的.

(define (rember* a lat)
  (cond
   ((null? lat) lat)
   ((atom? (car lat))
    (cond
     ((eq? (car lat) a) (rember* a (cdr lat)))
     (else
      (cons (car lat) (rember* a (cdr lat))))))
   (else
    (cons
     (rember* a (car lat))
     (rember* a (cdr lat))))))

(rember* 'a '((a b) a b d e a (e a f)))

((b) b d e (e f))

(define (leftmost lat)
  (cond
   ((atom? (car lat)) (car lat))
   (else
    (leftmost (car lat)))))

(leftmost '((((foo) bar) test) all))

foo

回头看如何比较两个列表相等:

• 都为空, #t

• 一个为空, #f

• 第一个元素都是atom时

• 有一个第一个元素是atom, #f

• 第一个元素都是列表时

(define (eqlist? l1 l2)
  (cond
   ((and (null? l1) (null? l2)) #t)
   ((or (null? l1) (null? l2)) #f)
   ((and (atom? (car l1)) (atom? (car l2)))
    (and (eqan? (car l1) (car l2))
         (eqlist? (cdr l1) (cdr l2))))
   ((or (atom? (car l1)) (atom? (car l2))) #f)
   (else
    (and
     (eqlist? (car l1) (car l2))
     (eqlist? (cdr l2) (cdr l2))))))

(eqlist? '((1 2) "a") '((1 3) "b"))

#f

(eqlist? '((1 2) "a") '((1 2) "a"))

#t

复习S-expression的语法定义: atom或是包含S-expression的list.

这种结构定义可以用文字描述, 也可以用BNF等语言来表达. 根据这个结构, 可以写出对应语法的解析器, 也可以写出一般的功能函数. 这些程序的结构也是类似的, 使用递归自上而下的遍历.

现在定义函数(equal_? s1 s2), 用来比较两个S-expression.

(define (equal_? s1 s2)
  (cond
   ((and (atom? s1) (atom? s2))
    (eqan? s1 s2))
   ((or (atom? s1) (atom? s2)) #f)
   (else
    (eqlist? s1 s2))))

(equal_? 'a 'a)

#t

(equal_? '(a b 1) '(a b 1))

#t

6) Shadows

首先定义算数表达式:

• atom

• 使用+, *, ^两两组合的算数表达式.

定义函数(numbered? aexp), 用于判断aexp是否是一个算数表达式.

(define (numbered? aexp)
  (cond
   ((atom? aexp) (number? aexp))
   (else
    (and (numbered? (car aexp))
         (numbered? (car (cdr (cdr aexp))))))))

(numbered? '(1 + (3 * 2) + a)) ;; 连加/乘的形式不处理

#t

定义求值函数

(define (value aexp)
  (cond
   ((atom? aexp) aexp)
   ((eq? (car (cdr aexp)) '+)
    (+
     (value (car aexp))
     (value (car (cdr (cdr aexp))))))
   ((eq? (car (cdr aexp)) '*)
    (*
     (value (car aexp))
     (value (car (cdr (cdr aexp))))))
   ((eq? (car (cdr aexp)) '^)
    (pow
     (value (car aexp))
     (value (car (cdr (cdr aexp))))))))

(value '(1 + (2 ^ 3)))

9

一种新的数字表示形式:

• '()代表0, '(())代表1, '(() ())代表2, 依次类推.

• 四个基本操作

  • zero?

  • number?

  • add1

  • sub1

就可以构建计算系统, 代码与前面的plus, minus, pow, gt?, lt?, eq_?等类似. 这表现了抽象的威力.

另一种Church Encoding, 也类似, 用Lambda表达式和函数调用层次表示数字.

7) Friends and Relations

集合是什么? 一组互不相同的元素组成的列表.

集合, 元素与集合, 集合与集合.

(define (set? lat)
  (cond
   ((null? lat) #t)
   ((member? (car lat) (cdr lat)) #f)
   (else
    (set? (cdr lat)))))

(set? '(1 2 3))

#t

(set? '(1 1 2 3 3))

#f

复杂度比较高\(O(n^2)\), 使用hashmap可以降到\(O(n)\), 使用排序, 能到\(O(nlogn)\).

(define (makeset lat)
  (cond
   ((null? lat) lat)
   ((member? (car lat) (cdr lat)) (makeset (cdr lat)))
   (else
    (cons (car lat) (makeset (cdr lat))))))

(makeset '(1 3 2 1 3 4 5))

(2 1 3 4 5)

(define (subset? s1 s2)
  (cond
   ((null? s1) #t)
   ((member? (car s1) s2) (subset? (cdr s1) s2))
   (else #f)))

(subset? '(1 2 4) '(1 2 3))

#f

(subset? '(1 2) '(1 2 3 4 5))

#t

两个集合相等, 当且仅当它们互为对方的子集.

(define (eqset? s1 s2)
  (and (subset? s1 s2)
       (subset? s2 s1)))

(eqset? '(1 3 2) '(1 2 3))

#t

两个集合相交是指, 存在共有元素. 两个集合的交集是, 两个集合共有元素的集合.

(define (intersect? s1 s2)
  (cond
   ((null? s1) #f)
   ((member? (car s1) s2) #t)
   (else
    (intersect? (cdr s1) s2))))

(intersect? '(1 2 3) '(6 4 5))

#f

(intersect? '(1 2 3) '(3 4 5))

#t

(define (intersect s1 s2)
  (cond
   ((null? s1) s1)
   ((member? (car s1) s2)
    (cons (car s1) (intersect (cdr s1) s2)))
   (else
    (intersect (cdr s1) s2))))

(intersect '(1 2 3) '(2 7 9))

(2)

(intersect '(1 2 3 4 5 6 7 8) '(6 9 11 32 4 55))

(4 6)

(define (intersectall l-set) ;; 主要是发现问题结构上的特点, 发现结构后, 就比较容易解决
  (cond
   ((null? (cdr l-set)) (car l-set))
   (else
    (intersect (car l-set)
               (intersectall (cdr l-set))))))

(intersectall '((1 2 3) (3 4 5 7 7) (3 1 11 34 9)))

(3)

并集是两个集合出现的共有元素.

(define (union s1 s2)
  (cond
   ((null? s1) s2)
   ((member? (car s1) s2) (union (cdr s1) s2))
   (else
    (cons (car s1) (union (cdr s1) s2)))))

(union '(1 2 3) '(3 4 5 6))

(1 2 3 4 5 6)

关系(rel)是什么:

一组Pair组成的列表.

(define (a-pair? x)
  (cond
   ((atom? x) #f)
   ((null? x) #f)
   ((null? (cdr x)) #f)
   ((null? (cdr (cdr x))) #t)
   (else #f)))

(a-pair? '(1 2))

#t

函数是什么?

集合A到集合B的多(一)对一映射.

(define (firsts lat)
  (cond
   ((null? lat) lat)
   (else
    (cons (car (car lat))
          (firsts (cdr lat))))))

(firsts '((1 2) (3 4) (5 7) (8)))

(1 3 5 8)

(define (fun? rel)
  (set? (firsts rel)))

(fun? '((1 2) (3 4) (5 6) (7 8)))

#t

上面的关系, 就是函数\(f(x)=x+1, x\in\{1, 3, 5, 8\}\).

逆关系(revrel)是什么?

关系的每个Pair, 第一个元素和第二个元素互换, 即是.

(define (revrel rel)
  (cond
   ((null? rel) rel)
   (else
    (cons (cons (car (cdr (car rel)))
                (car (car rel)))
          (revrel (cdr rel))))))

(revrel '((1 2) (3 4) (5 6) (7 8)))

((2 . 1) (4 . 3) (6 . 5) (8 . 7))

8) Lambda the Ultimate

涉及到函数作为值这一点.

定义(rember-f test? a l), 将谓词函数作为参数传进去, 而不是写死在代码中.

(define rember-f
  (lambda (test?)
      (lambda (a l)
          (cond
           ((null? l) l)
           ((test? a (car l)) (rember-f test? a (cdr l)))
           (else
            (cons (car l) ((rember-f test?) a (cdr l))))))))

((rember-f eq?) 'a '(1 2 3))

(1 2 3)

(define (f args..) ...) 实际是(define f (lambda (args..) ...))的语法糖, 而后者, 又是下面代码的语法糖:

(define f
  (lambda (a0)
    (lambda (a1)
      ...
      (lambda (an)
        ...))))

f(x0)就会返回(lambda (a1) ...)这个partial function, 依次类推, 我们把这个过程叫做curry-ing, 即柯里化.

(define rember-eq? (rember-f eq?))

考虑我们之前定义的value函数:

(define (value aexp)
  (cond
   ((atom? aexp) aexp)
   ((eq? (car (cdr aexp)) '+)
    (+
     (value (car aexp))
     (value (car (cdr (cdr aexp))))))
   ((eq? (car (cdr aexp)) '*)
    (*
     (value (car aexp))
     (value (car (cdr (cdr aexp))))))
   ((eq? (car (cdr aexp)) '^)
    (pow
     (value (car aexp))
     (value (car (cdr (cdr aexp))))))))

其中, 判断算符进行计算的过程, 有一个明显的公共模式. 我们可以建立一个符号->算符的映射函数, 通用的解决它.

(define (atom->fun x)
  (cond
   ((eq? x '+) +)
   ((eq? x '*) *)
   ((eq? x '^) pow)))

(define (value-1 aexp)
  (cond
   ((atom? aexp) aexp)
   (else
    ((atom->fun (car (cdr aexp)))
     (value-1 (car aexp))
     (value-1 (car (cdr (cdr aexp))))))))

(value-1 '(1 + (2 * 3)))

7

定义\(eq?-c^1\)函数, (eq?-c1 k), k="salad"调用的结果是, 一个函数, 判断参数是否eq?”salad”这个值.

(define eq?-c1
  (lambda (a)
    (lambda (x)
      (eq? x a))))

(eq?-c1 "salad")

#<procedure>

((eq?-c1 'salad) 'salad)

#t

(define eq?-salad (eq?-c1 'salad))

(eq?-salad 'salad)

#t

(define insertL-f
  (lambda (test?)
    (lambda (new old l)
      (cond
       ((null? l) '())
       ((test? (car l) old)
        (cons new (cons old (cdr l))))
       (else
        (cons (car l)
              ((insertL-f test?) new old (cdr l))))))))

((insertL-f eq?) 'a 'b '(a b c d e))

(a a b c d e)

(define insert-g0
  (lambda (is-left-side)
    (lambda (test?)
      (lambda (new old l)
        (cond
         ((null? l) '())
         ((test? (car l) old)
          (cond
           ((= is-left-side #t)
            (cons new (cons old (cdr l))))
           (else
            (cons old (cons new (cdr l))))))
         (else
          (cons (car l)
                (((insert-g0 is-left-side) test?) new old (cdr l)))))))))

(((insert-g0 #t) eq?) 'a 'b '(a b c d e))

(a a b c d e)

比较”土”的方式.

定义seqL, seqR, 接收(new old l), 分别生成:

• seqL

  • new old (cdr l)

• seqR

  • old new (cdr l)

将insert-g中的is-left-side开关, 替换成对应的seq方法.

(define insertL (insert-g seqL))
(define insertR (insert-g seqR))

(define (seqL new old l)
  (cons new (cons old l)))

(define (seqR new old l)
  (cons old (cons new l)))

(define insert-g
  (lambda (seq)
    (lambda (new old l)
      (cond
       ((null? l) '())
       ((eq? (car l) old)
        (seq new old (cdr l)))
       (else
        (cons (car l)
              ((insert-g seq) new old (cdr l))))))))

((insert-g seqL) 'a 'b '(a b c d e))

(a a b c d e)

(define subst0  ;; 替换一次
  (lambda (new old l)
    (cond
     ((null? l) '())
     ((eq? (car l) old)
      (cons new (cdr l)))
     (else
      (cons (car l)
            (subst0 new old (cdr l)))))))

(subst0 'a 'b '(a b c d e))

(a a c d e)

观察发现, subst0和insert-g有着相似的结构. 因此可以重写subst如下:

(define (seqS new old l)
  (cons new l))

(define subst (insert-g seqS))

(subst 'a 'b '(a b c d e))

(a a c d e)

上面的rember-f程序, 实际上是multirember-f, 略过了rember的实现.

下面引入continuation.

(define multirember&co
  (lambda (a lat col)
    (cond
     ((null? lat)
      (col '() '()))
     ((eq? (car lat) a)
      (multirember&co a
                      (cdr lat)
                      (lambda (newlat seen)
                        (col newlat (cons (car lat) seen)))))
     (else
      (multirember&co a
                      (cdr lat)
                      (lambda (newlat seen)
                        (col (cons (car lat) newlat) seen)))))))

这里的col的作用, 通过递归的调用, 将中间数据存储在各级的闭包中. col的作用是一个collector, 一般被称作continuation.

(define (a-friend x y)
  (null? y))

(multirember&co 'tuna '(strawberries tuna and swordfish) a-friend)

#f

展开上面调用的执行过程:

col = (lambda (x y) (null? y))

;; 1)
(m&c 'tuna '(strawberries tuna and swordfish) col)
;; 2) else
(m&c 'tuna
     '(tuna and swordfish)
     (col (cons 'strawberries x) y))
;; 3) match
(m&c 'tuna
     '(and swordfish)
     (col (cons 'strawberries x) (cons 'tuna y)))
;; 4) else
(m&c 'tuna
     '(swordfish)
     (col (cons 'strawberries x) (cons 'and (cons 'tuna y))))
;; 5) else
(m&c 'tuna
     '()
     (col (cons 'strawberries x) (cons 'swordfish (cons 'and (cons 'tuna y)))))

;; 6) null? #t
(col '() '())
(null?
 '(strawberries)
 '(swordfish and tuna))
>>> #f

(multirember&co 'tuna '() a-friend)

#t

(multirember&co 'tuna '(tuna) a-friend)

#f

;; 1) match
(m&c 'tuna
     '()
     (col x (cons 'tuna y)))
;; 2) null? #t
(col '() '())
(null?
 '()
 '(tuna))
>>> #f

回头看, (col x y)的两个参数, x是不满足条件的一组集合, y是满足条件的一组集合. 根据上面的结论, 我们设计cnt-friend, 分别统计两个集合的大小.

这里的collector, 类似于reduce或者fold.

(define (cnt-friend x y)
  (cons (length x) (length y)))

(multirember&co 'tuna '(strawberries tuna and swordfish) cnt-friend)

(3 . 1)

TODO 练习:

• multiinsertL/multiinsertR/multiinsertLR

• multiinsertLR&co

• evens-only*

• evens-only*&co

9) …and Again, and Again, and Again, …

函数looking, 从输入列表的第一个位置找起, 如果元素是数字, 表示列表索引, 继续查找, 如果非数字, 判断是否等于要找的元素, 是#t, 否#f.

(define (pick i lat)
  (cond
   ((null? lat) '())
   ((= i 1) (car lat))
   (else
    (pick (- i 1) (cdr lat)))))

(pick 3 '(1 2 3))

3

(define (keep-looking a i lat)
  (cond
   ((null? lat) #f)
   ((number? i)
    (keep-looking a (pick i lat) lat))
   (else (eq? i a))))

(define (looking a lat)
  (keep-looking a (pick 1 lat) lat))

(looking 'caviar '(6 2 4 caviar 5 7 3))

#t

(looking 'caviar '(6 2 grits caviar 5 7 3))

#f

keep-looking与以前的递归不同的地方, 在于lat的数据规模一直没有缩小.

它的结束, 依赖于输入数据, 输入(7 2 4 7 5 6 3), 永远停不下来.

• total function

  • 对所有输入都能在有限步后给出结果

• partial function

  • 只对部分输入能在有限步后给出结果

  • looking就是这类函数

(define (eternity x)  ;; 对任何输入都不能停, 也是一个`partial function`
  (eternity x))

(define (shift pair)
  (build (fst (fst pair))
         (build (snd (fst pair))
                (snd pair))))

(define (fst pair)
  (car pair))

(define (snd pair)
  (cond
   [(null? pair) '()]
   [else (car (cdr pair))]))

(define (third lat)
  (car (cdr (cdr lat))))

(define (build a b)
  (cons a (cons b '())))

(shift '((a b) (c d)))

(a (b (c d)))

(shift '((a b) c))

(a (b c))

(define (align pora)
  (cond
   [(atom? pora) pora]
   [(a-pair? (fst pora)) (align (shift pora))]
   [else (build (fst pora)
                (align (snd pora)))]))

(align '((a b) (c (d e))))

(a (b (c (d e))))

(shift '((a b) (c (d e))))

(a (b (c (d e))))

(define (length* pora)
  (cond
   [(atom? pora) 1]
   [else
    (+ (length* (fst pora))
       (length* (snd pora)))]))

(length* '((a b) (c (d (e f)))))

6

(define (revpair p)
  (build (snd p) (fst p)))

(revpair '(a b))

(b a)

(define (shuffle pora)
  (cond
   [(atom? pora) pora]
   [(a-pair? (fst pora))
    (shuffle (revpair pora))]
   [else
    (build (fst pora)
           (shuffle (snd pora)))]))

(shuffle '(a (b c)))

(a (b c))

(shuffle '(a b))

(a b)

(shuffle '((a b) (c d)))不能结束, shuffle函数是partial的.

(define (C n)
  (cond
   [(= n 1) 1]
   [(even? n) (C (/ n 2))]
   [else
    (C (add1 (* 3 n)))]))

;; (C 0) 不能结束, partial的

(define (A n m)
  (cond
   [(zero? n) (add1 m)]
   [(zero? m) (A (sub1 n) 1)]
   [else (A (sub1 n) (A n (sub1 m)))]))

(A 1 0)

2

(A 2 2)

7

Ackermann function,

\[\begin{split}A(m,n)=\begin{cases} n+1 & \quad \text{if } m=0 \\ A(m-1,1) & \quad \text{if } m>0 \text{ and } n=0 \\ A(m-1,A(m,n-1)) & \quad \text{if } m>0 \text{ and } n>0 \end{cases}\end{split}\]

停机判定问题, 这里will-stop?函数是定义不出来的, 因为围绕它的假设, 可以构造出一个悖论来.停机问题是遇到的第一个可以被精确描述, 但是不能在程序中定义的问题.

图灵停机问题和哥德尔不完备定理.

停机问题涉及自我指涉(递归就是种自指), 本质是一阶逻辑的不自洽和不完备.

回头看length函数:

(define (length lat)
  (cond
   [(null? lat) 0]
   [else (add1 (length (cdr lat)))]))

我们不再使用define绑定, 定义一个只能处理空列表的\(length_0\)(输入非空因为``eternity``的原因, 会不”停机”).

(lambda (lat)
  (cond
   [(null? lat) 0]
   [else (add1 (eternity (cdr lat)))]))

利用\(length_0\), 我们可以定义一个能处理空列表, 单元素列表的\(length_{\leq1}\):

(lambda (lat)
  (cond
   [(null? lat) 0]
   [else (add1 (length0 (cdr l)))]))

不存在\(length_0\)绑定, 所以展开.

scheme (lambda (lat)   (cond    [(null? lat) 0]    [else (add1 (lambda (lat)                  (cond                   [(null? lat) 0]                   [else (add1 (eternity (cdr lat)))]))                (cdr lat)]))

同理, 我们用相同的结构不断替换eternity,就可以得到不同的\(\leqN\)版本length函数. 那么能否定义一个无限的函数, 来求解\(length_{\leq\infty}\)? 不能. 但是存在的这个函数的重复结构, 怎样表达?

((lambda (length)
   (lambda (lat)
     (cond
      [(null? lat) 0]
      [else (add1 (length (cdr lat)))])))
 eternity)

按这种形式重写\(length_{\leq1}\),

((lambda (f)
   (lambda (lat)
     (cond
      [(null? lat) 0]
      [else (add1 (f (cdr lat)))])))
 ((lambda (g)
    (lambda (lat)
      (cond
       [(null? lat) 0]
       [else (add1 (g (cdr lat)))]))))
 eternity))

定义\(length_{\leq2}\)还需要再加一组(lambda (k) ...), 还是代码上重复. 怎么办? 定义一个函数, 输入是length, 输出还是length.

定义\(length_0\):

((lambda (mk-length)
   (mk-length eternity))
 (lambda (length)
   (lambda (lat)
     (cond
      [(null? lat) 0]
      [else (add1 (length (cdr lat)))]))))

定义\(length_{\leq1}\):

((lambda (mk-length)
   (mk-length
    (mk-length eternity)))
 (lambda (length)
   (lambda (lat)
     (cond
      [(null? lat) 0]
      [else (add1 (length (cdr lat)))]))))

如此类推, 只需增加(mk-length (mk-length ...)层次, 就可以表示函数的反复.

application-order Y combinator:

(define Y
  (lambda (le)
    ((lambda (f) (f f))
     (lambda (f)
       (le (lambda (x) ((f f) x)))))))

10) What is the Value of All of This?

entry是这样一个pair:

• 每个元素都是长度相同的list

• 第一个列表是set

(define new-entry build)

(define (lookup-in-entry name entry entry-f)
  (lookup-in-entry-help name (fst entry) (snd entry) entry-f))

(define (lookup-in-entry-help name names values entry-f)
  (cond
   [(null? names) (entry-f name)]
   [(eq? (car names) name) (car values)]
   [else
    (lookup-in-entry-help name
                          (cdr names)
                          (cdr values)
                          entry-f)]))

(lookup-in-entry 'tom '((lucy lily tom) (girl girl boy)) (lambda (x) x))

boy

(define extend-table cons)

(define (lookup-in-table name table table-f)
  (cond
   [(null? table) (table-f name)]
   [else
    (lookup-in-entry name
                     (car table)
                     (lambda (name)
                       (lookup-in-table name
                                        (cdr table)
                                        table-f)))]))

找出值的类型, 定义expr->action, atom->action方法.

(define (expr->action e)
  (cond
   [(atom? e) (atom->action e)]
   [else (list->action e)]))

(define (atom->action e)
  (cond
   [(number? e) *const]
   [(eq? e #t) *const]
   [(eq? e #f) *const]
   [(eq? e 'cons) *const]
   [(eq? e 'car) *const]
   [(eq? e 'cdr) *const]
   [(eq? e 'null?) *const]
   [(eq? e 'eq?) *const]
   [(eq? e 'atom?) *const]
   [(eq? e 'zero?) *const]
   [(eq? e 'add1) *const]
   [(eq? e 'sub1) *const]
   [(eq? e 'number?) *const]
   [else *identifier]))

(define (list->action e)
  (cond
   [(atom? (car e))
    (cond
     [(eq? (car e) 'quote) *quote]
     [(eq? (car e) 'lambda) *lambda]
     [(eq? (car e) 'cond) *cond]
     [else *application])]
   [else *application]))

(define (meaning e table)
  ((expr->action e) e table))

(define (value e) (meaning e '()))

(define (*const e table) ;; action for constants
  (cond
   [(number? e) e]
   [(eq? e #t) #t]
   [(eq? e #f) #f]
   [else (build 'primitive e)]))

(define (*quote e table) ;; action for (quote ..)
  (text-of e))

(define text-of snd)

(define (*identifier e table)
  (lookup-in-table e table initial-table))

(define (initial-table name)  ;; 不应该被用到
  (car '()))

primitive和non-primitive的区别, non-primitive需要记住它的形参和body.

(non-primitive
 ( (((y z) ((8) 9)))     (x)       (cons x y) ))
   |--- table ----| |- formals -|  |-- body --|

(define (*lambda e table)
  (build 'non-primitive
         (cons table (cdr e))))

(define table-of fst)

(define formals-of snd)

(define body-of third)

定义cond语句, 首先定义一组辅助函数.

(define (else? x)
  (cond
   [(atom? x) (eq? x 'else)]
   [else #f]))

(define question-of fst)

(define answer-of snd)

(define (evcon lines table)
  (cond
   [(else? (question-of (car lines)))
    (meaning (answer-of (car lines)) table)]
   [(meaning (question-of (car lines)) table)
    (meaning (answer-of (car lines)) table)]
   [else (evcon (cdr lines) table)]))

(define cond-lines-of cdr)

(define (*cond e table)
  (evcon (cond-lines-of e) table))

*application的结构:

• 一个列表

• 第一个元素的值是一个函数

• apply时,所有参数的值需要求到

定义evlis(eval list), 输入一个列表和table, 得到所有值组成列表.

然后得到function的值, (meaning-of-function meaning-of-args)得到这个*application的值.

(define (evlis args table)
  (cond
   [(null? args) '()]
   [else
    (cons (meaning (car args) table)
          (evlis (cdr args) table))]))

(define function-of car)

(define arguments-of cdr)

(define (*application e table)
  (apply (meaning (function-of e) table)
         (evlis (arguments-of e) table)))

程序中包含2种函数:

1. (primitive name)

2. (non-primitive (table formals body))

   1. 这里(table formals body)被称作一条闭包记录(closure record)

(define (primitive? l)
  (eq? (fst l) 'primitive))

(define (non-primitive? l)
  (eq? (fst l) 'non-primitive))

求值函数

(define (apply fun vals)
  (cond
   [(primitive? fun)
    (apply-primitive (snd fun) vals)]
   [(non-primitive? fun)
    (apply-closure (snd fun) vals)]))

(define (apply-primitive name vals)
  (cond
   [(eq? name 'cons) (cons (fst vals) (snd vals))]
   [(eq? name 'car) (car (fst vals))]
   [(eq? name 'cdr) (cdr (fst vals))]
   [(eq? name 'null?) (null? (fst vals))]
   [(eq? name 'eq?) (eq? (fst vals) (snd vals))]
   [(eq? name 'atom?) (:atom? (fst vals))]
   [(eq? name 'zero?) (zero? (fst vals))]
   [(eq? name 'add1) (add1 (fst vals))]
   [(eq? name 'sub1) (sub1 (fst vals))]
   [(eq? name 'number?) (number? (fst vals))]))

(define (:atom? x)
  (cond
   [(atom? x) #t]
   [(null? x) #f]
   [(eq? (car x) 'primitive) #t]
   [(eq? (car x) 'non-primitive) #f]
   [else #f]))

(define (apply-closure closure vals)
  (meaning (body-of closure)
           (extend-table
            (new-entry (formals-of closure) vals)
            (table-of closure))))

(meaning '(cons z x) '(((x y)
                        ((a b c) (d e f)))
                       ((u v w)
                        (1 2 3))
                       ((x y z)
                        (4 5 6))))

(6 a b c)

(apply '(primitive cons) '(6 (a b c)))

(6 a b c)

(完)