消息传递：从风格到机制

四. 扩展的实现
上篇最后给出了一个“看上去很美”的基于消息传递的编程风格，比如构造一个 People 类的代码类似：

function People () {
	var money = 0
	function setMoney (dollars) {
		money = dollars
	}
	function pay (dollars) {
		money -= dollars
	}
	return (function (verb) {
		return eval(verb)
	})
}

有了这样的语法我们就可以描述不少句子了。但是存在一个问题：现实中的 Objects 之间是存在关系的——比如，forrest 是个 IQ 为 75 的傻子，傻子是 People 的一种。而我们仅仅是生搬硬套了一种语法而割裂了这种 "is-a" 关系。现在我们的工作，目的之一就是让这样一个“真切”的世界从我们已有的编程风格的地基上拔地而起。
到底应该怎样做才能使 Fool 产生的对象都能响应 People 的消息呢？我们要给 Fool 产生的对象（也就是返回的那个匿名函数啦）都添加这样一种能力：如果在 Fool 中响应不了消息，那就反馈给 People 响应。

function Fool (iq) {
	var IQ = iq || 0
	function init (iq) {
		IQ = iq
	}
	return (function (verb) {
		try {
			return eval(verb)
		} catch (e) {
			return People()(verb)
		}
	})
}

js> forrest = Fool()
js> forrest('init')(75)
js> forrest('IQ')
75
js> forrest('money')
0

五. 语法扩展和代码生成
这下代码量增加了很多，强迫潜在的使用者们在创建每个类时都这样写那实在是令人抓狂。本来这篇文章应该不提此类问题的解决，但考虑到有益于读者理解“机制”这个抽象概念，这里给出一个可行的方案——把普通的类代码用 Function() 函数重编译为可用的 JavaScript 函数。也就是说，我们能给出类扩展的代码并指定被扩展的类来获取类似上文的代码：

Fool = extend('People()', function (iq){
	var IQ = iq || 0
	function init (iq) {
		IQ = iq
	}
})

为了方便字符串操作，我们希望编译后的代码的参数部分（如 People()）都集中出现在一个位置且尽可能便于定位。在函数头添加一句

var origin = People()

当然是可行的，这样还能使 Fool 内部显式引用到其超类。但这样还不够漂亮。我们修改编译后的样例代码为：

function () {
	return (function (origin) {
		var IQ = 0
		function init (iq) {
			IQ = iq
		}
		return (function (verb) {
			try {
				return eval(verb)
			} catch (e) {
				return origin(verb)
			}
		})
	})(People())
}

这个利用参数传递变量的小技巧不值得学习，实际效率不高。但在这篇文章中，这样绑定特殊变量的技术是标准方案。
那么，我们的语法扩展兼代码生成函数 extend() 的实现为：

function extend (originc, code) {
	function argsArea (code) {
		// 题外话，正则表达式也有不值得一用的时候
		return code.slice(code.indexOf('(')+1, code.indexOf(')'))
	}
	function bodyCode (code) {
		// 不用 trim() 了，别没事儿找事儿
		return code.slice(code.indexOf('{')+1, code.lastIndexOf('}'))
	}
	function format (body) {
		var objc = bodyCode(function () {
			return (function (verb) {
				try {
					return eval(verb)
				} catch (e) {
					return origin(verb)
				}
			})
		}.toString())
		return 'return (function (origin) {'+body+objc+'})('+originc+')'
	}
	var $ = code.toString()
	return Function(argsArea($), format(bodyCode($)))
}

这样前文提到过的 extend 的实例代码就可以正常运行了，测试代码不再重复。

六. 机制完备化
这样，我们的基于消息传递编程风格的一套面向对象机制就确定下来了。机制是宪法，是语言的根本大法，有了它，我们就可以通过修改代码生成器，很快地给这套机制进行完备化。
想法有很多，例子只举两个。
第一个例子：类的定义中应该能直接引用到将产生的对象 self。答案只有一句话：把返回的那个作为对象的匿名函数命名为 self。
第二个例子：既然是单继承模式，应当存在一个顶层类 AbsObj，使没有指定继承的类自动继承它。答案是：在 extend 函数体第一行添加代码：

