寫在垠神前面： CHR3 語言

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 : n. cond (nt(n=0)? 1ntelse? n*(fact(n-1))n)n

允許小括弧內部換行，如果這麼做，接下來的每一行的小括弧必須省略。這樣我們就獲得了比較優美的語法。

同理，let語句也允許這麼做。

那麼我們來看看我們的測試文件

1n1 + 2n2 * 3n2 * (3 + 4)n(1 + 2) * (3 + 4)nn( x . 2 * x) 3nnlet (ntx : 2n) let (ntf : y . x * yn) f 3nnlet (ntx : 2n) let (ntf : y . x * yn) let (ntx:4n) f 3nnfact : n. cond (nt(n=0)? 1ntelse? n*(fact(n-1))n)nfact 5nnfib : n. cond (nt(n<2)? nntelse? (fib(n-1)) + (fib(n-2))n)nfib 9nneven : n. cond (nt(n=0)? truent(n=1)? falsentelse? odd (n-1)n)nodd : n. cond (nt(n=0)? falsent(n=1)? truentelse? even(n-1)n)neven 42n

注意到，這個語言可以實現遞歸。

接下來看看具體實現：

括弧補全的代碼非常簡單：

tt// 補全括弧規則ntt// 如果某一行最後一個字元是左括弧ntt// 將接下來的每一行都用括弧括起來ntt// 直到遇見一個行首即為右括弧且行末不是左括弧的行nttgetline(ifs, code);nttif (!code.empty() && code[code.size()-1] == () {ntttstring more_code;ntttwhile (ifs.good()) {nttttgetline(ifs, more_code);nttttif (more_code.empty())ntttt{ntttttcontinue;ntttt}nttttif (more_code[0] == ) && more_code[more_code.size()-1] == () {ntttttcode += more_code;ntttt} else if (!more_code.empty() && more_code[0] == )) {ntttttcode += more_code;ntttttbreak;ntttt} else {ntttttcode += ("(" + more_code + ")");ntttt}nttt}ntt}n

首先讀取一行，然後看看下一行是否是一個結束（行首為左括弧），如是，則補上代碼走人，否則就將這一行代碼左右添上括弧然後加入原代碼。

其餘的詞法和語法分析並無什麼新鮮，我們講講如何實現遞歸。

要想實現遞歸，最經典的做法就是用棧了。可是這裡我們不打算用棧。我們用樹（為了簡單起見）。所以我們將 env 類型改成這樣的定義：

