基于消息传递的 Scheme OOP

续上次的OOP 诡异教程，我用 Scheme 宏写了一个类似的系统，拿来晒晒。

;; 这里只有部分定义，快速排序和二分法查找的代码就不帖在这儿了
;; 这里是 slot 类型的定义，Scheme 中不能动态 eval，只能用点别的招数
(define (make-slot name act) (cons name act))
(define (slot-name s) (car s))
(define (slot-act s) (cdr s))
(define (slotstring a) (symbol->string b)))

;; 主要的转换宏，语法比较丰富，但至少要带有一个 that 块
;; 语法可以只给出 that 块：(class (that (slot-name1 slot-act1) ...))
;; 也可以指定继承，要求在 class 关键字后出现原型对象：
　　;;(class extended-obj (that (slot-name1 slot-act1) ...))
;; 在 that 块之后还可以加入 where 块，这样可以指定不对外可见的类属性
;; 需要注意的是，where 块中的定义不能引用 self 等特殊命名，that 才行
;; 另外外部只能引用 origin, has-slot?, slot-names 3个特殊命名
(define-syntax class
(syntax-rules (that where)
　((_ that-block)
　 (class (absobj) that-block))
　((_ org that-block (where def ...))
　　(letrec (def ...) (class (absobj) that-block)))
　((_ org (that (slot val) ...))
　　(lambda ()
　　 (letrec ((slot val) ...)
　　　(let* ((origin org)
　　　　　　 (slots (list-qsort slotvector (map slot-name slots)))
　　　　　　 (slot-acts (list->vector (map slot-act slots)))
　　　　　　 (has-slot? (lambda (v)
　　　　　　　　　　　　 (vector-bsearch symbol index -1)
　　　　　　　　　　　(vector-ref slot-acts index)
　　　　　　　　　　　(case verb
　　　　　　　　　　　 ('origin origin)
　　　　　　　　　　　 ('slot-names slot-names)
　　　　　　　　　　　 ('has-slot? has-slot?)
　　　　　　　　　　　 (else (origin verb))))))))
　　　 self))))
　((_ that-block where-block)
　 (class (absobj) that-block where-block))))

;; 这里需要注意的是，因为嫌烦，absobj 被实现为了一个空壳子
(define (absobj)
(lambda (verb)
　(display "This object can't handle ")
　(display verb)
　(newline)))

测试一下：
> (define c1 (class (that (x 10))))
; no values returned
> (define c2 (class (c1) (that (z 16) (y 12))))
; no values returned
> (define o2 (c2))
; no values returned
> (o2 'x)
10
> (o2 'non-slot)
This object can't handle non-slot
#{Unspecific}
> (o2 'slot-names)
'#(y z)
> (o2 'origin)
#{Procedure 8647 (self##497 in c1)}

输出好像很古怪的样子~`我用的环境是 Scheme 48 虚拟机。
这儿的例子只覆盖了一小部分，剩下的比如 where 就自己慢慢玩吧。
Scheme 的“卫生宏”不但强大，还能制止你设计不好的语法，有意思。
消息传递真的很有意思。留个小题目，增加一个特殊方法 clone，把继承机制调整为差异继承+纯基于对象，类似 IO 语言 的面向对象机制。
这个“系统”的完整代码在此下载，升级版本就算了吧 :)

Scheme数据结构——向量也疯狂

学过数据结构的人都知道，一棵完全二叉树（除去最低层元素从左到右排列，其它的层都为满的）可以保存在一个数组中 这个完全二叉树存储在vector中就像这样：#(4 6 2 8 7 3) 可以看出一个结点下标 i 与它的左右孩子结点下标 j1，j2具有如下关系： j2 = 2*i+1，j2 = 2*i +2 然后，我们通过调整数组上结点的排列，把它变成一个“二叉堆”。这里显示的是一个最大堆，即：对于(vector-length a) => n，当(< (+ (* 2 i) 1) n) => #t时，有(> (vector-ref a (+ (* 2 i) 1)) (vector-ref a i) => #t；当(< (+ (* 2 i) 2) n) => #t时，有(> (vector-ref a (+ (* 2 i) 2)) (vector-ref a i) => #t。
这么复杂的S-exp，说白了，就是每个结点的左右孩子结点（如果有的话）都小于这个结点。 知道了这些，我们就可以来考虑一下怎么把完全二叉树转成最大堆了。方法是，先根据公式求出第一个非叶结点下标(define n (/ (- n 1) 2))，然后比较左孩子结点(vector-ref a (+ (* 2 i)与右孩子结点(vector-ref a (+ (* 2 i)的大小，将较大者与(vector-ref a i)比较，如果更大就互换。然后对于(- i 1)，(- i 2)完成以上步骤，于是，最大堆就构造完成了。

• 调整结点8：
  

• 调整结点3：

• 调整结点8：最后，最大堆有什么用呢？废话，当然是堆排序了；我最喜欢的排序算法就是它，因为它充分体现了“数形结合”的思想。 因为排序过程中整个堆都在大规模地变化（当然反应到数组上不是这么回事），所有就不再进行图解了；大致将一下即可：先将整个vector调整为最大堆，然后将堆顶的那个最大的元素与堆中最后一个元素互换，接着调整前 (- n 1) 个元素为最大堆，再将堆顶元素与堆中最后一个元素互换。。。如此反复（其实就是逐个排出最大元素），时间复杂度为O(n*log2 n)。

大致代码（缺少heep的实现）：
(define (heep-sort a)
(let* ((n (vector-length a))(tmp 0) (i (- n 1)))
(begin (make-heep a) ;调整a为最大堆
(when (> i 0)(set! tmp (vector-ref a 0))
(vector-set! a 0 (vector-ref a 1))
(vector-set! a 1 tmp)
(heep a i 0) ;在向量a上从下标0开始调整长度为i的一段为最大堆
(set! i (- i 1)))))) ;最好用尾递归代替循环

Scheme数据结构——list数组

（By the way，我终于知道如何删除list的头节点了。必须要使符号指向一个头节点，再由它确定当前节点，否则无非实现元素“脱链”）

list数组，顾名思义，由list构成的数组（或矩阵），学名不明。它不是一种具体的数据结构，但常被用作表示其它数据结构。它的一般形式如下：
当然，这里的vector也可以是一个矩阵。用Scheme实现时，注意list不需要随机插入元素的功能，但能随机脱链，且只能从尾部插入（技巧：(set-cdr! (list-tail l (- (length l) 1)) obj)）——list中的数据往往是无序的。可以把它设计得更强，但并不实用。
下面讲它的两种典型应用。

一. 图的邻接表存储结构

• 用矩阵的第一列存储结点，第二列存储结点的号码，第三列保存此行所对应结点链接的边的结束结点号码（当然还可以再用一列保存权值）。这样说有点绕人，我们看个例子好了：
• 这是一个有向图。让我们看看它是怎样用邻接表存储的：
• 复杂吗？吓，一点也不。它可以用来对付边较稀疏的有向图。

二. 链表法解决哈希冲突

• 讲解哈希表关键字冲突的一般思路是建立哈希函数组，逐个调用。但这个方法有个明显缺点：如果把哈希表作为一种服务提供给操作对象的话用户就麻烦大了。用向量上链接的list来保存hash code相同的元素是个不错的办法。
• 例子：这个哈希表的元素是 a={16, 54, 66, 43, 29, 55...}，m=13，哈希函数为 h(K)=K mod m（省略了其它7个元素）：
• 用矩阵的第一列存储基本元素，多于的“同位素”保存在临时开辟的list中。这样的设计重点考虑了效率，比较使用，但会给元素的删除带精神分裂般的麻烦，插入元素也够戗；如果你追求程序的“漂亮”，可以把所有元都平起平坐地存储在list里，不使用矩阵，元素的删除操作全是脱链。

从上面两个例子可以看出，list数组主要用于解决稀疏的“同位素”的存储问题。确定“同位素”的同位存储性质（比如同hash code元素的平等地位）和必要性（比如有向图结点拥有边与其起始结点的偏序关系），是使用它的重要前提。

let, let* 和 letrec（转）

使用 let, let*, letrec 都可以在当前环境中构造局部变量。这种 变量的生命会延续到这个环境消失为止。

这就像 C 语言里的

{  int x = 10;
int y = 20;

foo(x,y);
}

但是有一点不同就是，Scheme 的 let 生成的环境是分配在堆里而不 是像 C 那样分配在栈里的。所以 let 的局部变量有可能在 let 的 block 执行完毕以后还继续存在，只要有某些东西引用到它们。

这样我们可以制造一些返回函数的函数，这些函数拥有自己的状态记 忆，而这些记忆并不是全局变量，它们有点像 C 函数的 static 变 量。

下面是几个例子：

(define (function-gen n)
(let ((local-var 0))
 (lambda ()
   (display "The local-var is ")
   (display local-var)
   (newline)
   (set! local-var (+ 1 local-var)))))

(define f1 (function-gen 0))
(define f2 (function-gen 100))

(f1)
(f2)

函数 function-gen 接受一个参数 n，并且把它保存到自己的局部变 量 local-var. 它返回一个新的函数，这个函数被调用就会打印 local-var 的值，并且把 local-var 的值加 1.

我们用 0 和 100 作为参数传递给 function-gen，生成了两个函数 f1 和 f2. 这是两个起点不同的计数器。f1 从 0 开始，而 f2 从 100 开始。每次被调用两个函数都打印自己的数字，并且加 1.

可见，f1 和 f2 所见到的 local-var 是两个不同的空间。也就是说， 每次调用 function-gen，都会由 let 生成一个新的变量 local-var, 这个变量将一直伴随新生成的函数。

注意 let 里的 binding 是这样产生的。首先，进入 let 时，我们 只看到外层的绑定，然后每个 let 绑定的右边被 eval，然后这些值 被放到临时的一些空间，所有的右边都求值完毕后，这些值被一一赋 给左边的名字。

如果我们的代码不是那么简单，我们在 let 里生成了一个函数。比 如这样：

(define (func-gen)
(let ((x 10) (y 20))
 (lambda (a b)
       (+ x y a b))))

(define bar (func-gen))

func-gen 函数中被调用时，它在 let 空间中生成了一个函数，并且 作为 func-gen 的返回值送到外层，它被绑定到最外层的环境中的 bar 变量。那么这个函数引用了这个环境，这个 let frame 不会被 回收。

bar 如果在外层层环境被调用，那么它的名字绑定环境仍然是 let 里面的环境。也就是说，它仍然可以使用局部变量 x 和 y!

如果我们调用

(f 1 2)

就得到结果 33.

这相当于同时赋值。

所以在下面这种情况里，内层的 let 绑定 b 时，实际上使用的是外 层的 x 在计算。

(let ((x 10)    ; bindings of x
   (a 20)))  ; and a
+----------------------------------------------------------+
| (foo x)                                 scope of outer x |
| (let ((x (bar))                           and a          |
|       (b (baz x x)))                                     |
|  +------------------------------------------------+      |
|  | (quux x a)                    scope of inner x |      |
|  | (quux y b)                    and b            | )    |
|  +------------------------------------------------+      |
| (baz x a)                                                |
| (baz x b)                                                |
+----------------------------------------------------------+

Scheme数据结构——简单二叉树

终于把用Scheme写的二叉树发出来了，前两天网卡没钱拉。
层序例遍算法写出来了，可惜用不了——没法儿用Scheme实现队列！我折腾了半天，写出这么一个怪物：
(define queue list)
(define (queue-push! q o)
(set-cdr! (list-tail q (- (length q) 1)) (cons o null)))

可pop还是实现不了——不知道怎么删除pair，于是放弃。
把简单二叉树的实现贴在这儿吧，虽然没有一点实用价值。

(define null '()) ;用null代替空list

(define (child data left right) ;用它来申明一个“孩子”
(cons data (cons left right)))
(define (child? o)
(and (pair? o) (pair? (cdr o))))
(define (child.data o)
(if (child? o)
(car o)))
(define (set-child.data! o data)
(if (child? o)
(set-car! o data)))
(define (child.left o)
(if (child? o)
(cadr o)))
(define (set-child.left! o p)
(if (child? o)
(set-car! (cdr o)) p))
(define (child.right o)
(if (child? o)
(cddr o)))
(define (set-child.right! o p)
(if (child? o)
(set-cdr! (cdr o) p)))

;先序例遍递归版，用一句(if (not (null? o)...)省了不少判断
(define (child-tree-pre o func)
(if (not (null? o))
(begin
(func (child.data o))
(child-tree-pre (child.left o) func)
(child-tree-pre (child.right o) func))))
;后序例遍
(define (child-tree-post o func)
(if (not (null? o))
(begin
(child-tree-post (child.left o) func)
(child-tree-post (child.right o) func)
(func (child.data o)))))
;。。。中序~~可怜没有层序和分步例遍~~
(define (child-tree-mid o func)
(if (not (null? o))
(begin
(child-tree-mid (child.left o) func)
(func (child.data o))
(child-tree-mid (child.right o) func))))

Scheme数据结构——神奇的pair

Scheme中提供了两种可以存储泛型数据的数据结构——list和vector。list其实是一个链表，它是由pair实现的。学了Scheme很久才发现，原来pair其实是其它语言中我们超常用的Node（节点）！这下我总算理解了Scheme是怎样架起数据结构的了。

一. 链表（内部已实现）

• 每个pair的左值存储数据，右值存放指针（Scheme中cons值即引用）：
• 然后用指针指向（其实是赋值）下一个pair，链中最后一个为null（空值）：
• 这个语法树转换成Scheme代码就是(value . (value . (value . null)));当然只是“意思”一下，实际不可能有同名符号。

二. 二叉树（正在编写中…）

• 又一个用节点连起来的基本数据结构。每个二叉树child（孩子）可以这样设计，用第一个pair的左值保存数据，右值为另一个pair，它的左右值表示孩子的指针：
• 代码为(value . (left . right))
  
• 然后，n个这样的child组合为一棵二叉树。同样，没有孩子时指针为null：

• 上面这棵树的代码大致是这样：(value . ((value . ((value . (null . null)) . (value . (null . null)))) . (value . (null . null))))。
• 我的二叉树实现正在写着，面前至少可以用(child)代替(cons(cons))申明孩子节点，下一步编写tree的整个数据结构支持，最好能支持一次例遍。

有了链表和二叉树，队列，栈，线索二叉树之类就都能直接实现了。其它的数据结构如集合，树，图，HashTable等等多是由向量＋pair构成的，不典型，暂且不提。

Scheme学习笔记（五）

（这应当是最后一篇了，明天来继续数组左旋...）

八. 宏

• MIT-Scheme的宏定义：

  (define-syntax 宏名
  (syntax-rules()
  ((模板) 操作))
  . . . ))

• 在操作时，先用let绑定参数，然后用lambda定义过程：

  (let ((本地操作 (lambda 参数 宏主体 ...)))
  (lambda (e r)
   (apply 本地操作 (cdr e))))

• (define-syntax start
   (syntax-rules ()
       ((start exp1)
           exp1)
        ((start exp1 exp2 ...)
   (let ((temp exp1)) (start exp2 ...))) ))

• 实现的短小的定义：
  

  (define-macro MACRO-NAME
  (lambda MACRO-ARGS
  MACRO-BODY ...))

九. 结构

• 结构模板定义：(defstruct 结构名 属性（不构成list）)

(defstruct tree height girth age leaf-shape leaf-color)

• 新建结构：(make-结构名 属性符号 值 符号 值)

(define coconut
(make-tree ’height 30
’leaf-shape ’frond
’age 5))

• 使用结构：(结构名.属性名 结构对象);返回属性值，(set!结构名.属性名 结构对象 新属性值);更改属性值

(tree.leaf-shape coconut) => frond
(set!tree.height coconut 40)
(tree.height coconut) => 40

• defstruct本身未提供，需要宏来定义，具体不再写出。

十. 面向对象

• Scheme标准默认未提供！我看也用不着。

祝所有Sceme的爱好者们早日摆脱无聊和世俗的coder世界！

Scheme学习笔记（四）

（下一篇是最后一篇，讨论宏，结构和面向对象（其实没什么用））

四. 流程控制

• Scheme中只有if操作是内置的，其它用宏实现。
• 应尽量用尾递归代替循环。

• (if (测试表达式) (操作) (else操作))
• 由多个语句构成的操作用(begin)语句组合

• (when (测试表达式) (多个操作))
• (when (非测试表达式) (多个操作))
• 其它的操作式不必用begin组合
• case语句：

(case c
((#\a) 1)
((#\b) 2)
((#\c) 3)
(else 4)) => 3

• 逻辑表达式操作：
• and在无非比较时返回后一个值：(and 1 2) => 2
  (and #f 1) => #f
• r在无非比较时返回前一个值：(or 1 2) => 1
  (or #f 1) => 1

六. 递归

• 不能工作的代码，因为let或let*会将操作名绑定到各自的词法定界，导致互相递归调用的函数不能互访：
  

(let ((local-even? (lambda (n)
(if (= n 0) #t
(local-odd? (- n 1)))))
(local-odd? (lambda (n)
(if (= n 0) #f
(local-even? (- n 1))))))

• 把绑定操作换成letrec即可。
• 由begin引导的语句序列返回最后一个语句的值。
• 命名let可简化局部递归调用：

(let countdown ((i 10))
(if (= i 0) ’liftoff
(begin
(display i)
(newline)
(countdown (- i 1))))) ;输出一个整数递减过程中的每个值

• 迭代器(for-each 操作 (被操作list))
• 迭代器(map 操作 (被操作list))，返回list中每一个被操作项构成的list（python里的那个函数的同名被复制品）。

Scheme学习笔记（三）

（另一些参考资料：Scheme语言介绍，语言概要（上）（下））

三. 过程

• lambda形式：((lambda 参数 (过程)) 可选的实际参数)

((lambda (x) (+ x 2)) 5) => 7

• 带括号时为形式参数，否则被认为是一个参数list

((lambda someFriends ; 参数周围没有括号 ! (DisplayLine "hi there " someFriends)) 'mole 'bear 'tiger)

• 定义函数用define：(define add2 (lambda (x) (+ x 2)))，省略lambda：(define (add6 x) (+ x 6))
• 谓词(procedure?)来测试一个对象实际上是否为过程
• 函数名即操作名：(add2 9) => 11
• (apply 函数名 参数列表)强制调用。
• 过程的套嵌定义遵循词法定界。

五. 词法定界（下篇讲“四”）

• define定义当前定界以下对象。
  
• (set!)仅改变当前定界中的对象：

(define counter 0)
(define bump-counter (lambda ()
(set! counter (+ counter 1))
counter))

(bump-counter) => 1
(bump-counter) => 2
(bump-counter) => 3

• 相对define，(let (定义局部变量) (其它代码))绑定局部变量到过程：

(let ((x 2) (y 5)) (* x y)) => 10


• let*内的定义不改变上级定界定义的局部变量

• letrec的定义可互交引用？

(letrec ((even?
             (lambda(x)
             (if (= x 0) #t
                     (odd? (- x 1)))))
         (odd?
             (lambda(x)
             (if (= x 0) #f
                     (even? (- x 1))))))
(even? 88))  =>  #t

• letrec帮助局部过程实现递归。

• 非标准的(fluid-let)不改变上级定界变量却引作当前定界局部变量——无聊。。。

(fluid-let ((counter 99))
(display (bump-counter)) (newline)
(display (bump-counter)) (newline)
(display (bump-counter)) (newline))
输出100，101，102，但原counter不变。

Scheme学习笔记（二）

（都忘了说了，我复习用的教材是Teach Yourself Scheme in Fixnum Days，还有一本The Scheme Programming Language也很好，但太长，没看过）

2. 复合类型

比较谓词：

(eqv?   (list 'a) (list 'a)) ; 它们 "看起来一样"，
;()
(eq?    (list 'a) (list 'a)) ; 存储在不同的内存单元中。
;()
(equal? (list 'a) (list 'a))
;#t

• 字符串：申明(define str "This is a string.")
• 用字符申明：(string #\h #\e #\l #\l #\o) => "hello"
• (string-ref 字符串 位置（整数）)返回字符串该位置上的字符
• (string-append "E " "Pluribus " "Unum") => "E Pluribus Unum"
• 改变字符串（重新赋值）(string-set!)
• (string-length "mumble") => 6

• 向量（貌似数组）：值以"#"开头
• 申明(vector 0 1 2 3 4) => #(0 1 2 3 4)或(make-vector 长度)

• 对（不知道怎么翻译pairs这个词~~）
• 分为左右值，左值叫car，右值叫cdr，用他们作操作符获取左右值
• 申明(cons 左值 右值)
• (cons 1 #t) => ’(1 . #t)
• (set-car!)，(set-cdr!)
• 重要！经常右值套嵌！(cons 1 (cons 2 (cons 3 (cons 4 ’()))))形成list：(list 1 2 3 4)

• list（太有名，懒得翻译）
  

• list操作：取值(list-ref)
• list-tail 通过除去前面的 n 个元素来获得一个子表
• 添加元素(append)
• (null?) 检查它的操作对象是否是空表。
• 长度(length)
• member 和 memq 将返回它的 car 是一个指定元素的一个子表。
• 查找(assoc 'LittleBear '((HappyMole vampire) (LittleBear banshee) (LittleTiger troll))) => (LittleBear banshee)

• 类型转换：(原类型-新类型 对象)
• 类型转换方式非常自由：

(string->number "16") => 16
(symbol->string ’symbol) => "symbol"
尤其是这个：
(string->list "hello") => (#\h #\e #\l #\l #\o)

Scheme学习笔记（一）

（写这个文档并非我初学Scheme，只是为开始全面使用它作点复习准备）

一. HelloWorld

• Scheme语法即抽象语法树，只有仅有的几个内部语法支持。
• ;开启一行注释
• 用括号进行文法定界，第一项为操作，空格（换行）分割操作对象，如：

(diplay "hello, world!")
即对"hello, world!"字符串进行 display 操作。

• Scheme和Lisp一样是自描述的，脚本用 .scm 作为后缀，进入解释器后，使用(load "文件名字符串")启动程序，用(exit)退出解释器。

• 完整程序：

(begin (display "hello, world!") (newline));newline用来刷新缓存

二. 数据类型
1. 简单类型

• 布尔值：有两个取值，#t和#f
• 操作(类型名? 变量)返回一个布尔值，确认该变量是否为此类型。如：

(boolean? #t) => #t
(boolean? 32) => #f

• 宏(not 布尔值)返回这个布尔值的反取值。如：

（not (boolean? #t)) => #f

• 数字：分为complex，rational，real，integer，但申明时不必指出。
• (= 操作对象1 操作对象2)操作仅用于比较类型相同的变量值是否相同；(= 43 43) => #t，但(= 43 "ok")会报错。
• (eqv?)操作是(=)的范型版本
• 指数运算(expt 2 3) => 8，取绝对值(abs -7) => 7
  
• 字符：以#\开头的单个字符

(char=? #\a #\a) ? #t
(char=? #\a #\b) ? #f

• 忽略大小写比较：(char-ci=? #\a #\A) => #t
  
• 大小写转换（不影响原值）(char-downcase #\A) => #\a，(char-upcase #\a) => #\A
• 符号：编译原理中的东西，可作变量名，用(quote)申明，(quote a) => 'a
• 变量不与其类型绑定：
  

(quote abc) (define xyz 9) (set! xyz #\c)