if (arguments.length == 1) {
	code = originc
	originc = 'AbsObj()'
}

然后手工构造设计 AbsObj 类，为空也无所谓。不过当然了，一般都会给顶层类添加一些全局性质的消息绑定。由于是“底层操作”，基本上都需要修改 extend 函数。做了一个简单的：

function AbsObj () {
	//检测是否能响应此 verb，要再用一次异常处理
	function canHandle(verb){
		try {
			// 别担心这里的 self 会传递不过去
			self(verb)
		} catch (e) {
			return false
		}
		return true
	}
	function toString() {} // 这个搞起来其实很麻烦~`
	var self = function (verb) {
		return eval(verb)
	}
	return self
}

js> Obj=extend(function(){x=5})
js> o=Obj()
js> o('canHandle')('x')
true
js> o('canHandle')('y')
false

文章写完了，小结一下。消息传递的编程不仅仅是一种代码风格，还可以成长为一种完备的机制。这种完备性远不只是这两篇加起来不到300行的文章所能覆盖的（例如非常彻底的“万物皆对象”，因为只要是能响应消息的函数，连接一下 AbsObj 就是合法对象了；类，函数都可以），大家可以试着玩一玩，顺便体会一下这个计算模型的透明和强大。
另外，熟悉函数式编程的朋友可以帮忙思考一下：这样一个基于闭包变换的计算模型实质上是函数式的，再配合动态的函数式的对象级继承（用一个匿名类代换一下）就能在纯 FP 真正下实现 OOP 了。可惜的是每一次更新操作都要重新生成对象，性能代价大了点，yet another question.

嗯，'return (function (origin) {'+body+objc+'})('+originc+')' 这一句可能还是换成
['return (function (origin) {', body, objc, '})(', originc, ')'].join('') 比较好吧，快一点。
我测试了一下，发现消息转发的时候特别慢，因为要刻意地使用异常处理。不过好像也没别的办法，eval() 不到肯定抛异常。
算了，不讨论这些了，LZ 说了“反对回帖质疑”“效率”什么的呢，还是想想有关“消息传递”思想本身，嗯。

哈哈，我帮你顶， 楼主， 悄悄地告诉你， 我也是个变态的js爱好者， 那玩意儿的语法成份少， 可描述能力巨强。

哦对了，我还用 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 (slot<? s1 s2) (symbol<? (slot-name s1) (slot-name s2)))
(define (symbol<? a b)
 (string<?
  (symbol->string a) (symbol->string b)))