struct env_tn{ntstring name;ntexpr_t *value;ntenv_t *parent;nntenv_t():parent(NULL),value(NULL) {}nntexpr_t *lookup(string name) {nttassert(parent != this);ntt// cout<<"lookup "<<name<<", compare "<<this->name<<endl;nttif (this->name == name) return value;nttif (parent == NULL) return NULL;nttreturn parent->lookup(name);nt}ntenv_t *extend(string name, expr_t *value)nt{nttenv_t *child = new env_t();nttchild->name = name;nttchild->value = value;nttchild->parent = this;nttreturn child;nt}n};n

每個env都只是一個<name,value>條目，除此之外還有一個parent指針，這樣自然可以實現從根環境散發出很多分支。

lookup操作就是看看自己和父環境有沒有。

extend操作則是新建一個環境，父環境的指針設置好就行了。

其實這個和類的繼承非常像。

接下來看 expr 類型的改動，非常簡單，只是增加了 pairs 用來支持 let 和 cond

// function call: (func value)n// lambda: ( name . body)n// let: (let (pairs) body)n// arithmetic: (value name value2)n// compare: (value name value2)n// cond: (cond (pairs))nstruct expr_tn{ntint type;ntint ivalue; // for intntstring str; // for namenntexpr_t *name;ntexpr_t *func;ntexpr_t *value;ntexpr_t *value2; // only for + - * /ntexpr_t *body;nntenv_t *env; // only for lambdanntvector<pair<expr_t,expr_t>> pairs; // for cond and letnntexpr_t() {}ntexpr_t(int type)nt{nttthis->type = type;nt}n};n

接下來看解釋器部分的代碼：

expr_t *interp(expr_t *e, env_t *env)n{ntenv_t *new_env;ntexpr_t *ret;ntexpr_t *v1, *v2;ntint v;ntswitch (e->type) {nttcase EXPR::NAME:nttt// printf("name of %s in %lun", e->str.c_str(), &env);ntttret = env->lookup(e->str);ntttif (!ret) {ntttt// printf("lookup %s in env0n", e->str.c_str());nttttret = env0->lookup(e->str);nttttif (!ret) {ntttttprintf("undefined variable %sn", e->str.c_str());ntttttexit(1);ntttt}nttt}ntttreturn ret;nttcase EXPR::BOOL:nttcase EXPR::INT:nttt// printf("int %dn", e->ivalue);ntttreturn e;nttcase EXPR::LAMBDA:nttt// printf("lambda (%s)n", e->name->str);nttte->env = env;ntttreturn e;nttcase EXPR::DEFINE:nttt// printf("let (%s)n", e->name->str.c_str());ntttv1 = interp(e->value, env);ntttenv0 = env->extend(e->name->str, v1);ntttreturn v1;nttcase EXPR::LET:ntttnew_env = env;ntttfor (auto p : e->pairs) {nttttv1 = interp(&p.second, env);ntttt// printf("extend %sn", p.first.str.c_str());nttttnew_env = new_env->extend(p.first.str, v1);nttt}ntttreturn interp(e->body, new_env);nttcase EXPR::ARITH:nttt// printf("v1:%d, v2:%d in env(%ld)n",nttt// te->value->type, e->value2->type, env);ntttv1 = interp(e->value, env);ntttv2 = interp(e->value2, env);ntttret = new expr_t(INT);ntttassert(e->func->type == NAME);ntttswitch (e->func->str[0]) {nttttcase +:ntttttv = v1->ivalue + v2->ivalue;ntttttbreak;nttttcase -:ntttttv = v1->ivalue - v2->ivalue;ntttttbreak;nttttcase *:ntttttv = v1->ivalue * v2->ivalue;ntttttbreak;nttttcase /:ntttttv = v1->ivalue / v2->ivalue;ntttttbreak;nttt}ntttret->ivalue = v;ntttreturn ret;nttcase EXPR::COMPARE:ntttv1 = interp(e->value, env);ntttv2 = interp(e->value2, env);ntttret = new expr_t(BOOL);ntttassert(e->func->type == NAME);ntttswitch (e->func->str[0]) {nttttcase =:ntttttv = v1->ivalue == v2->ivalue;ntttttbreak;nttttcase <:ntttttv = v1->ivalue < v2->ivalue;ntttttbreak;nttttcase >:ntttttv = v1->ivalue > v2->ivalue;ntttttbreak;nttt}ntttret->ivalue = v;ntttreturn ret;nttcase EXPR::FUNC_CALL:nttt// printf("FUNC_CALL (:%d :%d) n", e->func->type, e->value->type);ntttv2 = interp(e->value, env);ntttv1 = interp(e->func, env);ntttnew_env = v1->env->extend(v1->name->str, v2);ntttret = interp(v1->body, new_env);ntttdelete new_env;ntttreturn ret;nttcase EXPR::COND:ntttfor (auto cp : e->pairs) {nttttv1 = interp(&cp.first, env);nttttif (v1->ivalue) {ntttttreturn interp(&cp.second, env);ntttt}nttttdelete v1;nttt}ntttprintf("cond all falsen");ntttexit(1);ntttbreak;nt}n}n

我們可以看看 FUNC_CALL 部分，代碼和之前完全一樣，但是因為 env 的操作邏輯改變，使得它可以支持遞歸。

我們來看fact的例子

fact : n. cond (nt(n=0)? 1ntelse? n*(fact(n-1))n)nfact 5n

第一次調用 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 的定義。

好了，代碼在這裡：

interp/chr3.cpp at master · picasso250/interp · GitHub