Welcome to 《The Little Schemer》笔记¶
Contents:
scheme十戒五律¶
scheme十戒¶
当对一个原子列表进行递归时,要注意两个问题:(null? lat) and else。
当对一个数字进行递归时,要注意两个问题:(zero? n) and else。
当对一个S表达式列表进行递归时,要注意三个问题:(null? l), (atom? (car l)) 和 else。
使用cons来创建列表。
当创建一个列表时,先描述第一个元素,然后用cons来将它和递归连接在一起
递归时,至少要改变一个参数。 例如:递归一个原子列表使用(cdr lat);递归一个数字使用(sub1 n);
递归一个S表达式时,如果这个表达式即不(null? l),也不(atom? (car l)), 那么使用(car l) 和 (cdr l)。
并且该参数必须要越来越接近终止元素。在终止条件里面必须要对正在变化的参数进行检查:
- 当使用cdr时,终止条件使用null?
- 当使用sub1时,终止条件使用zero?
当你使用+来创建一个值时,必须总要用0来作为终止,0加上任何值都不会改变原来的值。
当你使用*来创建一个值时,必须总要用1来作为终止,1乘以任务值都不会改变原来的值。
当你使用cons来创建一个值时,必须总要用()来作为终止。
当函数运行正确后再考虑简化函数。
当一个对象的子对象是与其本身表现一致时,这时候可用递归操作。比如:
- 一个列表的子列表
- 一个算术表达式的子表达式
使用辅助函数来简化表述。
使用新的函数来抽象公共模式。
创建连续函数时,尽量能够一次性获取更多的值。
scheme五律¶
- car函数最初只是用在非空列表上的。
- cdr函数最初只是用在非空列表上的,(cdr non-null-list)的结果是另一个列表。
- cons函数最初只接受两个参数,第二个参数必须是一个列表,它返回的结果也是一个列表。
- null?函数只对列表有用。
- eq?函数只接受两个参数,两个参数必须都是非数字的原子。
前言¶
小技巧
这篇前言在第二版及第三版的《The Little LISPer》中出现过。
我们经过作者的允许,将之放在了本书里。
PS:
《The Little LISPer》为《The Little Schemer》的前身。
在1976年,我参加了一门摄影入门课程。大部分学生(包括我自己)学这门课程的原因是希望自己能够富有创造力,比如拍出我所景仰的艺术家Edward Weston水准的照片。在第一天,老师耐心的罗列并解释了他将在这学期要教授我们的一长串摄影技巧。其中一个重点是 亚当斯区域曝光理论(Ansel Adams’ “Zone System”) ,用来预视觉化(previsualizing, 在影片抓取前初步生成影片拍摄镜头或者序列镜头的预览效果) 打印值(最后成像的光量),并且知道如何从拍摄场景中的光强获取该值。想要掌握这种技巧,我们必须学会使用曝光表(测光表)测量光强、控制曝光时长、控制冲洗时间来控制图片的黑标准和对比度。但是这些技巧又需要更底层的技巧的支撑,比如:装胶卷、冲洗、打印和各种混合化学试剂。一个人必须需要花费数年的时间持之以恒地练习冲洗感光胶卷,才能达到稳定一致的冲洗效果。还记得我第一次专注投入的实验课程,最终就记得滑滑的显影剂和恶心的定影剂。
那关于创造力呢?为了能够有创造力,一个人必须要掌握产生创造力的媒介。就像一个人连拍张照片的技能都没有,那他甚至都不会想到自己要拍出伟大的摄影作品。在工程领域,就像其它富有创造性的艺术一样,我们必须学会系统分析来成就我们的综合成果。就像一个人没有钢筋混凝土的相关知识、足够多的用来计算大桥结构的数学知识,那么他是无论如何都造不出既雄伟又实用的大桥的。类似的,一个人如果对“预视觉化”他所写的代码的执行过程没有深入的理解,那么他也不可能创造出优雅的计算机系统(译者:应该指系统软件)。
一些摄影家在摄影时选择使用8×10的黑白倒影板,另一些却选择35mm的反转片, 其中每一种都有其各自的优缺点。像摄影一样,编程也需要选择媒介。Lisp 就是这样一种媒介,它能够让人享受到自由自在的编程体验。Lisp 最初是用于递归理论和符号代数的理论载体。它现在已经发展成为一个独一无二的强大且灵活的软件开发工具体系,为软件系统的快速原型开发提供了全方位的支持。和其它编程语言一样, Lisp 能够利用社区成员提供的大量的封装好的第三库,就像胶水把东西粘起来一样容易。在 Lisp 中,函数被当作第一类公民,它能够当作参数传入到其它函数,当作其它函数的返回值,或者保存在数据结构里面。这种灵活是无与伦比的,但最重要的是,它提供了形式化、命名、重用(工程设计中必不可少的常见中使用模式)机制。另外, Lisp程序很容易处理Lisp程序的表示形式(译者:应该指语法)。这种特性推动一大堆程序推演与分析结构工具的出现,比如 cross-referencers 。
The Little LISPer 开辟一条独特的途径来挖掘 Lisp 中隐藏的创造性编程技能。它上手无痛,充满令人深思的智慧,如果要学习用它来构造递归过程和操作递归数据结构则需要大量的钻研和实践。The Little LISPer 对于学习Lisp编程的学生而言, 就像Hanon的指法练习或者Czerny的练习曲对于学钢琴的学生。
注解
本篇翻译部分参考了Z.X.L的 the little schemer 笔记
序言¶
小技巧
为了庆祝Scheme的20周年纪念,我们第三次修订了 The Little LISPer ,
给了它一个更加准确的名字 The Little Schemer ,
并且写了一本它的续篇 The Seasoned Schemer 。
程序接收和产生数据。设计一个程序需要对处理的数据有透彻的了解。一个好的程序同样也会反映出它所处理的数据的结构。大部分的数据及程序都是递归形式的。递归是一种通过自己定义自己,或者自己调用自己来求解问题的行为。
本书的目标是教会读者递归思想 。首先一个任务就是决定哪一种语言阐述这种概念。这里有三个明显的选择:自然语言,比如英语;严谨的数学表达式;或者程序语言。自然语言模棱两可,不够准确,甚至冗长。这些在日常交流中自然语言的优势,在介绍递归这样精细的概念时却变成了劣势。数学表达式恰恰相反,它可以用极少的符号表达出一个复杂的概念。遗憾地是,数学表达往往晦涩难懂,只有经过专门的学习才能领会。技术和数学的结合给了我们一个更理想的选择──程序语言。我们相信,程序语言是解释递归这一概念的最佳媒介。它继承了数学的简明,但与之不同的是,我们可以运行代码来观察它们的行为,并通过不断地修改来评估这些改动带来的影响。
Scheme也许是最适合教授递归的程序语言了。从Scheme一诞生就支持符号(计算)。程序员不必考虑他自己的语言符号和这些符号在计算机中如何表示。Scheme最根本的进行计算方法就是递归。编程最主要的工作就是找出(内在的)递归定义。大多数Scheme实现都采用交互的方式(译者:REPL)──程序员能立即感知程序的行为并进行调整。当你读完这本书,最大的感触可能是,Scheme程序和它要处理的数据存在着直接的对应。
虽然Scheme很严谨,但理解Scheme并不需要经过专门的数学训练。实际上, The Little Schemer 出自一门为期两周的Scheme导论课的授课提纲,这门课是专门为没接触过编程,对数学又没有丝毫兴趣的学生开设的。这些学生大多准备从事公共事务方面的职业。我们的理念是“用Scheme递归地写出程序,关键是要识别出模式”。我们关注的是如何用递归的方式编程,因此我们只需用到Scheme中很小的一部分功能:car, cdr, cons, eq?, null?, zero?, add1, sub1, number?, and, or, quote, lambda, define, cond。事实上,这就够了。
The Little Schemer 和 The Seasoned Schemer 不会向你介绍怎么完成现实世界中的任务,但掌握这两本书中的概念将有助于你更好地理解计算的本质。
致谢¶
感谢一堆人,暂不翻译。
给读者的建议¶
不要囫囵吞枣地阅读本书,仔细地阅读它。书里散落着很多有用的提示。至少阅读本书三次。按章节顺序读。如果你没有完全读懂前一章,那么下一章可能更不懂。每章节的难度是递增的,如果你不能解决前面的问题,那么后面的问题会更让你无处下手。
本书是以一种你与我们之间的对话形式来展开的,对话的内容是一些有趣的Scheme编程例子。当你在阅读本书时,希望你能够尽量尝试运行那些例子。Scheme程序很容易读懂。虽然在不同的Scheme实现之间有一些细微的语法差别(主要是个别名字的拼写和某些函数的作用域稍有不同),但Scheme基本上是一致的。要运行书中的Scheme代码,你还需要定义atom?, sub1, add1.这些函数我们都会在书里详细介绍:
(define atom?
(lambda (x)
(and (not (pair? x)) (not (null? x)))))
要想知道你的Scheme有没有正确地定义atom?,运行 (atom? (quote())) ,看是否返回#f。事实上,这个测试也适用于现代的Lisp版本,如Common Lisp。如果用你想使用Lisp,你需要添加atom?函数:
(defun atom? (x)
(not (listp x)))
你可能需要稍稍修改这程序。书中提供的例子可能都需要做一些修改。在书中,我会在旁注里注明在不同Scheme实现的一些特性。“S:”表示Scheme,“L:”表示Common Lisp。
在第四章,我们会深入探讨三个基本的算术操作:add1, sub1, zero?。虽然Scheme没有提供add1和sub1,但你可以用内置的加减运算符来定义它们。为了避免逻辑上的死结,我们用另一套符号来表示基本的加减操作:+, -。
我们不会在书中给出任何标准的定义。我们相信你能自己搞出一套来,这样比我们给你一个写好的定义更能让你记住、理解它们。请好好消化十诫和五律。学习Scheme的关键是 模式识别 。十诫就是对你所见过的模式的总结。书一开始会简化一些概念。但随后,它们会被不断扩展、丰富。你应该知道,这本书里的所有东西都是Scheme,Scheme是一门通用编程语言,不是这样一本导论性质的书能讲清的。在你掌握了本书之后,你可以去阅读和理解一些进阶的有关Scheme的书了。
我们编写本书时遵循一些约定。不同类别符号的字型稍有不同。
注解
主要的规定就是通过字体来标识不同类型的单词。
该段下面基本就是告诉你各种类型的单词使用什么字体,
这个也不翻译了,看例子就知道。
最后谈一谈断句。Webster把断句定义为用标准的符号分割句子来使文意更明确的行为。有时为了表达清楚,我们会使用非常规的断句方式。注意我们不会对左栏的文字(译注:书采用对话形式,分为左右两栏)断句,因为那是程序语言。
本书的例子中出现食物名有两个原因。
食物比起那些抽象的符号来说更容易可视化
(但是在你节食的时候读本书可不是一个好主意)。
我们希望我们选择食物名能够有助读者理解本书中的例子和主题。
我们希望在读书时能够小分一下心。
我们知道当你试图理解这些主题时多少有点沮丧,
但是一丢丢分心多少能够帮助你远离沮丧的情绪。
你现在要准备开始本书之旅了。祝你好运!我们希望你能够享受在接下来的章节里的挑战。
注解
本篇翻译大部分参考了Sedgewick的 The Little Schemer ── 小众Schemer? 。
Toys¶
本章概要:
使读者了解scheme语言的一些基本概念和一些常用函数,为接下来的章节打基础。
常见函数¶
car: 返回非空列表中的首个S表达式,
所以它操作的对象一定要是非空的列表(十戒第一条)。
cdr: 取出非空列表中的除首个S表达式的列表,
它操作的对象也是要非空列表(十戒第一条)。
cons: 将两个S表达式连接成一个列表,第二个必须是一个列表。
null?: 只判断列表是否为空(scheme五律第四条)。
atom?: 用来判断一个S表达式是否为一个原子。
(define atom? (lambda (m) (and (not (pair? m)) (not (null? m)))))
eq?: 用来判断两个非数字的的原子是否相等。
小技巧
guile的实现不太一样,它还可以比较数字。
Do It, Do It Again, and Again, and Again…¶
本章节概要:
首先介绍了一个基本概念 `lat` ,然后定义了一系列与该概念相关的操作,以及如何通过递归来实现这些操作。
lat?¶
判断某个列表是否为 lat
小技巧
通过判断列表中是否每个S表达式都是原子来实现
; lat?: list -> bool
(define lat?
(lambda (l)
(cond
((null? l) #t)
((atom? (car l)) (lat? (cdr l)))
(else #f))))
lat? 经过CPS变换后的代码
小技巧
建议阅读完第8章,了解CPS变换之后,再回头从2章将每个函数写一个对应的CPS变换。
用于连续的那个函数基本没有固定的参数和代码,按照自己所想的来。
;; 添加一个连续函数,参数中为两个列表
;; 第一个表示lat列表,第二表示非lat列表
(define col
(lambda (lat nolat)
(null? nolat)))
(define lat?&co
(lambda (l col)
(cond
((null? l) (col '() '()))
((atom? (car l)) (lat?&co (cdr l)
(lambda (lat nolat)
(col (cons (car l) lat) nolat))))
(else (lat?&co (cdr l)
(lambda (lat nolat)
(col lat (cons (car l) nolat))))))))
member?¶
用来判断一个S表达式是否在一个lat之内。
; member?: symbol lat -> bool
(define member?
(lambda (a lat)
(cond
((null? lat) #f)
((eq? a (car lat)) #t)
(else (member? a (cdr lat))))))
; CPS变换
(define col
(lambda (in out)
(not (null? in))))
(define member?&co
(lambda (a lat col)
(cond
((null? lat) #f)
((eq? a (car lat)) (member?&co a
(cdr lat)
(lambda (in out)
(col (cons a in) out))))
(else (member?&co a
(cdr lat)
(lambda (in out)
(col in (cons a out))))))))
Cons the Magnificent¶
Contents
本章节概要:
继续讲解lat/列表相关的操作及使用递归来进行代码实现
rember¶
将lat中首次出现的某个S表达式删除。
; rember: symbol lat -> lat
(define rember
(lambda (a lat)
(cond
((null? lat) '())
((eq? a (car lat)) (cdr lat))
(else (cons (car lat) (rember a (cdr lat)))))))
; 参数rmcount不是必需的,也可以去掉
(define col
(lambda (rmcount leftlat)
(display rmcount)
(newline)
(display leftlat)
(newline)
leftlat))
(define rember&co
(lambda (a lat col)
(cond
((null? lat) (col 0 '()))
((eq? a (car lat)) (col 1 (cdr lat)))
(else (rember&co a
(cdr lat)
(lambda (rmcount leftlat)
(col rmcount (cons (car lat) leftlat))))))))
firsts¶
从一个列表中的获取其每个子列表的首个S表达式,并以列表形式返回
注解
此函数并未考虑每个子列表为空表的情况
; firsts: list -> list
(define firsts
(lambda (l)
(cond
((null? l) '())
(else (cons (car (car l)) (firsts (cdr l)))))))
(define col
(lambda (first_ed)
(display first_ed)
(newline)
first_ed))
(define firsts&co
(lambda (l col)
(cond
((null? l) (col '()))
(else (firsts&co (cdr l)
(lambda (first_ed)
(col (cons (car (car l)) first_ed))))))))
insertR¶
将一个S表达式插入到一个列表中指定S表达式的右边,并返回修改后的列表
; insertR: symbol symbol lat -> lat
(define insertR
(lambda (new old lat)
(cond
((null? lat) '())
((eq? old (car lat)) (cons old (cons new (cdr lat))))
(else (cons (car lat) (insertR new old (cdr lat)))))))
(define col
(lambda (newlat)
(display newlat)
(newline)
newlat))
(define insertR&co
(lambda (new old lat col)
(cond
((null? lat) (col '()))
((eq? old (car lat))
(col (cons old (cons new (cdr lat)))))
(else (insertR&co new
old
(cdr lat)
(lambda (newlat)
(col (cons (car lat) newlat))))))))
insertL¶
将一个S表达式插入到一个列表中指定S表达式的左边,并返回修改后的列表
; insertL: symbol symbol lat -> lat
(define insertL
(lambda (new old lat)
(cond
((null? lat) '())
((eq? old (car lat)) (cons new lat))
(else (cons (car lat) (insertL new old (cdr lat)))))))
(define col
(lambda (newlat)
(display newlat)
(newline)
newlat))
(define insertL&co
(lambda (new old lat col)
(cond
((null? lat) (col '()))
((eq? old (car lat)) (col (cons new lat)))
(else (insertL&co new
old
(cdr lat)
(lambda (newlat)
(col (cons (car lat) newlat))))))))
subst¶
用新的S表达式替代列表中指定的S表达式,并返回修改后的列表
; subst: symbol symbol lat -> lat
(define subst
(lambda (new old lat)
(cond
((null? lat) '())
((eq? old (car lat)) (cons new (cdr lat)))
(else (cons (car lat) (subst new old (cdr lat)))))))
(define col
(lambda (newlat)
(display newlat)
(newline)
newlat))
(define subst&co
(lambda (new old lat col)
(cond
((null? lat) (col '()))
((eq? old (car lat))
(col (cons new (cdr lat))))
(else (subst&co new
old
(cdr lat)
(lambda (newlat)
(col (cons (car lat) newlat))))))))
subst2¶
用来替代列表中指定的两个S表达式
; subst2: symbol symbol symbol lat -> lat
(define subst2
(lambda (new old1 old2 lat)
(cond
((null? lat) '())
((eq? old1 (car lat)) (cons new (cdr lat)))
((eq? old2 (car lat)) (cons new (cdr lat)))
(else (cons (car lat) (subst2 new old1 old2 (cdr lat)))))))
;subst2简化版本
(define subst2
(lambda (new old1 old2 lat)
(cond
((null? lat) '())
((or (eq? old2 (car lat))
(eq? old1 (car lat)))
(cons new (cdr lat)))
(else (cons (car lat)
(subst2 new old1 old2 (cdr lat)))))))
(define col
(lambda (newlat)
(display newlat)
(newline)
newlat))
(define subst2&co
(lambda (new old1 old2 lat col)
(cond
((null? lat) (col '()))
((or (eq? old1 (car lat))
(eq? old2 (car lat)))
(col (cons new (cdr lat))))
(else (subst&co new
old1
old2
(cdr lat)
(lambda (newlat)
(col (cons (car lat) newlat))))))))
multirember¶
基本同rember, 只不过是列表中所有符合的S表达式都会删除.
; multirember: symbol lat -> lat
(define multirember
(lambda (a lat)
(cond
((null? lat) '())
((eq? a (car lat)) (multirember a (cdr lat)))
(else (cons (car lat) (multirember a (cdr lat)))))))
(define col
(lambda (rmcount newlat)
(display rmcount)
(display " ")
(display newlat)
(newline)
newlat))
(define multirember&co
(lambda (a lat col)
(cond
((null? lat) (col 0 '()))
((eq? a (car lat))
(multirember&co a
(cdr lat)
(lambda (rmcount newlat)
(col (+ rmcount 1) newlat))))
(else
(multirember&co a
(cdr lat)
(lambda (rmcount newlat)
(col rmcount (cons (car lat) newlat))))))))
multiinsertR¶
基本同insertR,只不过是列表中所有符合的s表达式都会插入其右边。
; multiinsertR: symbol symbol lat -> lat
(define multiinsertR
(lambda (new old lat)
(cond
((null? lat) '())
((eq? old (car lat))
(cons old (cons new (multiinsertR new old (cdr lat)))))
(else (cons (car lat) (multiinsertR new old (cdr lat)))))))
(define col
(lambda (inscount newlat)
(display inscount)
(display " ")
(display newlat)
(newline)
newlat))
(define multiinsertR&co
(lambda (new old lat col)
(cond
((null? lat) (col 0 '()))
((eq? old (car lat))
(multiinsertR&co new
old
(cdr lat)
(lambda (inscount newlat)
(col (+ inscount 1)
(cons old (cons new newlat))))))
(else
(multiinsertR&co new
old
(cdr lat)
(lambda (inscount newlat)
(col inscount
(cons (car lat) newlat))))))))
multiinsertL¶
基本同insertL, 只不过是列表中所有符合的s表达式都会插入其左边.
; multiinsertL: symbol symbol lat -> lat
(define multiinsertL
(lambda (new old lat)
(cond
((null? lat) '())
((eq? old (car lat))
(cons new (cons old (multiinsertL new old (cdr lat)))))
(else (cons (car lat) (multiinsertL new old (cdr lat)))))))
(define col
(lambda (inscount newlat)
(display inscount)
(display " ")
(display newlat)
(newline)
newlat))
(define mutlinsertL&co
(lambda (new old lat col)
(cond
((null? lat) (col 0 '()))
((eq? old (car lat))
(mutlinsertL&co new
old
(cdr lat)
(lambda (inscount newlat)
(col (+ inscount 1)
(cons new (cons old newlat))))))
(else
(mutlinsertL&co new
old
(cdr lat)
(lambda (inscount newlat)
(col inscount
(cons (car lat) newlat))))))))
multisubst¶
基本同subst, 只不过是列表中所有符合的s表达式都替换
; multisubst: symbol symbol lat -> lat
(define multisubst
(lambda (new old lat)
(cond
((null? lat) '())
((eq? old (car lat))
(cons new (multisubst new old (cdr lat))))
(else (cons (car lat) (multisubst new old (cdr lat)))))))
(define col
(lambda (stcount newlat)
(display stcount)
(display " ")
(display newlat)
(newline)
newlat))
(define mutlsubst&co
(lambda (new old lat col)
(cond
((null? lat) (col 0 '()))
((eq? old (car lat))
(mutlisubst&co new
old
(cdr lat)
(lambda (inscount newlat)
(col (+ inscount 1)
(cons new newlat)))))
(else
(mutlisubst&co new
old
(cdr lat)
(lambda (inscount newlat)
(col inscount
(cons (car lat) newlat))))))))
Numbers Games¶
Contents
本章节概要:
主要引入了数字,以及数字列表tup,
围绕着上面两个概念,定义了相关的一系列操作,并用递归实现之。
基本概念¶
数字也是一个atom
number?: 判断一个S表达式是否为数字
add1: 对数字加1
(define add1 1+)
sub1: 对数字减1
(define sub1 1-)
zero?: 判断一个数字是否为0
tup: 列表中包含的每个s表达式都是数字的列表。
注解
书中为了简化概念,不考虑负数的情况。
+¶
将两个数字相加
; +; number number -> number
(define +
(lambda (a b)
(cond
((zero? b) a)
(else (add1 (+ a (sub1 b)))))))
; 另外一个版本
(define +
(lambda (a b)
(cond
((zero? b) a)
(else (+ (add1 a) (sub1 b))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define +&co
(lambda (a b col)
(cond
((zero? b) (col a))
(else (+&co a
(sub1 b)
(lambda (num)
(col (add1 num))))))))
; 另外一个版本
(define +&co
(lambda (a b col)
(cond
((zero? b) (col a))
(else (+&co (add1 a)
(sub1 b)
col)))))
-¶
将两个数字相减
注解
不考虑相减的结果为负数的情况
; -: number number -> number
(define -
(lambda (a b)
(cond
((zero? b) a)
(else (sub1 (- a (sub1 b)))))))
; 另一个版本
(define -
(lambda (a b)
(cond
((zero? b) a)
(else (- (sub1 a) (sub1 b))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define -&co
(lambda (a b col)
(cond
((zero? b) (col a))
(else (-&co a
(sub1 b)
(lambda (num)
(col (sub1 num))))))))
; 另一个版本
(define -&co
(lambda (a b col)
(cond
((zero? b) (col a))
(else (-&co (sub1 a) (sub1 b) col)))))
addtup¶
将一个tup中的所有数字相加
; addtup: tup -> number
(define addtup
(lambda (tup)
(cond
((null? tup) 0)
(else (+ (car tup) (addtup (cdr tup)))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define addtup&co
(lambda (tup col)
(cond
((null? tup) (col 0))
(else
(addtup&co (cdr tup)
(lambda (sum)
(col (+ sum (car tup)))))))))
*¶
将两个数字相乘
; *: number number -> number
(define *
(lambda (n m)
(cond
((zero? m) 0)
(else (+ n (* n (sub1 m)))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define *&co
(lambda (n m col)
(cond
((zero? m) (col 0))
(else (*&co n
(sub1 m)
(lambda (num)
(col (+ num n))))))))
tup+¶
将两个tup中相对的数字相加,然后返回相加后的tup
; tup1+: tup tup -> tup
; 该函数允许两个参数的长度不一样
(define tup1+
(lambda (tup1 tup2)
(cond
((null? tup2) tup1)
((null? tup1) tup2)
(else (cons (+ (car tup1) (car tup2))
(tup+ (cdr tup1) (cdr tup2)))))))
; tup2+: tup tup -> tup
; 该函数的两个参数长度必须一样
(define tup2+
(lambda (tup1 tup2)
(cond
((and (null? tup1) (null? tup2)) '())
(else (cons (+ (car tup1) (car tup2))
(tup+ (cdr tup1) (cdr tup2)))))))
(define col
(lambda (newtup)
(display newtup)
(newline)
newtup))
(define tup+&co
(lambda (tup1 tup2 col)
(cond
((null? tup1) (col tup2))
((null? tup2) (col tup1))
(else (tup+&co (cdr tup1)
(cdr tup2)
(lambda (newtup)
(col (cons (+ (car tup1)
(car tup2))
newtup))))))))
<¶
比较两个数字的大小
注解
< 函数未考虑两个数字都为0的情况
; >: number number -> bool
(define >
(lambda (n m)
(cond
((zero? n) #f)
((zero? m) #t)
(else (> (sub1 n) (sub1 m))))))
(define col
(lambda (bflag)
(display bflag)
(newline)
bflag))
(define >&co
(lambda (n m col)
(cond
((zero? n) (col #f))
((zero? m) (col #t))
(else (>&co (- n 1) (- m 1) col)))))
>¶
比较两个数字的大小
注解
< 函数未考虑两个数字都为0的情况
; <: number number -> bool
(define <
(lambda (n m)
(cond
((zero? m) #f)
((zero? n) #t)
(else (< (sub1 n) (sub1 m))))))
(define col
(lambda (bflag)
(display bflag)
(newline)
bflag))
(define <&co
(lambda (n m col)
(cond
((zero? m) (col #f))
((zero? n) (col #t))
(else (<&co (sub1 n) (sub1 m) col)))))
=¶
比较两个数字是否相等
; =: number number -> bool
(define =
(lambda (n m)
(cond
((zero? m) (zero? n))
((zero? n) #f)
(else (= (sub1 n) (sub1 m))))))
; 另一版本
(define =
(lambda (n m)
(cond
((or (> n m) (< n m)) #f)
(else #t))))
(define col
(lambda (bflag)
(display bflag)
(newline)
bflag))
(define =&co
(lambda (n m)
(cond
((zero? m) (col (zero? n)))
((zero? n) (col #f))
(else (=&co (sub1 n) (sub1 m) col)))))
^¶
阶乘
; ^: number number -> number
(define ^
(lambda (n m)
(cond
((zero? n) 0)
((zero? m) 1)
(else (* n (^ n (sub1 m)))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define ^&co
(lambda (n m col)
(cond
((zero? n) (col 0))
((zero? m) (col 1))
(else (^&co n
(sub1 m)
(lambda (num)
(col (* n num))))))))
/¶
除
; /: number number -> number
(define /
(lambda (n m)
(cond
((< n m) 0)
(else (add1 (/ (- n m) m))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define /&co
(lambda (n m col)
(cond
((< n m) (col 0))
(else (/&co (- n m)
m
(lambda (num)
(col (add1 num))))))))
length¶
返回一个lat的长度
; length: lat -> number
(define length
(lambda (lat)
(cond
((null? lat) 0)
(else (add1 (length (cdr lat)))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define length&co
(lambda (lat col)
(cond
((null? lat) (col 0))
(else (length&co (cdr lat)
(lambda (num)
(col (add1 num))))))))
pick¶
根据传入的数字,获取其对应在lat中位置的S表达式
; pick: number lat -> symbol
(define pick
(lambda (n lat)
(cond
((zero? (sub1 n)) (car lat))
(else (pick (sub1 n) (cdr lat))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define pick&co
(lambda (n lat col)
(cond
((null? lat) (col '()))
((zero? (sub1 n)) (col (car lat)))
(else (pick&co (sub1 n) (cdr lat) col)))))
rempick¶
根据传入的数字, 删除其对应在lat中位置的S表达式,并返回剩余列表
; rempick: number lat -> lat
(define rempick
(lambda (n lat)
(cond
((null? lat) '())
((zero? (sub1 n)) (cdr lat))
(else (cons (car lat)
(rempick (sub1 n) (cdr lat)))))))
(define col
(lambda (lat)
(display lat)
(newline)
lat))
(define rempick&co
(lambda (n lat col)
(cond
((null? lat) (col '()))
((zero? (sub1 n)) (col (cdr lat)))
(else (rempick&co (sub1 n)
(cdr lat)
(lambda (newlat)
(col (cons (car lat)
newlat))))))))
no-nums¶
选出列表中的非数字S表达式, 并以列表形式返回
; no-nums: lat -> lat
(define no-nums
(lambda (lat)
(cond
((null? lat) '())
((number? (car lat)) (no-nums (cdr lat)))
(else (cons (car lat)
(no-nums (cdr lat)))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define no-nums&co
(lambda (lat col)
(cond
((null? lat) (col '()))
((number? (car lat))
(no-nums&co (cdr lat) col))
(else
(no-nums&co (cdr lat)
(lambda (newlat)
(col (cons (car lat) newlat))))))))
all-nums¶
跟上面相反, 只返回数字列表
; all-nums: lat -> lat
(define all-nums
(lambda (lat)
(cond
((null? lat) '())
((not (number? (car lat))) (all-nums (cdr lat)))
(else (cons (car lat) (all-nums (cdr lat)))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define all-nums&co
(lambda (lat col)
(cond
((null? lat) (col '()))
((not (number? (car lat)))
(all-nums&co (cdr lat) col))
(else
(all-nums&co (cdr lat)
(lambda (newlat)
(col (cons (car lat) newlat))))))))
小技巧
no-nums 和 all-nums 的逻辑基本一样,
其实可以将它们的共同点抽出来。
(define col
(lambda (no-nums all-nums)
(dispaly no-nums)
(newline)
(display all-nums)))
(define split-nums&co
(lambda (lat col)
(cond
((null? lat) (col '() '()))
((number? (car lat))
(split-nums&co (cdr lat)
(lambda (no all)
(col no (cons (car lat) all)))))
(else
(split-nums&co (cdr lat)
(lambda (no all)
(col (cons (car lat) no) all)))))))
eqan?¶
比较两个S表达式是否是相等
小技巧
实现该函数是为了扩展 eq? 的功能,后面会用到该函数
; eqan? symbol symbol -> bool
(define eqan?
(lambda (a1 a2)
(cond
((and (number? a1) (number? a2))
(= a1 a2))
((or (number? a1) (number? a2))
#f)
(else (eq? a1 a2)))))
occur?¶
检查列表中有几个指定的S表达式
; occur: symbol lat -> number
(define occur
(lambda (a lat)
(cond
((null? lat) 0)
((eqan? a (car lat))
(add1 (occur a (cdr lat))))
(else (occur a (cdr lat))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define occur&co
(lambda (n lat col)
(cond
((null? lat) (col 0))
((eq? n (car lat))
(occur&co n
(cdr lat)
(lambda (num)
(col (add1 num)))))
(else
(occur&co n
(cdr lat)
col)))))
one?¶
判断一个数字是否为1
小技巧
写这个函数,应该是稍微提一下Scheme中的第八戒。
; one?: number -> bool
(define one?
(lambda (n)
(cond
((zero? n) #f)
(else (zero? (sub1 n))))))
; 另一版本
(define one?
(lambda (n)
(cond
(else (= n 1)))))
通过 one? 咱们就可以简写 rempick 函数了。
; rempick: number lat -> lat
(define rempick
(lambda (n lat)
(cond
((null? lat) '())
((one? n) (cdr lat))
(else (cons (car lat)
(rempick (sub1 n)
(cdr lat)))))))
*Oh My Gawd*: It’s Full of Stars¶
Contents
本章概要:
本章节稍微添加了一点难度。
以前都只处理一层列表,现在需要处理嵌套列表(含有子列表的列表)。
rember*¶
基本同rember, 但其处理的对象包括一个嵌套的列表
; rember*: symbol list -> list
(define rember*
(lambda (a l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? a (car l))
(rember* a (cdr l)))
(else (cons (car l) (rember* a (cdr l))))))
(else (cons (rember* a (car l))
(rember* a (cdr l)))))))
(define col
(lambda (l)
(display l)
(newline)
l))
(define rember*&co
(lambda (a l col)
(cond
((null? l) (col '()))
((atom? (car l))
(cond
((eq? a (car l))
(rember*&co a (cdr l) col))
(else
(rember*&co a
(cdr l)
(lambda (newl)
(col (cons (car l) newl)))))))
(else
(rember*&co a
(car l)
(lambda (carl)
(rember*&co a
(cdr l)
(lambda (cdrl)
(col (cons carl cdrl))))))))))
insertR*¶
基本同insertR, 但其处理的对象包括一个嵌套的列表
; insertR*: symbol symbol list -> list
(define insertR*
(lambda (new old l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? old (car l))
(cons old (cons new (insertR* new old (cdr l)))))
(else (cons (car l) (insertR* new old (cdr l))))))
(else (cons (insertR* new old (car l))
(insertR* new old (cdr l)))))))
(define col
(lambda (l)
(display l)
(newline)
l))
(define insertR*&co
(lambda (new old l col)
(cond
((null? l) (col '()))
((atom? (car l))
(cond
((eq? old (car l))
(insertR*&co new
old
(cdr l)
(lambda (newl)
(col (cons old
(cons new newl))))))
(else
(insertR*&co new
old
(cdr l)
(lambda (newl)
(col (cons (car l)
newl)))))))
(else
(insertR*&co new
old
(car l)
(lambda (carl)
(insertR*&co new
old
(cdr l)
(lambda (cdrl)
(col (cons carl cdrl))))))))))
occur*¶
基本同occur, 但其处理的对象包括一个嵌套的列表
; occur*: symbol list -> number
(define occur*
(lambda (a l)
(cond
((null? l) 0)
((atom? (car l))
(cond
((eq? a (car l))
(add1 (occur* a (cdr l))))
(else (occur* a (cdr l)))))
(else (+ (occur* a (car l))
(occur* a (cdr l)))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define occur*&co
(lambda (a l col)
(cond
((null? l) (col 0))
((atom? (car l))
(cond
((eq? a (car l))
(occur*&co a (cdr l) (lambda (num)
(col (add1 num)))))
(else
(occur*&co a (cdr l) col))))
(else
(occur*&co a
(car l)
(lambda (carnum)
(occur*&co a
(cdr l)
(lambda (cdrnum)
(col (+ carnum cdrnum))))))))))
subst*¶
基本同subst, 但其处理的对象包括一个嵌套的列表
; subst*: symbol symbol list -> list
(define subst*
(lambda (new old l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? old (car l))
(cons new (subst* new old (cdr l))))
(else (cons (car l) (subst* new old (cdr l))))))
(else (cons (subst* new old (car l))
(subst* new old (cdr l)))))))
(define col
(lambda (l)
(display l)
(newline)
l))
(define subst*&co
(lambda (new old l col)
(cond
((null? l) (col l))
((atom? (car l))
(cond
((eq? old (car l))
(subst*&co new
old
(cdr l)
(lambda (newl)
(col (cons new newl)))))
(else
(subst*&co new
old
(cdr l)
(lambda (newl)
(col (cons (car l) newl)))))))
(else
(subst*&co new
old
(car l)
(lambda (carl)
(subst*&co new
old
(cdr l)
(lambda (cdrl)
(col (cons carl cdrl))))))))))
insertL*¶
基本同insertL, 但其处理的对象包括一个嵌套的列表
; insertL*: symbol symbol list -> list
(define insertL*
(lambda (new old l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? old (car l))
(cons new (cons old (insertL* new old (cdr l)))))
(else (cons (car l) (insertL* new old (cdr l))))))
(else (cons (insertL* new old (car l))
(insertL* new old (cdr l)))))))
(define col
(lambda (l)
(display l)
(newline)
l))
(define insertL*&co
(lambda (new old l col)
(cond
((null? l) (col l))
((atom? (car l))
(cond
((eq? old (car l))
(insertL*&co new
old
(cdr l)
(lambda (newl)
(col (cons new (cons old newl))))))
(else
(insertL*&co new
old
(cdr l)
(lambda (newl)
(col (cons old newl)))))))
(else
(insertL*&co new
old
(car l)
(lambda (carl)
(insertL*&co new
old
(cdr l)
(lambda (cdrl)
(col (cons carl cdrl))))))))))
member*¶
基本同member, 但其处理的对象包括一个嵌套的列表
; member*: symbol list -> bool
(define member*
(lambda (a l)
(cond
((null? l) #f)
((atom? a (car l))
(cond
((eq? a (car l)) #t)
(else (member* a (cdr l)))))
(else (or (member* a (car l))
(member* a (cdr l)))))))
(define col
(lambda (num)
(display num)
(newline)
num))
(define member*&co
(lambda (a l col)
(cond
((null? l) (col #f))
((atom? (car l))
(cond
((eq? a (car l))
(col #t))
(else
(member*&co a (cdr l) col))))
(else
(member*&co a
(car l)
(lambda (incar)
(member*&co a
(cdr l)
(lambda (incdr)
(col (or incar incdr))))))))))
leftmost¶
找出不包含空列表的列表/嵌套列表中的最左边的一个atom
; leftmost: list -> symbol
(define leftmost
(lambda (l)
(cond
((atom? (car l)) (car l))
(else (leftmost (car l))))))
(define col
(lambda (s)
(display s)
(newline)
s))
(define leftmost&co
(lambda (l col)
(cond
((atom? (car l)) (col (car l)))
(else (leftmost (car l) col)))))
eqlist?¶
判断两个列表是否相等(包含嵌套列表)
; eqlist?: list list -> bool
(define eqlist?
(lambda (l1 l2)
(cond
((and (null? l1) (null? l2)) #t)
((and (null? l1) (atom? (car l2))) #f)
((null? l1) #f)
((and (atom? (car l1)) (null? l2)) #f)
((and (atom? (car l1)) (atom? (car l2)))
(and (eqan? (car l1) (car l2))
(eqlist? (cdr l1) (cdr l2))))
((atom? (car l1)) #f)
((null? l2) #f)
((atom? (car l2)) #f)
(else
(and (eqlist? (car l1) (car l2))
(eqlist? (cdr l1) (cdr l2)))))))
(define eqlist?
(lambda (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 l1) (cdr l2)))))))
equal?¶
判断两个S表达式是否相等
(define equal?
(lambda (s1 s2)
(cond
((and (atom? s1) (atom? s2))
(eqan? s1 s2))
((or (atom? s1) (atom? s2)) #f)
(else (eqlist? s1 s2)))))
简化版eqlist?¶
作者通过equal?来简化了eqlist?,
而且equal?也是通过eqlist?来实现的。
SO,只当函数正确的前提下再进行简化/优化。
(define eqlist?
(lambda (l1 l2)
(cond
((and (null? l1) (null? l2)) #t)
((or (null? l1) (null? l2)) #f)
(else
(and (equal? (car l1) (car l2))
(eqlist? (cdr l1) (cdr l2)))))))
Shadows¶
Contents
本章概要:
本章节主要两个方面:
1. 一个计算器的实现(计算算术表达式的值),
为最后一章节讲解Scheme解释器打基础。
2. church encoding,使用列表来表示数字,
然后再参照第四章,根据原语函数定义加、减等函数。
numbered?¶
判断一个S表达式是否为算术表达式
; numbered?: symbol -> bool
(define numbered?
(lambda (aexp)
(cond
((atom? aexp) (number? aexp))
((or (eq? (car (cdr aexp)) '+)
(eq? (car (cdr aexp)) '*)
(eq? (car (cdr aexp)) '^))
(and (numberd? (car aexp))
(numberd? (car (cdr (cdr aexp))))))
(else #f))))
value¶
获取一个算术表达式的值
小技巧
; 在Guile环境,请添加如下代码 (define ^ expt)
(define value
(lambda (nexp)
(cond
((atom? nexp) nexp)
((eq? (car nexp) '+)
(+ (value (cdr nexp))
(value (cdr (cdr nexp)))))
((eq? (car nexp) '*)
(* (value (cdr nexp))
(value (cdr (cdr nexp)))))
(else (^ (value (cdr nexp))
(value (cdr (cdr nexp))))))))
; 帮助函数
(define 1st-sub-exp
(lambda (aexp)
(car (cdr aexp))))
; 帮助函数
(define 2nd-sub-exp
(lambda (aexp)
(car (cdr (cdr aexp)))))
; 帮助函数
(define operator
(lambda (aexp)
(car aexp)))
(define value
(lambda (nexp)
(cond
((atom? nexp) nexp)
((eq? (operator nexp) '+)
(+ (value (1st-sub-exp nexp))
(value (2nd-sub-exp nexp))))
((eq? (operator nexp) '*)
(* (value (1st-sub-exp nexp))
(value (2nd-sub-exp))))
(else (^ (value (1st-sub-exp nexp))
(value (2nd-sub-exp nexp)))))))
使用帮助函数重写的value函数,其实该版本的value函数可以用在前缀、中缀、后缀表达式上,只要修改三个帮助函数即可。
church encoding¶
翻译为:邱奇数,关于它的定义详见 Wiki 邱奇数
作者用 () 来表示0, (()) 表示1, (() ()) 表示2... ...
然后定义了对应的原语函数: sero?,edd1,zub1。
sero?: 对应zero?
(define sero? (lambda (n) (null? n)))
edd1: 对应add1
(define edd1 (lambda (n) (cons '() n)))
zub1: 对应sub1
(define zub1 (lambda (n) (cdr n)))
和第四章一样,根据上面三个原语函数,然后再来定义加、减等这些函数。
(define +
(lambda (n m)
(cond
((sero? m) n)
(else (edd1 (+ n (zub1 m)))))))
(define -
(lambda (n m)
(cond
((sero? m) n)
(else (- (zub1 n) (zub1 m))))))
Friends and Relations¶
Contents
本章概要:
介绍了Scheme中的几种常见数据结构。
为最后一章节的Scheme解释器实现打基础。
set¶
集合, 类似于列表, 但是它包含的每个元素在集合内都是唯一的
set?¶
判断一个S表达式是否为set
; set?: lat -> bool
(define set?
(lambda (lat)
(cond
((null? lat) #t)
((member? (car lat) (cdr lat)) #f)
(else (set? (cdr lat))))))
(define col
(lambda (bflag)
(display bflag)
(newline)
bflag))
(define set?&co
(lambda (lat col)
(cond
((null? lat) (col #t))
((member? (car lat) (cdr lat)) (col #f))
(else (set?&co (cdr lat) col)))))
makeset¶
生成一个set
; makeset: lat -> set
(define makeset
(lambda (lat)
(cond
((null? lat) '())
((member? (car lat) (cdr lat))
(makeset (cdr lat)))
(else (cons (car lat) (makeset (cdr lat)))))))
;使用multirember, 另外一种思路
(define makeset
(lambda (lat)
(cond
((null? lat) '())
(else (cons (car lat)
(makeset (multirember (car lat)
(cdr lat))))))))
(define col
(lambda (set)
(display set)
(newline)
set))
(define makeset&co
(lambda (lat col)
(cond
((null? lat) (col '()))
((member? (car lat) (cdr lat))
(makeset&co (cdr lat) col))
(else makeset&co (cdr lat)
(lambda (newset)
(col (cons (car lat) newset)))))))
subset?¶
判断set1是否是set2的子集
; subset?: set set -> bool
(define subset?
(lambda (set1 set2)
(cond
((null? set1) #t)
((member? (car set1) set2)
(subset? (cdr set1) set2))
(else #f))))
; 另一版本
(define subset?
(lambda (set1 set2)
(cond
((null? set1) #t)
((and (member? (car set1) set2)
(subset? (cdr set1) set2))))))
(define col
(lambda (bflag)
(display bflag)
(newline)
bflag))
(define subset&co
(lambda (set1 set2 col)
(cond
((null? set1) (col #t))
((member? (car set1) set2)
(subset&co (cdr set1) set2))
(else (col #f)))))
eqset?¶
判断两个set是否相等
; eqset?: set set -> bool
(define eqset?
(lambda (set1 set2)
((and (subset? set1 set2)
(subset? set2 set1)))))
interset?¶
判断set1是否至少有一个S表达式在set2中
; interset?: set set -> bool
(define intersect?
(lambda (set1 set2)
(cond
((null? set1) #t)
((member? (car set1) set2) #t)
(else (intersect? (cdr set1) set2)))))
; 另一版本
(define intersect?
(lambda (set1 set2)
(cond
((null? set1) #t)
((or (member? (car set1) set2)
(intersect? (cdr set1) set2))))))
(define col
(lambda (bflag)
(display bflag)
(newline)
bflag))
(define intersect?&co
(lambda (set1 set2 col)
(cond
((null? set1) (col #t))
((member? (car set1) set2) (col #t))
(else (intersect?&co (cdr set1) set2 col)))))
interset¶
求两个set的交集
; set set -> set
(define intersect
(lambda (set1 set2)
(cond
((or (null? set1)
(null? set2))
'())
((member? (car set1) set2)
(cons (car set1)
(intersect (cdr set1) set2)))
(else (intersect (cdr set1) set2)))))
(define col
(lambda (set)
(display set)
(newline)
set))
(define intersect&co
(lambda (set1 set2 col)
(cond
((or (null? set1) (null? set2))
(col '()))
((member? (car set1) set2)
(intersect&co (cdr set1)
set2
(lambda (newset)
(col (cons (car set1) newset)))))
(else (intersect&co (cdr set1) set2 col)))))
union¶
求两个set的并集
; union: set set -> set
(define union
(lambda (set1 set2)
(cond
((null? set1) set2)
((null? set2) set1)
((member? (car set1) set2)
(union (cdr set1) set2))
(else (cons (car set1)
(union (cdr set1) set2))))))
(define col
(lambda (set)
(display set)
(newline)
set))
(define union&co
(lambda (set1 set2 col)
(cond
((null? set1) (col set2))
((null? set2) (col set1))
((member? (car set1) set2)
(union&co (cdr set1) set2 col))
(else union&co (cdr set1)
set2
(lambda (newset)
(col (cons (car set1) newset)))))))
intersectall¶
获取set中每个子set的交集
; intersectall: set -> set
(define intersectall
(lambda (l-set)
(cond
((null? (cdr l-set)) (car l-set))
(else (intersect (car l-set)
(intersectall (cdr l-set)))))))
(define col
(lambda (set)
(display set)
(newline)
set))
(define intersectall&co
(lambda (l-set col)
(cond
((null? (cdr l-set))
(col (car l-set)))
(else (intersectall&co (cdr l-set)
(lambda (newset)
(col (interset (car l-set) newset))))))))
pair¶
点对, 只包含两个S表达式的列表
fun¶
基本同rel, 但其所有子pair的第一个元素也是唯一的
revrel¶
将rel中所有子pair的两个元素对调
; revrel: rel -> rel
(define revrel
(lambda (rel)
((null? rel) '())
(else (cons (build (second (car rel))
(first (car rel)))
(revrel (cdr rel))))))
如果将其中的pair中两元素对调写成一个单独的函数,则revrel看起来会更简洁明了。
(define revpair
(lambda (pair)
(build (second pair)
(first pair))))
(define revrel
(lambda (rel)
((null? rel) '())
(else (cons (revpair (car rel))
(revrel (cdr rel))))))
(define col
(lambda (rel)
(display rel)
(newline)
rel))
(define revrel&co
(lambda (rel col)
((null? rel) (col '()))
(else (revrel&co (cdr rel)
(lambda (newrel)
(col (cons (revpair (car rel))
newrel)))))))
Lambda the Ultimate¶
Contents
本章概要:
这一章才算开始高能, 下面的九,十章则更是要下一翻功夫了.
说高能, 并不是指有多难(除了连续概念的讲解),
而是指这一章揭示了很多更深入的东西, 更深入的抽象:
**高阶函数** 与 **CPS变换** 。
rember-f¶
基本同rember,但是其中的eq/equal比较函数当作参数传入进来。
这样具体的比较操作就抽象比来,可以用来支持各种对象/类型的删除操作,只需要你定义好其对象/类型的eq/equal比较函数即可。
; rember-f: function symbol list -> list
(define rember-f
(lambda (test? a l)
(cond
((null? l) '())
((test? a (car l)) (cdr l))
(else (cons (car l)
(rember-f (test? a (cdr l))))))))
简单修改一下,将之定义成为一个高阶函数,即返回函数的函数。
(define rember-f
(lambda (test?)
(lambda (a l)
(cond
((null? l) '())
((test? a (car l)) (cdr l))
(else (cons (car l)
(rember-f (test? a (cdr l)))))))))
(define rember-eq?
(lambda (a l)
(rember-f eq?)))
(define rember-equal?
(lambda (a l)
(rember-f equal?)))
eq?-c¶
返回一个函数, 用来与固定S表达式比较.
(define eq?-c
(lambda (a)
(lambda (x)
(eq? x a))))
; 与salad比较
(define eq?-salad
(eq?-c 'salad))
insert-q¶
返回一个函数, 具体的操作函数当作参数传入
小技巧
其实在第3章,细心的话,会发现 insertL 、 insertR 、 subst 、 rember 的逻辑基本是一样的,只是各别的代码不一样,那么我们可以通过高阶函数来将公共的代码抽出来。
(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))))))))
(define seqL
(lambda (new old l)
(cons new (cons old l))))
(define insertL
(insert-g seqL))
(define seqR
(lambda (new old l)
(cons old (cons new l))))
(define insertR
(insert-g seqR))
(define seqS
(lambda (new old l)
(cons new l)))
(define subst
(insert-g seqS))
(define seqrem
(lambda (new old l)
l))
(define rember
(lambda (a l)
((insert-g seqrem) #f a l)))
value¶
重写之前的value, 将里面的操作抽象出来
(define atom-to-function
(lambda (x)
(cond
((eq? x '+) +)
((eq? x '*) *)
(else ^))))
(define value
(lambda (nexp)
(cond
((atom? nexp) nexp)
(else
((atom-to-function (operator nexp))
(value (1st-sub-exp nexp))
(value (2nd-sub-exp nexp)))))))
multirember-f¶
(define multirember-f
(lambda (test?)
(lambda (a lat)
(cond
((null? lat) '())
((test? a (car lat))
((multirember-f test?) a (cdr lat)))
(else (cons (car lat)
((multirember-f test?) a (cdr lat))))))))
(define multirember-eq?
(multirember-f eq?))
(define multirember-equal?
(multirember-f equal?))
警告
下面开始介绍到连续概念(continuation)
multiremberT¶
基本同上,不过test?可以带参数,将每次递归都不会变化的test?和a参数都存放到test?函数中,以后写函数,可以将哪些参数是不变的,哪些参数是变化的区分开来。
(define multiremberT
(lambda (test? lat)
(cond
((null? lat) '())
((test? (car lat))
(multiremberT test? (cdr lat)))
(else (cons (car lat)
(multiremberT test? (cdr lat)))))))
multirember&co¶
添加一个连续函数col,multirember&co函数的最后一步就是调用col。
将具体的操作放入col中,其中的col相当于一个收集器(collector),它将lat中和a参数不相同的S表达式放入col的第一个参数中,相同的放入第二个参数中。
(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)))))))
(define a-friend
(lambda (x y)
(null? y)))
如果col为a-friend,那么multirember&co的意思就是:
memeber?
(define last-friend
(lambda (x y)
(length x)))
如果col为last-friend,那么multirember&co的意思就是:
lat中有多少个与a不同的S表达式
multiinsertLR¶
将new插入到oldL的左边,oldR的右边.
(define multiinsertLR
(lambda (new oldL oldR lat)
(cond
((null? lat) '())
((eq? oldL (car lat))
(cons new
(cons oldL
(multiinsertLR new
oldL
oldR
(cdr lat)))))
((eq? oldR (car lat))
(cons oldR
(cons new
(multiinsertLR new
oldL
oldR
(cdr lat)))))
(else
(cons (car lat)
(multiinsertLR new
oldL
oldR
(cdr lat)))))))
multiinsertLR&co¶
col的newlat参数存放最后插入new参数后的newlat,L参数是在oldL参数左边插入的次数, R参数是在oldR参数右边插入的次数。
(define multiinsertLR&co
(lambda (new oldL oldR lat col)
(cond
((null? lat)
(col '() 0 0))
((eq? oldL (car lat))
(multiinsertLR&co new
oldL
oldR
(cdr lat)
(lambda (newlat L R)
(col (cons new (cons oldL newlat))
(add1 L)
R))))
((eq? oldR (car lat))
(multiinsertLR&co new
oldL
oldR
(cdr lat)
(lambda (newlat L R)
(col (cons oldR (cons new newlat))
L
(add1 R)))))
(else
(multiinsertLR&co new
oldL
oldR
(cdr lat)
(lambda (newlat L R)
(col (car lat)
L
R)))))))
evens-only*¶
找出嵌套队列中所有的偶数
; 此处要用之前定义的运算符号,用系统自带的会出错
; lisp支持分数, 即3/2不缺失其精度
(define even?
(lambda (n)
(= (* (/ n 2) 2) n)))
(define evens-only*
(lambda (l)
(cond
((null? l) '())
((atom? (car l))
(cond
((even? (car l))
(cons (car l)
(evens-only* (cdr l))))
(else
(evens-only* (cdr l)))))
(else
(cons (evens-only* (car l))
(evens-only* (cdr l)))))))
evens-only*&co¶
col函数的第一个参数表示l列表中所有的偶数列表,第二个参数表示所有偶数之积,第三个参数表示l列表中所有非偶数之和。
(define evens-only*&co
(lambda (l col)
(cond
((null? l) (col '() 1 0))
((atom? (car l))
(cond
((even? (car l))
(evens-only*&co (cdr l)
(lambda (newlat m s)
(col (cons (car l) newlat)
(* (car l) m)
s))))
(else
(evens-only*&co (cdr l)
(lambda (newlat m s)
(col newlat
m
(+ (car l) s)))))))
(else
(evens-only*&co (car l)
(lambda (al am as)
(evens-only*&co (cdr l)
(lambda (dl dm ds)
(col (cons al dl)
(* am dm)
(+ as ds))))))))))
(define the-last-friend
(lambda (newl product sum)
(cons sum (cons product newl))))
如果col为the-last-friend,那么evens-only*&co意思为:
返回一个列表,列表的第一个S表达式为l参数中所有的偶数之积,
列表的第二个S表达式为l参数中所有偶数之和,
列表的剩余S表达式为l参数中所有的偶数。
小技巧
这里建议一下,最好将从第二章开始的所有递归函数都用cps形式手动重写一遍。
第一次接触连续的概念不用担心,虽然看起来很难,其实只是你不熟悉而已,按照上面的建议做一遍,就都明白了。
... and Again, and Again, and Again ...¶
Contents
本章概要:
这一章节的内容基本讲的都是数学上的概念或者理论。
一上来先讲到了偏函数(数学概念),然后由此引入了停机问题,
最后讲到了递归的理论基础:Y算子。
偏函数¶
looking¶
从lat的第一元素找起,如果第一元素与a相同同为#t,如果不相同,则跳转到第一元素所对应的lat中的位置再进行比较,直到找到与a相同的S表达式为止。
; looking: symbol lat -> bool
(define looking
(lambda (a lat)
(keep-looking a (pick 1 lat) lat)))
(define keep-looking
(lambda (a sorn lat)
(cond
((number? sorn)
(keep-looking a (pick sorn lat) lat))
(else (eq? sorn a)))))
细心的读者看上面的代码或者定义就知道looking函数有个问题:
并不所有的输入它都能生成对应的结果。
比如:
a = caviar
lat = (7 1 2 caviar 5 6 3)
上面两个参数代入looking函数的后果就是一直死循环,永远不会有结果。
作者将这类不能对所有参数都能产生结果的函数称为 偏函数 。
shift¶
该函数的参数为一个点对,且该点对的第一个S表达式也为一个点对(first),函数会将该参数的中的第中的第二个S表达式(second)和first中的second合并。
小技巧
Sorry,本人水平有限,看不明白上面的话就直接看代码吧。
(define shift
(lambda (pair)
(build (first (first pair))
(build (second (first pair))
(second pair)))))
align¶
(define align
(lambda (pora)
(cond
((atom? pora) pora)
((a-pair? (first pora))
(align (shift pora)))
(else (build (first pora)
(align (second pora)))))))
align仅仅是调整了参数中S表达式的位置。
从它的表面行为来看,它貌似也违反了十戒中的第七戒:
当一个对象的子对象是与其本身表现一致时,这时候可用递归操作。比如:
* 一个列表的子列表
* 一个算术表达式的子表达式
因为参数经过align操作后,并非原参数的子列表,所以我们目前无法一眼就确认align是一个全函数还是一个偏函数。
那么,咱们接下来找出方法来确定align是一个全函数还是一个偏函数。
小技巧
其实,参与递归的参数要有一个趋向性,第七戒只能算是其中一种。
length*¶
计算align参数的长度。
(define length*
(lambda (pora)
(cond
((atom? pora) 1)
(else
(+ (length* (first pora))
(length* (second pora)))))))
我们先看看这个指标是能否表示align的趋向性。
> (align '((a b) (c d)))
$25 = (a (b (c d)))
> (length* '((a b) (c d)))
$26 = 4
> (length* '(a (b (c d))))
$27 = 4
好吧,这个指标明显不能表示align的趋向性,传入的参数和输出的结果的长度都一样,只能继续找其它指标。
weight*¶
计算align参数的权重。
align每次都会对点对中的第一个S表达式特殊对待,所以我们可以增加它的权重,在计算其长度的基础上,设定第一个S表达式占的权重为2,第二个S表达式占的权重为1。
(define weight*
(lambda (pora)
(cond
((atom? pora) 1)
(else
(+ (* (weight* (first pora)) 2)
(weight* (second pora)))))))
我们再来试试看。
> (align '((a b) (c d)))
$25 = (a (b (c d)))
> (weight* '((a b) (c d)))
$26 = 9
> (weight* '(a (b (c d))))
$27 = 7
嗯,看出苗头了,如果我们用更多的参数进行测试的话,这个趋向性就更明显了,所以说,align不是一个偏函数。
shuffle¶
还是刚才align的逻辑,只不过用revpair函数来替换shift函数。
(define shuffle
(lambda (pora)
(cond
((atom? pora) pora)
((a-pair? (first pora))
(shuffle (revpair pora)))
(else (build (first pora)
(shuffle (second pora)))))))
现在咱们再来求证shuffle是否是一个偏函数。
> (shuffle '(a (b c)))
$1 = (a (b c))
> (shuffle '(a b))
$2 = (a b)
> (shuffle '((a b) (c d)))
... ...
(shuffle ‘((a b) (c d)))一直运行不出结果(死循环),所以它是偏函数。
其它例子¶
接下来作者又列出了几个偏函数的例子并且直接给出结果,未给出证明步骤。
(define C
(lambda (n)
(cond
((one? n) 1)
(else
(cond
((even? n) (C (/ n 2)))
(else (C (add1 (* 3 n)))))))))
C函数除了传入参数0没有值外,其它都能得到结果,所以它是一个偏函数。
(define A
(lambda (n m)
(cond
((zero? n) (add1 m))
((zero? m) (A (sub1 n) 1))
(else (A (sub1 n) (A n (sub1 m)))))))
A虽然是一个全函数,但是对于某些参数,它的运行时间可能会非常地长。
小技巧
作者给出了一系列的例子,是为了引入了停机问题。
停机问题¶
既然有偏函数这种求不出结果(一直在运算,不会返回结果)的函数存在,那我们能不能编写出一个函数,能够判断某个函数是否是偏函数呢?
我们先假设有这样一个函数:
(define will-stop?
(lambda (f)
...))
然后利用这个函数再编写一个函数:
(define last-try
(lambda (x)
(and (will-stop? last-try)
(eternity x))))
- 假设(will-stop? last-try)返回的是#t,则(and (will-stop? last-try) (eternity x)) == (eternity x),(eternity x)是偏函数,不会返回结果,所以last-try也不会返回结果。该假设不成立。
- 假设(will-stop? last-try)返回的是#f,则(and (will-stop? last-try) (eternity x))为#f,所以last-try也返回#f。该假设也不成立。
通过上面的证明, 我们无法定义出will-stop?这种函数出来。
Y算子¶
Scheme通过(define ...)来定义一个函数。上面我们说到我们无法定义出will-stop?函数,作者此时话峰一转,问道:那递归函数呢?
我在定义某个递归函数的时候(以length为例),length还在正在被定义当中,怎么能自己调用自己呢?
通过这个问题作者就引入了Y算子(Y Combiniator),也叫Y组合子。
不动点组合子(Fixed-point combinator;不动点算子)是计算其他函数的一个不动点的高阶函数。
函数f的不动点是一个值x使得f(x) = x。
鉴于一阶函数(在简单值比如整数上的函数)的不动点是个一阶值,
高阶函数f的不动点是另一个函数g使得f(g) = g。
那么,不动点算子是任何函数fix使得对于任何函数f都有
f(fix(f)) = fix(f)。
不动点组合子允许定义匿名的递归函数。它们可以用非递归的lambda抽象来定义。
接下的代码就是就以length函数为例,一步步推导出Y算子。
;; 使用define的length函数定义
(define length
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l)))))))
现在没有了define这个定义功能,也就是说没有了length这个名称了,我们怎么调用自身呢?
好吧,让我先从最简单的情形一步步分析。
;; length0
;; 计算元素个数为0的列表长度
(lambda (l)
(cond
((null? l) 0)
(else (add1 (eternity (cdr l))))))
;; length<=1
;; 计算元素个数为1的列表长度
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length0 (cdr l))))))
;; 将length0替换成它的定义
(lambda (l)
(cond
((null? l) 0)
(else (add 1 ((lambda (l)
(cond
((null? l) 0)
(else (add1 (eternity (cdr l))))))
(cdr l))))))
;; length<=2
;; 计算元素个数为1的列表长度
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length<=1 (cdr l))))))
;; 将length<=1替换为它的定义
(lambda (l)
(cond
((null? l) 0)
(else (add1 ((lambda (l)
(cond
((null? l) 0)
(else (add1 ((lambda (l)
(cond
((null? l) 0)
(else (add1 (eternity (cdr l))))))
(cdr l))))))
(cdr l))))))
参照上面的思路,我们可以整出length<=3...length∞
但是按这种思路写出来的代码不实现,越到后面的函数最大,根本无法真正写出来。
我们可以重新调整一下length:
根据上面的代码发现一个现象,每个length函数的大体逻辑是一样,
每次只是eternity这个位置的代码发生了变化。
好的,既然只有它是可变的,那么我们就将之提取出来,当作参数传入。
;; length0
((lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l)))))))
eternity)
;; length<=1
((lambda (f)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (f (cdr l)))))))
((lambda (g)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (g (cdr l)))))))
eternity))
;; length<=2
((lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l)))))))
((lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l)))))))
((lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l)))))))
eternity)))
照上面的逻辑写下去,和以前没差啊,还是要写很多。
咱们再重新调整一下length:
我们再观察一下上面的代码:
(lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l)))))))
貌似就这个函数每次在重复。
好的,我们也将它提取出来,当作参数传入。
;; length0
((lambda (mk-length)
(mk-length eternity))
(lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l))))))))
;; length0简化为(mk-length eternity)
;; length<=1
((lambda (mk-length)
(mk-length (mk-length eternity)))
(lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l))))))))
;; length<=1简化为(mk-length (mk-length eternity))
;; length<=2
((lambda (mk-length)
(mk-length (mk-length (mk-length eternity))))
(lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l))))))))
;; length<=2简化为(mk-length (mk-length (mk-length eternity)))
;; length<=3
((lambda (mk-length)
(mk-length (mk-length (mk-length (mk-length eternity)))))
(lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l))))))))
;; length<=3简化为(mk-length (mk-length (mk-length (mk-length eternity))))
上面的逻辑/代码比之前简单了,但还是没有根本解决问题,所以还需要继续调整:
还是先从length0看起,
eternity没起什么实质的作用,\
我们就用mk-length来代替之;
length也是,不就一个参数名么,要统一就全部统一。
;; length0
;; 将eternity替换为mk-length
((lambda (mk-length)
(mk-length mk-length))
(lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l))))))))
;; length0
;; 使用α-变换将length替换为mk-length
((lambda (mk-length)
(mk-length mk-length))
(lambda (mk-length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (mk-length (cdr l))))))))
继续调整length<=1。
上面的length0如果变成length<=1的话,就会走到else分支,
走到else分支就出错了,因为mk-length本身是一个函数,然后它将自身当作参数传入。
而(add1 (mk-length (cdr l)))却给mk-length传入了一个列表。
所以我们简单改一下(add1 (mk-length (cdr l)))中的mk-length即可,
让它支持计算长度不超过1的列表。
;; length<=1
((lambda (mk-length)
(mk-length mk-length))
(lambda (mk-length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 ((mk-length eternity) (cdr l))))))))
咱们再做最后一次的调整:
再将eternity替换为mk-length,然后length函数就诞生了。
我们简单梳理一下(以计算长度为2的列表为例):
1. (mk-length mk-length)这个操作生成一个计算列表长度的函数length<=2。
2. 由于列表不为空,它会走到else分支。
3. 在else分支中,又生成了一个计算列表长度的函数,并且对(cdr l)计算其长度,然后+1返回。
4. 现在(cdr l)长度为1,然后又走到else分支。
5. 在else分支中,又生成了一个计算列表长度的函数,并且对(cdr l)计算其长度,然后+1返回。
6. (cdr l)长度为0,这次不走else分支了,直接返回0。
7. 0 + 1 + 1 = 2, 最后返回2。
;; length
((lambda (mk-length)
(mk-length mk-length))
(lambda (mk-length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 ((mk-length mk-length) (cdr l))))))))
不过还是有一个问题:
;; 使用define的length函数定义
(define length
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l)))))))
这是使用define的length函数定义,但现在不用define之后,和原来的代码写法不一样了。
一眼看去,不一样的地方在 (mk-length mk-length) ,将之提取出来吧。
;; length
((lambda (mk-length)
(mk-length mk-length))
(lambda (mk-length)
((lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l)))))))
(lambda (x)
((mk-length mk-length) x)))))
最里的函数貌似和原来的定义一样了,但是它陷在里面,将之提到外面来。
;; length
((lambda (le)
((lambda (mk-length)
(mk-length mk-length))
(lambda (mk-length)
(le (lambda (x)
((mk-length mk-length) x))))))
(lambda (length)
(lambda (l)
(cond
((null? l) 0)
(else (add1 (length (cdr l))))))))
好了,这次length函数的定义提取出来了,那我们得到一个额外的东西:
(lambda (le)
((lambda (mk-length)
(mk-length mk-length))
(lambda (mk-length)
(le (lambda (x)
((mk-length mk-length) x))))))
就是它提供了一种能力:将某个非递归函数转换为递归形式。
我们可以给它起个名字: 应用序Y算子
(define Y
(lambda (le)
((lambda (f)
(f f))
(lambda (f)
(le (lambda (x)
(f f) x))))))
What Is the Value of All of This?¶
Contents
本章概要:
本章基于前面几章节的基础,
引入了table这个数据结构,
然后用Scheme实现了一个简化版本的Scheme解释器(自身实现自身,亦叫自举)。
小技巧
王垠前辈也写过一篇:怎样写一个解释器(没有原文地址,搜索即可)。
讲的内容差不多,也是比较好理解,如果对英文没耐心的,可以参考他的文章。
entry¶
entry是这样一种数据结构:
它是一个点对,里面包含两个长度相同的子列表。
第一个子列表中的所有S表达式各不相同(即为一个集合)。
lookup-in-entry¶
根据name在entry中查找对应的值。
entry-f用来处理在entry中不存在name的情况。
(define lookup-in-entry
(lambda (name entry entry-f)
(lookup-in-entry-help name
(first entry)
(second entry)
entry-f)))
(define lookup-in-entry-help
(lambda (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))))
table¶
也叫环境(environment)。它是这样一种数据结构:
它是一个列表,里面所有的S表达式都为entry。
lookup-in-table¶
根据name在table中查找其对应的值。
(define lookup-in-table
(lambda (name table table-f)
(cond
((null? table) (table-f name))
(else (lookup-in-table name
(car table)
(lambda (name)
(lookup-in-table name
(cdr table)
table-f)))))))
简化版Scheme解释器¶
作者通过一系列的对话,总结了Scheme中几种基本语义类型。
既然Scheme作为一门函数式编程语言,自然就用函数(function)来表示上面这些语义类型了。
小技巧
如果有兴趣的同学可以在网上搜索一下其它语言的Scheme解释器实现(比如:Python), 有的是用类来实现的。
当然用什么来表示这些类型不是重点,重点是要了解解释器的原理。
那写解释器的第一步:
我们需要知道某个S表达式属于上面归纳的那种语义类型,
并且找到该类型对应的处理函数。
expression-to-action¶
实现S表达式属于哪种语义类型,并返回其对应的处理函数。
从第一章节我们就开始了Scheme中S表达式有两种:
- atom
- list
(define expression-to-action
(lambda (e)
(cond
((atom? e) (atom-to-action e))
(else (list-to-action e)))))
atom-to-action¶
实现atom类型的S表达式属于哪种语义类型,并返回其对应的处理函数。
(define atom-to-action
(lambda (e)
(cond
((number? e) *const
((eq? e #t) *const)
((eq? e #f) *const)
((eq? e (quote cons)) *const)
((eq? e (quote car)) *const)
((eq? e (quote cdr)) *const)
((eq? e (quote null?)) *const)
((eq? e (quote eq?)) *const)
((eq? e (quote atom?)) *const)
((eq? e (quote zero?)) *const)
((eq? e (quote add1)) *const)
((eq? e (quote sub1)) *const)
((eq? e (quote number?)) *const)
(else *identfier)))))
list-to-action¶
实现atom类型的S表达式属于哪种语义类型,并返回其对应的处理函数。
(define list-to-action
(lambda (e)
(cond
((atom? (car e))
(cond
((eq? (car e) (quote quote)) *quote)
((eq? (car e) (quote lambda)) *lambda)
((eq? (car e) (quote cond)) *cond)
(else *application)))
(else *application))))
value¶
虽然上面两个函数里面有一堆的help函数未实现,但是咱们先假定它们实现,先把最外层的框架写好,再实现底层细节。
有了expression-to-action,那么解释器的雏形就有了。
; (quote ()) 表示一个空的table
(define value
(lambda (e)
(meaning e (quote ()))))
(define meaning
(lambda (e table)
((expression-to-action e) e table)))
e好理解,就是需要解释的S表达式么,table是做什么的?
table是用来存储与S表达式对应的上下文环境。
比如:S表达式 (+ n 1) ,当我们计算 (+ n 1) 怎样知道n的值?
答案就在table里。
解释器会在给n赋值的时候就将其对应关系保存到了table中,
当调用 `(+ n 1)` 时,解释器就会从table中获取n对应的数值,然后再进行计算。
*const¶
(define *const
(lambda (e table)
(cond
((number? e) e)
((eq? e #t) #t)
((eq? e #f) #f)
(else (build (quote primitive) e)))))
*identfier¶
这里就是我上面关于table的说明了。
(+ n 1) 中的n会被当作 identfier 来处理,就会调用下面的 *identfier 处理函数。
*identfier 则从table中找出与n对应的值。
(define *identfier
(lambda (e table)
(lookup-in-table e table initial-table)))
(define initial-table
(lambda (name)
(car (quote ()))))
*lambda¶
原语函数和非原语函数有什么区别?
原语函数是指Scheme语言本身提供的一些基本函数。 其实就是一些我们在写Scheme解释器时预先定义好的函数。
非原语函数是用户通过(lambda ...)形式来定义的函数。那我们在解析到非原语函数时,需要将它的参数和函数体保存到table中,等待之后的*identfier调用。
(define *lambda
(lambda (e table)
(build (quote non-primitive)
(cons table (cdr e)))))
*lambda会将table、参数、函数体绑定在一个列表中。
那么为了方便我们之后取出对应的数据,我再定义一些help函数。
(define table-of first)
(define formals-of second)
(define body-of third)
*cond¶
(define *cond
(lambda (e table)
(evcon (cond-lines-of e) table)))
(define cond-lines-of cdr)
evcon实现了cond函数的功能。
(define evcon
(lambda (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)))))
;; 判断某个S表达式是否为else分支
(define else?
(lambda (x)
(cond
((atom? x) (eq? x (quote else)))
(else #f))))
(define question-of first)
(define answer-of second)
注解
evcon没有判断lines是否为空。
可能作者是为了实现的简洁,暂时忽略这种异常情况。
所以在使用本章节实现的Scheme解释器时,cond函数中最好至少代入一个判断分支语句。
*application¶
application表示的是这样一种S表达式:
它为一个列表,列表的第一个元素(car)表示一个函数,
剩余的元素(cdr)表示该函数的调用参数。
(define *application
(lambda (e table)
(apply
(meaning (function-of e) table)
(evlis (arguments-of e) table))))
(define function-of car)
(define arguments-of cdr)
; 获取调用参数中每参数所对应的值。
(define evlis
(lambda (args table)
(cond
((null? args) (quote ()))
(else (cons (meaning (car args) table)
(evlis (cdr args) table))))))
apply¶
执行函数调用。
上面讲过函数分为两种:
- 原语函数
- 非原语函数(自定义函数)
(define apply
(lambda (func vals)
(cond
((primitive? fun)
(apply-primitive (second fun) vals))
((non-primitive? fun)
(apply-closure (second fun) vals)))))
(define primitive?
(lambda (l)
(eq? (first l) (quote primitive))))
(define non-primitive?
(lambda (l)
(eq? (first l) (quote non-primitive))))
(define apply-primitive
(lambda (name vals)
(cond
((eq? name (quote cons))
(cons (first vals) (second vals)))
((eq? name (quote car))
(car (first vals)))
((eq? name (quote cdr))
(cdr (first vals)))
((eq? name (quote null?))
(null? (first vals)))
((eq? name (quote eq?))
(eq? (first vals)))
((eq? name (quote atom?))
(:atom? (first vals)))
((eq? name (quote zero?))
(zero? (first vals)))
((eq? name (quote add1))
(add1 (first vals)))
((eq? name (quote sub1))
(sub1 (first vals)))
((eq? name (quote number?))
(number? (first vals))))))
(define :atom?
(lambda (x)
(cond
((atom? x) #t)
((null? x) #f)
((eq? (car x) (quote primitive)) #t)
((eq? (car x) (quote non-primitive)) #t)
(else #f))))
;; 将调用参数及非原语函数的参数组成一个entry(组成对应关系)
;; 然后添加到table中,再对该非原语函数的函数体求值即可。
(define apply-closure
(lambda (closure vals)
(meaning (body-of closure)
(extend-table (new-entry (formals-of closure)
vals)
(table-of closure)))))
关于我¶
- 标签: Linux、Emacs、Python、Scheme、Bash Shell
- 业余: 佛学、toastmaster俱乐部演讲
- 运动: 桌上足球、羽毛球、台球、乒乓球
- 性格: 内向、中庸
- 爱好: 看书、编程、折腾跟计算机相关的事
- 联系: chenjiee815@gmail.com