面向对象 - Scheme 实现

十五、十六课

父类和子类

上一课，我们通过下表，引申出通过对同一种数据类型的不同操作进行抽象而得到面向对象编程的思路。

再次分析这张表：

  • 横向：同一个过程常常可以对多个数据类型进行操作，以此为出发点形成过程抽象、数据抽象的思路

  • 纵向：同一个数据类型常常可以适应多种过程，以此为出发点形成面向对象的思路

但不论以哪一点为出发点，都需要兼顾另一个出发点背后隐藏的抽象需求。从面向对象的角度出发，我们将同一个数据类型的内部状态和过程结合解决纵向的抽象合并，但不同的数据类型可能含有类似的过程，这时就可以通过将这些类似的过程单独抽象成一个数据类型的方式解决，也就是我们常说的继承、is-a 关系、父类和子类。

例如：汽车和电动车的内部状态都包含位置 (position)，控制内部状态转变的过程都有行驶 (drive)，因此可以抽象出一个车 (Car) 类，让汽车和电动车都继承它的内部状态和相关过程，这样就能在一定程度上解决上表中横向的抽象合并。

一个支持继承的面向对象编程系统，至少需要考虑以下这些问题：

  • 每个实例都有标签来表示它属于哪个类

  • 声明类之间的继承关系

  • 子类继承父类的状态和过程

  • 如果子类没有相关过程，是否委托 (delegation) 给父类

如何用 Scheme 构建面向对象系统

Scheme 的环境模型，可以用来构建 Object 和 Class：

  • Objects: 接收消息的，含有内部状态的过程集合

    • 每个实例都有 identity：唯一的 Scheme procedure

    • 每个示例都有局部状态：每个示例 procedure 都有它的局部环境

  • Classes: Scheme make-<object> procedures:

    • 方法：接收消息，执行对应的 Scheme procedure

    • 继承规则：在继承链上如何决定调用哪个 procedure

让我们把自己的双手搞脏吧！尝试实现以下的对象系统：

![](/assets/Screen Shot 2018-03-13 at 10.48.15 PM.jpg)

Person

person 实例在接收到消息后，可能会需要做很多种事情，如返回信息 (selector, predicator)、改变内部状态，这些事情中，有些还需要输入来自外界的信息 (参数)，因此我们约定接收消息后，都统一返回一个 procedure，这个 procedure 可以接受参数也可以不接受参数。该约定是这个面向对象系统的一个设计，不同的面向对象系统在这类设计上可以有不同的取舍。

接下来我们实现 make-person procedure