;; 主要的转换宏，语法比较丰富，但至少带有一个 that 块
;; 语法可以只给出 that 块：(class (that (slot-name1 slot-act1) ...))
;; 也可以指定继承：(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 slot<?
				     (list (make-slot (quote slot) slot) ...)))
		     (slot-names (list->vector (map slot-name slots)))
		     (slot-acts (list->vector (map slot-act slots)))
		     (has-slot? (lambda (v)
						 (vector-bsearch symbol<? v slot-names)))
		     (self (lambda (verb)
				    (let ((index (has-slot? verb)))
				     (if (> 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 虚拟机。完整的可执行版本在附件中有。
消息传递真的很有意思。留个小题目，增加一个特殊方法 clone，把继承机制调整为差异继承+纯基于对象，类似 IO 语言。
PS: 有变态的 Scheme 爱好者也多交流！

用Lysee 1.1.0实现一下，条条大陆通罗马:

class people // Lysee 1.1.0
{
  private string _name;
  private money _money;
  private hashed _hs;
  
  new(string name, money m) {
    this._name = name;
    this._money = m;
    this._hs = hashed();
  }
  
  public variant ___GETPV(string ID)
  {
    return this._hs[ID];
  }
  
  public void ___SETPV(string ID, variant value)
  {
    this._hs[ID] = value;
  }
}

// 可能的操作

public people run(people p)
{
  = p._name + ": I am running\n";
  return p;
}

public people jump(people p)
{
  = p._name + ": I am jumping\n";
  return p;
}

public people gain(people p, money m)
{
  p._money = p._money + m;
  = p._name + ": I gained", m , "dollors and have", p._money, "dollors now\n";
  return p;
}

public people pay(people p, money m)
{
  m = p._money - m;
  p._money = m < 0 ? 0 : m;
  = p._name + ": I payed", m , "dollors and ", p._money, "dollors left now\n";
  return p; 
}

// 初始化函数

public people People(string name, money m)
{
  people p = people(name, m);
  p.run  = curry(run,  [p]);
  p.jump = curry(jump, [p]);
  p.gain = curry(gain, [p]);
  p.pay  = curry(pay,  [p]);
  return p;
}

// Clone 一下

public people Clone(people who, string name)
{
  return People(name ?? who._name, who._money);
}

main:

people forest = People("forest", 100);

forest.run().jump().gain(1000).pay(33);

Clone(forest, "amin").run().jump().gain(40).pay(999);

// 打印内容
forest: I am running
forest: I am jumping
forest: I gained 1000 dollors and have 1100 dollors now
forest: I payed 33 dollors and  1067 dollors left now
amin: I am running
amin: I am jumping
amin: I gained 40 dollors and have 1107 dollors now
amin: I payed 999 dollors and  108 dollors left now

当然run, jump, gain等这些函数也可以作为People()的闭包注册到people对象中，但使用curry()可以形成更好的机制

晕了...楼主发帖的意思是怎样设计一个面向对象系统（而且代码还是函数式风格的），想说明消息、智能对象的本质是什么。那否则最后补发 Scheme 宏的帖子干吗，现在你们常见的语言不都有 class 嘛。而楼上除了用一个 curry() 函数把顺次调用玩儿成了之外其它全在秀 Lysee Script 自有的面向对象机制。怎么，想就此开个语言入门讲座吗？

伙计，不用太认真。Lysee是我开发的，我也从不指望用它挣钱，只是因为个人爱好一直开发到现在。Lysee差不多一天一个版本，每次都实现一个小的概念，目前的方向是：

1、通过开发脚本引擎验证我对FP编程和Script运行架构的理解。
2、对照编程，找到Lysee还不能实现的编程模式。
3、收集反馈信息，改进Lysee设计，有时不妨班门弄斧一把。

***** 希望你能对Lysee的开发提出意见，谢谢！

今天释出的Lysee实现了一个通过闭包修改函数局部变量的概念：

public void box(variant proc)
{
  int b = 10;
  proc();
  = b, eol;
}

public void change()
{
  setsv("b", 1000);
}

main:

box { b = b * b };
box ("b=b+1");
box (change);

// 输出
100
11
1000

这个操作在Ruby中是通过传递代码块实现的，Lysee模仿了一下，同时提供了显示操作的API。

一个简单的消息实现:

public hashed objects = hashed();

class Object
{ 
  private int _handle;
   
  public void run() { = this._handle, "- I am RUNNING\n" }
  public void jump() { = this._handle, "- I am jumping\n" }
  
  public void process(varpair msg)
  {
    switch(msg.last) {
      case "run": this.run();
      case "jump": this.jump();
      default: = "unknow message\n"
    }
  }
  
  new(int handle) 
  {
    this._handle = handle;
    objects[handle] = this; // 注册消息接收者 
  }  
}

public void dispatch(varpair msg) // (first=handle, last=message)
{
  objects[msg.first].process(msg);
}

main:

// 注册对象
 
10.times {|int index| Object(index + 1000)};

// 发布消息

10.times {
  int handle = sys::random(10) + 1000;
  dispatch((handle, (handle % 10 == 1) ? "run" : "jump"));
};

// 输出
1000 - I am jumping
1001 - I am RUNNING
1005 - I am jumping
1006 - I am jumping
1005 - I am jumping
1003 - I am jumping
1004 - I am jumping
1001 - I am RUNNING
1004 - I am jumping
1009 - I am jumping

感觉还是越简单越好

楼上是来推销新语言的鉴定完毕。
楼主最后留的那个 clone 的问题太简单了吧？想一想，一个产生类本身的函数，不就是类自己吗？

(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) ...)) 
	; 把类自己，也就是表示类的这个函数命个名 clone
	(let ((clone (lambda ()
	 (letrec ((slot val) ...)
	  (let* ((origin org)
		     (slots (list-qsort slot<?
				     (list (make-slot (quote slot) slot) ...)))
		     (slot-names (list->vector (map slot-name slots)))
		     (slot-acts (list->vector (map slot-act slots)))
		     (has-slot? (lambda (v)
						 (vector-bsearch symbol<? v slot-names)))
		     (self (lambda (verb)
				    (let ((index (has-slot? verb)))
				     (if (> index -1)
					  (vector-ref slot-acts index)
					  (case verb
					   ('origin origin)
					   ('slot-names slot-names)
					   ('has-slot? has-slot?)
					   ; 再把 clone 加入可响应的特殊命名列表里
					   ('clone clone)
					   (else (origin verb))))))))
	   self)))))
	 ; 最后把它返回出来
	 clone))
  ((_ that-block where-block)
   (class (absobj) that-block where-block))))

这样就行啦！
另外，我还发现一个很有意思的事情。因为类可以是匿名的，所以可以通过虚拟的类直接产生对象：

(define-syntax object
 (syntax-rules ()
  ((_ ...) ((class ...)))))

这样一来，基于 prototype 的类+对象的模式有了，基于 clone +差异继承的方式也有了，这个面向对象系统的表达能力相当于 JavaScript+Lua（或者Io）。双料的，有意思。。。。把 mixin （不要多继承了，反正差不多）再加上的话，3模式系统，嗯。。

LS 的想法是对的，就是这么回事，只是宏写错了，应该是：

(define-syntax object
 (syntax-rules ()
  ((_ that ...) ((class () that ...)))))

我写了一个那样的“三模式系统”。

; 在一个正常的 Scheme 实现中，undefined 都是一个特殊的符号
; 但因为在 R5RS 中没有特别指明，不如把它提取出来再用
(define undef (if #f #f))

(define (absobj)
 (define (clone verb)
  (define mixin undef)
  (case verb
   ('slot-names '())
   ('clone clone)
   ('oncur (lambda (me)
	    (set! mixee me)))
   ('has-slot? (lambda (n) -1))
    ; 这个长长的条件判断说明，这里的 mixin 是把 mixee 当作 mixer 的元表处理的
    ; 也就是说，mixin 绝不是继承的变形，它没有 mixin 链，更不会顺着继承链向上找
   (else (if (and (not (eq? mixee undef))
			(> ((mixee 'has-slot?) verv) -1))
		  (mixee verb)
		  undef))))
 clone)

完整代码太长，见于附件。以下是测试示例：
> ; 这一行说明了一个小小变革，就是 class 必须带参数了，整个 clone 函数作为构造函数
> (define c1 (class () (that (x 13))))
; no values returned
> (define o1 (c1))
; no values returned
> (o1 'x)
13
> (define c2 (class () (that (y 15))))
; no values returned
> ; 这里的革新是，设置 mixin 对象的方法名为 oncur
> ((o1 'oncur) (c2))
#{Unspecific}
> ; 这是 mixin 的效果；这也是我不喜欢 mixin 的原因，因为代码不是函数式的了
> ; 不过并不是说 mixin 一定要实现为命令式风格的，只是这样比较高效而已
> (o1 'y)
15
>

另附：我在写升级版本的时候发现 self 有问题，根本不能使用，正在全力解决中！