CHR3 语言

CHR3 语言

来源 https://zhuanlan.zhihu.com/p/20835230

https://github.com/yinwang0/

https://github.com/picasso250/interp

https://github.com/picasso250/ts-lisp

垠神的 GitHub 上已经发布了 R3 语言：

interpreters/r3-interpreter.ss at master · yinwang0/interpreters · GitHub

但是对应的教程还没更新。可是我已经等不及了（我的魔法已经饥渴难耐），那就为我的 CHR3 语言先写个教程吧。

首先，看看语法：

• 变量 x
• 函数 x . e
• 绑定 let ( 定义们 ) e
• 定义 x : e
• 调用 f x
• 算数 x · y 其中 · 是 +-*/ 之中的任意一个
• 开关 cond ( 条件结果们 )
• 条件结果 (e1? e2)
• 比较 x · y 其中 · 是 < = > 三者之一

标为粗体的是和 CHR2 语言不同的地方。

首先，和我承诺的一样，我们将实现 let ，其次，之前用等号表示全局绑定，现在我们改成了冒号（至于为什么，是为了词法分析的简单，我将每个符号都定成单符号，所以等号就被比较符号占据了）。

定义还是全局定义。

开关语句就是 lisp 中的 cond 语句。

比较语句的返回值是一个布尔类型。

但是这里有个问题，那就是 cond 语句将非常 lisp style，这是我不希望看到的。所以我们来允许这样：

fact : 
. cond (
	(n=0)? 1
	else?  n*(fact(n-1))
)

允许小括号内部换行，如果这么做，接下来的每一行的小括号必须省略。这样我们就获得了比较优美的语法。

同理，let语句也允许这么做。

那么我们来看看我们的测试文件

1
1 + 2
2 * 3
2 * (3 + 4)
(1 + 2) * (3 + 4)

( x . 2 * x) 3

let (
	x : 2
) let (
	f :  y . x * y
) f 3

let (
	x : 2
) let (
	f :  y . x * y
) let (
	x:4
) f 3

fact : 
. cond (
	(n=0)? 1
	else?  n*(fact(n-1))
)
fact 5

fib : 
. cond (
	(n<2)? n
	else?  (fib(n-1)) + (fib(n-2))
)
fib 9

even : 
. cond (
	(n=0)? true
	(n=1)? false
	else?  odd (n-1)
)
odd :  
. cond (
	(n=0)? false
	(n=1)? true
	else?  even(n-1)
)
even 42

注意到，这个语言可以实现递归。

接下来看看具体实现：

括号补全的代码非常简单：

		// 补全括号规则
		// 如果某一行最后一个字符是左括号
		// 将接下来的每一行都用括号括起来
		// 直到遇见一个行首即为右括号且行末不是左括号的行
		getline(ifs, code);
		if (!code.empty() && code[code.size()-1] == '(') {
			string more_code;
			while (ifs.good()) {
				getline(ifs, more_code);
				if (more_code.empty())
				{
					continue;
				}
				if (more_code[0] == ')' && more_code[more_code.size()-1] == '(') {
					code += more_code;
				} else if (!more_code.empty() && more_code[0] == ')') {
					code += more_code;
					break;
				} else {
					code += ("(" + more_code + ")");
				}
			}
		}

首先读取一行，然后看看下一行是否是一个结束（行首为左括号），如是，则补上代码走人，否则就将这一行代码左右添上括号然后加入原代码。

其余的词法和语法分析并无什么新鲜，我们讲讲如何实现递归。

要想实现递归，最经典的做法就是用栈了。可是这里我们不打算用栈。我们用树（为了简单起见）。所以我们将 env 类型改成这样的定义：

struct env_t
{
	string name;
	expr_t *value;
	env_t *parent;

	env_t():parent(NULL),value(NULL) {}

	expr_t *lookup(string name) {
		assert(parent != this);
		// cout<<"lookup "<<name<<", compare "<<this->name<<endl;
		if (this->name == name) return value;
		if (parent == NULL) return NULL;
		return parent->lookup(name);
	}
	env_t *extend(string name, expr_t *value)
	{
		env_t *child = new env_t();
		child->name = name;
		child->value = value;
		child->parent = this;
		return child;
	}
};

每个env都只是一个<name,value>条目，除此之外还有一个parent指针，这样自然可以实现从根环境散发出很多分支。

lookup操作就是看看自己和父环境有没有。

extend操作则是新建一个环境，父环境的指针设置好就行了。

其实这个和类的继承非常像。

接下来看 expr 类型的改动，非常简单，只是增加了 pairs 用来支持 let 和 cond