(define (make-person fname lname)
    (lambda (message)
        (cond ((eq? message 'WHOAREYOU?) (lambda () fname))
              ((eq? message 'CHANGE-MY-NAME)
               (lambda (new-name) (set! fname new-name)))
              ((eq? message 'SAY)
               (lambda (list-of-stuff)
                 (display-message list-of-stuff)
                 'NUF-SAID))
              (else (no-method)))))

利用环境模型，我们将局部状态 fname, lname 保存在局部环境中，然后利用 procedure 的外环境来访问、修改局部状态，实现之前对象系统的需求。有了 make-person，我们就可以用它创建 person 对象的实例：

(define g (make-person 'george 'orwell))
((g 'WHOAREYOU?)) ; (g 'WHOAREYOU?) 获取方法后再执行它，才能输出 george
==> george

注意上面的信息传递到得到最终结果的过程，实际上包含两个步骤：

  • 从实例中找到 msg 对应的 procedure

  • 合理地执行这个 procedure 来获取预期结果

我们可以改进这个过程：

  • 将两个过程分开

  • 将两个过程对使用者抽象成一个步骤

(define (get-method message object)
    (object message))

(define (ask object message . args)
    (let ((method (get-method message object)))
        (if (method? method)
            (apply method args)
            (error "No method for message" message))))

于是，刚才的调用过程就变成：

(define g (make-person 'george 'orwell))
(ask g 'WHOAREYOU?)
==> george

具体的环境模型如下图所示：![](/assets/Screen Shot 2018-03-13 at 10.48.45 PM.jpg)

no-method 与 method?

在顺着继承关系寻找对应 procedure 的过程中，我们需要两个助手

  • no-method --- 由于我们约定，每当我们向 object 索取信息时，它总是返回一个 procedure，因此我们需要一个 procedure 来表示object 内部没有相应的 procedure, 这就是 no-method

(define no-method
  (let ((tag (list 'NO-METHOD)))
       (lambda () tag))

  • method? --- 确认返回值是否是有效的 procedure

(define (method? x)
  (cond ((procedure? x) #T)
        ((eq? x (no-method) #F)
        (else
          (error "Object returned non-message" x))))

self

很多时候，一个对象需要在一个 procedure 中调用自己的另一个 procedure，但它没有相关的 reference，这时候就需要一个变量 self，它始终指向这个对象自己，从而达到调用自己的 procedure 的目的。

首先，需要为每个 procedure 增加 self 引用，然后就可以利用这个 self 去调用自己的 procedure：

(define (make-person fname lname)
  (lambda (message)
    (case message
      ((WHOAREYOU?) (lambda (self) fname)
      ((CHANGE-NAME)
        (lambda (self new-name)
          (set! fname new-name)
          (ask self 'SAY (list 'call 'me fname))))
      ((SAY)
        (lambda (self list-of-stuff)
          (display-message list-of-stuff)
          'NUF-SAID))
        (else (no-method)))))

接着，需要修改 ask

(define (ask object message . args)
  (let ((method (get-method message object)))
    (if (method? method)
      (apply method object args)
      (error "No method for message" message))))

从以上代码中，可以体会到将寻找 procedure 和调用 procedure 的逻辑抽象到 ask 中，也能让我们很方便地做这种额外的改动。

object typing

在面向对象系统中，常常需要知道某对象的类型，从而构建对不同类型对象的处理逻辑。其中最简单的一种方法就是在对象中添加一个 procedure

(define (make-person fname lname)
  (lambda (message)
    (case message
      ((WHOAREYOU?) (lambda (self) fname))
      ((CHANGE-NAME)
        (lambda (self new-name)
          (set! fname new-name)
          (ask self 'SAY (list 'call 'me fname))))
      ((SAY)
        (lambda (self list-of-stuff)
          (display-message list-of-stuff)
          'NUF-SAID))
      ((PERSON?)
        (lambda (self) #t))
      (else (no-method)))))

(define someone (make-person 'bert 'sesame))
(ask someone 'person?)
> #t

这种方法简单，但弊端也很明显，如果我们 (ask someone 'professor)，就会得到 no-method，但我们同样可以利用类似 ask 抽象的方式解决这个问题：

(define (is-a object type-pred)
  (if (not (procedure? Object))
      #f
      (let ((method (get-method type-pred object)))
          (if (method? Method)
              (ask object type-pred)
              #f)))))
(define someone (make-person 'bert 'sesame))
(ask someone 'professor?)
> #f

Inheritance

Internal object

继承 (inheritance) 是面向对象系统中重要的一员，它可以将系统中的个体按层级抽象，将不同个体的共同特征单独抽象，使得代码往模块化更进一步。基于之前的面向对象系统设计，我们可以在子类实例内部创建一个父类的实例，当子类中找不到与 message 相对应的 procedure 时，将 message 传递给内部的父类实例，从而实现局部变量和 procedure 的继承，以 professor 和 person 为例：

(define (make-professor fname lname)
  (let ((int-person (make-person fname lname)))
    (lambda (message)
      (case message
        ((LECTURE) ...) ; new method
        ((WHOAREYOU?
          (lambda (self)
            (display-message (list 'Professor lname))
            lname))
        (else (get-method message int-person))))))

(define e (make-professor 'eric 'grimson))

执行最后一句 define，我们在全局环境上创建一个 professor 实例，此时环境模型如下图所示：

![](/assets/Screen Shot 2018-03-20 at 6.28.52 PM.jpg)

当执行 professor 特有的 procedure 时，可以得到如下环境模型图：

![](/assets/Screen Shot 2018-03-20 at 6.29.20 PM.jpg)

当执行 person 特有的 procedure 时，可以得到如下环境模型图：

![](/assets/Screen Shot 2018-03-20 at 6.29.44 PM.jpg)

环境模型图中展现出整个继承的过程，值得回味。

Delegation

拥有 internal object 能够将子类共用的局部变量和 procedure 抽象到父类中，但有时候子类的某个 procedure 常常是父类的某个 procedure 的改进版本，为了避免重复父子类中相似 procedure 中的共同逻辑，我们需要 delegation，来实现子类对父类 procedure 的调用。

首先，构建一个 delegate procedure

(define (delegate to from message . args)
  (let ((method (get-method message to)))
    (if (method? method)
      (apply method from args)   ; from becomes self
      (error "No method" message))))
; 对比 ask
(define (ask object message . args)
  (let ((method (get-method message object)))
    (if (method? method)
      (apply method object args) ; object becomes self
      (error "No method for message" message)

delegate 与 ask 非常相似，唯一的不同在于 delegate 是从 to 身上找到 method，然后执行的时候用 from 当作 self 传入，举例：子类实例拿父类的方法应用到自己身上，而不是父类的示例身上。

继续之前的例子，创建一个 arrogant-professor，它的 SAY procedure 会在自己说的每句话之后加上 obviously，利用 delegate 实现如下：

(define (make-arrogant-professor fname lname)      ; subclass
  (let ((int-prof (make-professor fname lname)))   ; superclass
    (lambda (message)
      ((SAY)
        (lambda (self stuff)
          (delegate int-prof self
            'SAY (append stuff '(obviously)))))
      (else
        (get-method message int-prof))))))

(define e (make-arrogant-professor 'big 'gun))
(ask e 'SAY '(the sky is blue))
> the sky is blue obviously
(ask e 'LECTURE '(the sky is blue))
> therefore the sky is blue

调用 SAY 时，arrogant-professor 实例如愿在自己说的话后面加上 obviously，然而调用 professor 实例的 LECTURE 时，并没有如愿。仔细看一下 make-professor 的源码：

(define (make-professor name)
  (let ((int-person (make-person name)))
    (lambda (message)
      (case message
        ((LECTURE)
          (lambda (self stuff)
; bug       (delegate int-person self 'SAY
; bug         (append '(therefore) stuff))
            (ask self 'SAY
              (append '(therefore) stuff))))
      (else (get-method message int-person))))))

原因在于arrogant professor 内部的 professor 实例内部调用 SAY 时，使用的并不是 arrogant-professor 本身的 SAY，而是 professor 实例内的 SAY，因此 obviously 没有被加在每句话之后。因此稍加改动就能实现我们最初的目的。本例也能体会出，在面向对象系统设计过程中，在重用 procedure 过程中的一些微妙的变化。

Multiple Inheritance

假设系统中有新的类 Singer，它没有父类，它的 constructor 如下所示：

(define (make-singer)
  (lambda (message)
    (case message
      ((SAY)
        (lambda (self stuff)
          (display-message
            (append stuff '(tra lala))))
      ((SING)
        (lambda (self)
          (ask self 'SAY '(the hills are alive))))
      (else (no-method)))))

这时候如果有一个新的类，它既是 Arrogant Professor 又是 Singer，暂且称它为 SAP， 这时候就出现 multiple inheritance，沿用之前的设计，我们可以在 SAP 实例内部创建一个 Arrogant Professor 实例和一个 Singer 实例：

(define (make-s-a-p fname lname)
  (let ((int-singer (make-singer))
        (int-arrognt (make-arrogant-prof fname lname)))
    (lambda (message)
      (find-method message int-singer int-arrognt))))

(define (find-method message . objects)
  (define (try objects)
    (if (null? objects)
        (no-method)
        (let ((method (get-method message (car objects))))
          (if (not (eq? method (no-method)))
            method
            (try (cdr objects))))))
  (try objects))

当一个类继承两个类时，就需要决定先从哪个父类寻找 procedure，我们甚至也可以让每个父类都执行对应的 procedure。这些都是设计面向对象系统的需要做的一些决定。

参考

Previous面向对象-消息传递Next构建 Scheme 解释器

Last updated