CHR3 语言
2021-05-06 10:28
标签：pre inter 不同 语句 定义 cout ica 经典的 如何 来源 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 语言先写个教程吧。 首先，看看语法： 标为粗体的是和 CHR2 语言不同的地方。 首先，和我承诺的一样，我们将实现 let ，其次，之前用等号表示全局绑定，现在我们改成了冒号（至于为什么，是为了词法分析的简单，我将每个符号都定成单符号，所以等号就被比较符号占据了）。 定义还是全局定义。 开关语句就是 lisp 中的 cond 语句。 比较语句的返回值是一个布尔类型。 但是这里有个问题，那就是 cond 语句将非常 lisp style，这是我不希望看到的。所以我们来允许这样： 允许小括号内部换行，如果这么做，接下来的每一行的小括号必须省略。这样我们就获得了比较优美的语法。 同理，let语句也允许这么做。 那么我们来看看我们的测试文件 注意到，这个语言可以实现递归。 接下来看看具体实现： 括号补全的代码非常简单： 首先读取一行，然后看看下一行是否是一个结束（行首为左括号），如是，则补上代码走人，否则就将这一行代码左右添上括号然后加入原代码。 其余的词法和语法分析并无什么新鲜，我们讲讲如何实现递归。 要想实现递归，最经典的做法就是用栈了。可是这里我们不打算用栈。我们用树（为了简单起见）。所以我们将 env 类型改成这样的定义： 每个env都只是一个 lookup操作就是看看自己和父环境有没有。 extend操作则是新建一个环境，父环境的指针设置好就行了。 其实这个和类的继承非常像。 接下来看 expr 类型的改动，非常简单，只是增加了 pairs 用来支持 let 和 cond 接下来看解释器部分的代码： 我们可以看看 FUNC_CALL 部分，代码和之前完全一样，但是因为 env 的操作逻辑改变，使得它可以支持递归。 我们来看fact的例子 第一次调用 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 CHR3 语言 标签：pre inter 不同 语句 定义 cout ica 经典的 如何 原文地址：https://www.cnblogs.com/lsgxeva/p/13190397.htmlCHR3 语言
fact : \n. cond (
(n=0)? 1
else? n*(fact(n-1))
)
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 : \n. cond (
(n=0)? 1
else? n*(fact(n-1))
)
fact 5
fib : \n. cond (
(n // 补全括号规则
// 如果某一行最后一个字符是左括号
// 将接下来的每一行都用括号括起来
// 直到遇见一个行首即为右括号且行末不是左括号的行
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 + ")");
}
}
}
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);
// coutname 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;
}
};
// 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
vectorpairexpr_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\n", e->str.c_str(), &env);
ret = env->lookup(e->str);
if (!ret) {
// printf("lookup %s in env0\n", e->str.c_str());
ret = env0->lookup(e->str);
if (!ret) {
printf("undefined variable %s\n", e->str.c_str());
exit(1);
}
}
return ret;
case EXPR::BOOL:
case EXPR::INT:
// printf("int %d\n", e->ivalue);
return e;
case EXPR::LAMBDA:
// printf("lambda (%s)\n", e->name->str);
e->env = env;
return e;
case EXPR::DEFINE:
// printf("let (%s)\n", 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\n", 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)\n",
// 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 ‘ivalue ivalue;
break;
case ‘>‘:
v = v1->ivalue > v2->ivalue;
break;
}
ret->ivalue = v;
return ret;
case EXPR::FUNC_CALL:
// printf("FUNC_CALL (:%d :%d) \n", 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\n");
exit(1);
break;
}
}
fact : \n. cond (
(n=0)? 1
else? n*(fact(n-1))
)
fact 5