// function call: (func value)
// lambda: ( name . body)
// let: (let (pairs) body)
// arithmetic: (value name value2)
// compare: (value name value2)
// cond: (cond (pairs))
struct expr_t
{
	int type;
	int ivalue; // for int
	string str;  // for name

	expr_t *name;
	expr_t *func;
	expr_t *value;
	expr_t *value2; // only for + - * /
	expr_t *body;

	env_t *env; // only for lambda

	vector<pair<expr_t,expr_t>> pairs; // for cond and let

	expr_t() {}
	expr_t(int type)
	{
		this->type = type;
	}
};

接下来看解释器部分的代码：

expr_t *interp(expr_t *e, env_t *env)
{
	env_t *new_env;
	expr_t *ret;
	expr_t *v1, *v2;
	int v;
	switch (e->type) {
		case EXPR::NAME:
			// printf("name of '%s' in %lu
", e->str.c_str(), &env);
			ret = env->lookup(e->str);
			if (!ret) {
				// printf("lookup %s in env0
", e->str.c_str());
				ret = env0->lookup(e->str);
				if (!ret) {
					printf("undefined variable %s
", e->str.c_str());
					exit(1);
				}
			}
			return ret;
		case EXPR::BOOL:
		case EXPR::INT:
			// printf("int %d
", e->ivalue);
			return e;
		case EXPR::LAMBDA:
			// printf("lambda (%s)
", e->name->str);
			e->env = env;
			return e;
		case EXPR::DEFINE:
			// printf("let (%s)
", e->name->str.c_str());
			v1 = interp(e->value, env);
			env0 = env->extend(e->name->str, v1);
			return v1;
		case EXPR::LET:
			new_env = env;
			for (auto p : e->pairs) {
				v1 = interp(&p.second, env);
				// printf("extend %s
", p.first.str.c_str());
				new_env = new_env->extend(p.first.str, v1);
			}
			return interp(e->body, new_env);
		case EXPR::ARITH:
			// printf("v1:%d, v2:%d in env(%ld)
",
			// 	e->value->type, e->value2->type, env);
			v1 = interp(e->value, env);
			v2 = interp(e->value2, env);
			ret = new expr_t(INT);
			assert(e->func->type == NAME);
			switch (e->func->str[0]) {
				case '+':
					v = v1->ivalue + v2->ivalue;
					break;
				case '-':
					v = v1->ivalue - v2->ivalue;
					break;
				case '*':
					v = v1->ivalue * v2->ivalue;
					break;
				case '/':
					v = v1->ivalue / v2->ivalue;
					break;
			}
			ret->ivalue = v;
			return ret;
		case EXPR::COMPARE:
			v1 = interp(e->value, env);
			v2 = interp(e->value2, env);
			ret = new expr_t(BOOL);
			assert(e->func->type == NAME);
			switch (e->func->str[0]) {
				case '=':
					v = v1->ivalue == v2->ivalue;
					break;
				case '<':
					v = v1->ivalue < v2->ivalue;
					break;
				case '>':
					v = v1->ivalue > v2->ivalue;
					break;
			}
			ret->ivalue = v;
			return ret;
		case EXPR::FUNC_CALL:
			// printf("FUNC_CALL (:%d :%d) 
", e->func->type, e->value->type);
			v2 = interp(e->value, env);
			v1 = interp(e->func, env);
			new_env = v1->env->extend(v1->name->str, v2);
			ret = interp(v1->body, new_env);
			delete new_env;
			return ret;
		case EXPR::COND:
			for (auto cp : e->pairs) {
				v1 = interp(&cp.first, env);
				if (v1->ivalue) {
					return interp(&cp.second, env);
				}
				delete v1;
			}
			printf("cond all false
");
			exit(1);
			break;
	}
}

我们可以看看 FUNC_CALL 部分，代码和之前完全一样，但是因为 env 的操作逻辑改变，使得它可以支持递归。

我们来看fact的例子

fact : 
. cond (
	(n=0)? 1
	else?  n*(fact(n-1))
)
fact 5

第一次调用 fact 的时候，新建一个env，n=5。在第二次调用的时候，extend 会新建一个 env，这个 env 的条目就是n=4，我们知道，这个env的父链上会有一个n=5的，但是因为lookup的逻辑，覆盖了n=5的条目，所以此时n=4。以此类推。

当然，为了实现互相递归，我们还需要在根环境 env0 上查找一下。（当然，这会导致一个微妙的bug，或者说feature？）

比如 even 和 odd 函数就相互调用。even 是先定义的，它并不知道 odd，自然需要从 env0 中才能查到 odd 的定义。

============== End