【IT168 技术】本文的主要目的就是在C中实现一个基于lambda演算的编程语言，例如Lisp。在学习了相关知识和评估了可行性之后，我们尝试使用少于200行C代码来实现Lisp。

　　#include <stdio.h>

　　#include <stdlib.h>

　　#include <string.h>

　　标准头文件：stdio.h提供printf和puts，getchar从stdin中提取字符。 stdlib.h提供calloc在程序运行时动态分配内存。 string.h提供strcmp来比较两个字符串，strdup为字符串做副本。

　　#define debug(m,e) printf("%s:%d: %s:",__FILE__,__LINE__,m); print_obj(e,1); puts("");

　　这个debug宏用于在程序无法工作时帮助排除故障，还可以添加一行debug('evaluating', exp)，以可读形式打印出文件，行号，消息和Lisp表达式表示。

　　typedef struct List {

　　struct List * next;

　　void * data;

　　} List;

　　该List结构是用来表示代码和数据的基本数据结构。它是一个带有两个指针的单向链表：next指向列表中的下一个项目，data指向符号或另一个列表结构。data可以投到一个char *或一个List *。

　　List *symbols = 0;

　　全局变量symbols表示符号列表的头部。当符号被解析时，我们将在符号列表中查找它，如果它不在那里，我们将添加它。这样我们可以使用等号比较运算符"=="来比较两个符号。当Lisp程序中重复多次使用相同的符号时，它会节省存储空间，不过，如果电脑中有8GB的RAM内存则不需要额外注意节省空间。

　　static int look; /* look ahead character */

　　static char token[32]; /* token */

　　由于符号可以包含多个字符，因此遇到不属于符号的字符时，我们会将其改变为一个完整的符号。非符号字符包括空白符(空格，制表，换行等和语法字符，如括号()。为了确定符号是否已经到达，我们需要向前看一个字符。look变量存储就是向前看一个字符，如果这个字符包含一个非符号字符，那么就停止阅读这个符号。token变量是一个字符数组存储从输入读出的当前符号。请注意，token的大小为32，因此符号的最大长度将是31个字符，token是一个NULL终止字符串，所以标记始终以 字符。

　　#define is_space(x) (x == ' ' || x == ' ')

　　#define is_parens(x) (x == '(' || x == ')')

　　上面的两个宏实主要是为了可读性和程序的可维护性和可扩展性。is_space，如果该字符是空格或换行符，则返回true。is_parens如果该字符是括号，则返回true。

　　static void gettoken() {

　　int index = 0;

　　while(is_space(look)) {

　　look = getchar();

　　}

　　if (is_parens(look)) {

　　token[index++] = look;

　　look = getchar();

　　} else {

　　while(look != EOF && !is_space(look) && !is_parens(look)) {

　　token[index++] = look;

　　look = getchar();

　　}

　　}

　　token[index] = '';

　　}

　　函数gettoken负责从标准输入中读取字符，并确定是否发现括号或符号。首先它将跳过所有空格。如果look变量是括号，则将其存储在token输入流中的下一个字符中look。如果不是括号，则认为它属于一个符号。继续向前看并保存字符，直到EOF到达文件末尾，或者look是空格或括号。 index将当前位置存储在token数组中，以便每次存储符号所属的字符时增加该位置。最后，令牌被终止。

　　#define is_pair(x) (((long)x & 0x1) == 0x1) /* tag pointer to pair with 0x1 (alignment dependent)*/

　　#define untag(x) ((long) x & ~0x1)

　　#define tag(x) ((long) x | 0x1)

　　List结构中，data指针既可以是char *，也可以是List *其它列表。我们指示指针类型的方法是通过设置指针上的最低位。例如，给定一个指针指向的地址0x100200230，如果是一对，我们将用一个位或1来修改这个指针，这样地址就变成0x100200231。这种修改指针方式的问题在于如何将普通未标记的地址传递给标记为1的指针。很多计算机系统和操作系统为了性能优化，会在设定的边界上分配内存，这被成为内存对齐。如果以8位边界为例，这意味着当内存被分配时，它的地址将是8的倍数。例如，地址0x100200230的下一个是0x100200238。内存也可以对齐到16位，32位。通常，它在machine word上对齐，这意味着如果你有32位的CPU和总线，也意味着是32位对齐。更多内容可以查看：。

　　实际上，每当我们调用calloc时，总会得到一个地址(0)，这样我们就可以设置它。如果地址是一对，is_pair将返回非零值(这意味着我们需要取消最低的位来获得地址)。它使用一个位和1来确定这个。untag macro以位和1的补码切换最低位。tag macro改变最低位或1。

　　#define car(x) (((List*)untag(x))->data)

　　#define cdr(x) (((List*)untag(x))->next)

　　在典型的Lisp / Scheme中有两个基本操作，car返回一个头部列表，cdr返回尾部列表。它们是以IBM计算机上的操作命名的，具体信息可以查看 。

　　#define e_true cons( intern("quote"), cons( intern("t"), 0))

　　#define e_false 0

　　e_true和e_false macro是用于在实现中便利定义真假，基本上非零代表是真的，如果他们所拥有的价值能够以人类可读的形式打印出来，那将会有所帮助。

　　List * cons(void *_car, void *_cdr) {

　　List *_pair = calloc( 1, sizeof (List) );

　　_pair->data = _car;

　　_pair->next = _cdr;

　　return (List*) tag(_pair);

　　}

　　另一个Lisp / Scheme基本操作是cons，它构造了一对指针，List结构中包含data指针和next指针。具体可查看：https://en.wikipedia.org/wiki/Cons

　　因为指针列表(一对)必须使用最低标记,我们依靠calloc提供内存足够容纳列表数据结构和内存对齐到一个地址,不涉及最低。这里的cons函数接受两个参数，第一个是存储在数据字段中的地址，第二个是存储在下一个字段中的地址。最后，在被标记为特殊类型的指针之后，返回列表结构所在的地址。

　　void *intern(char *sym) {

　　List *_pair = symbols;

　　for ( ; _pair ; _pair = cdr(_pair)) {

　　if (strncmp(sym, (char*) car(_pair), 32)==0) {

　　return car(_pair);

　　}

　　}

　　symbols = cons(strdup(sym), symbols);

　　return car(symbols);

　　}

　　这是符号从全局符号列表中被回收的地方，如果没有找到，则会被添加。它需要一个字符串参数，使用strncmp来确定任何符号是否等同于传入的字符串。如果我们到达了符号列表的末尾也没有找到匹配的符号，那么该符号会被重复使用，并添加到列表的头部。

　　当将一个现有的列表作为第二个参数时，cons的作用:一个新的符号被推到列表上，并且构造了新的列表头。使用strdup的原因是字符串是重复的，而我们想要一个更永久的字符串副本。当程序运行时，sym参数可以是一个指向令牌全局变量的指针，作为符号从输入流中读取。

　　List * getlist();

　　getlist进一步定义函数的前向声明。getobj函数可以调用它，而getlist也可以调用getobj，C编译器需要知道该函数的完整签名，以便在定义之前使用它。

　　void * getobj() {

　　if (token[0] == '(') return getlist();

　　return intern(token);

　　}

　　所有getobj都要做的是检查输入流中的当前标记是否为一个左括号，这意味着要定义列表，并调用getlist来构造列表。否则，令牌被视为一个符号，而intern则被用来返回单一副本，或者创建一个副本，并将其添加到符号列表中。

　　List * getlist() {

　　List *tmp;

　　gettoken();

　　if (token[0] == ')') return 0;

　　tmp = getobj();

　　return cons(tmp, getlist());

　　}

　　函数getlist从输入读取下一个令牌。如果令牌是右括号，则返回0(空指针)。否则，令牌可能是一个符号，因此调用getobj并将其作为一个符号，然后使用cons将该符号添加到列表的头部，递归地调用getlist以获取列表的尾部。注意，变量tmp 在调用cons函数之前，它的参数是被评估的，在这种情况下，它的第二个参数是函数调用getlist。因此，在调用cons之前，getlist再次被调用，或者列表的末尾被发现。

　　这个递归函数调用的工作原理是值得理解的。在C中，当函数被调用时，函数的参数和变量被推到一个称为堆栈的数据结构之上，而当函数返回时，函数的参数和变量从堆栈中掉下来。每次调用getlist函数时，堆栈会随着另一组getlist需要的变量而增长，这无疑会导致低效率。

　　void print_obj(List *ob, int head_of_list) {

　　if (!is_pair(ob) ) {

　　printf("%s", ob ? (char*) ob : "null" );

　　} else {

　　if (head_of_list) {

　　printf("(");

　　}

　　print_obj(car(ob), 1);

　　if (cdr(ob) != 0) {

　　if (is_pair(cdr(ob))) {

　　printf(" ");

　　print_obj(cdr(ob), 0);

　　}

　　} else {

　　printf(")");

　　}

　　}

　　}

　　print_obj函数非常有用，可以将一个符号或整个列表打印出来，以使我们能够读取它。如果第一个参数，对象不是特别标记的指针，它只是一个符号，因此可以使用% s格式说明符输出printf，如果print_obj被要求打印一个列表，ob将是列表结构的地址。head_of_list参数是附赠的，如果head_of_list是非零的，那么它是一个新列表的开始，在任何情况下，它必须打印当前项的值，因此它以当前列表的值car(ob)来调用自己。如果列表的尾部是非零的，这意味着只要列表的尾部是指向另一个列表结构的指针，就可以打印一个空格，然后打印列表的尾部。如果列表的尾部为零，这意味着已经到达列表尾部，打印右括号。

　　List *fcons(List *a) { return cons(car(a), car(cdr(a))); }

　　List *fcar(List *a) { return car(car(a)); }

　　List *fcdr(List *a) { return cdr(car(a)); }

　　List *feq(List *a) { return car(a) == car(cdr(a)) ? e_true : e_false; }

　　List *fpair(List *a) { return is_pair(car(a)) ? e_true : e_false; }

　　List *fsym(List *a) { return ! is_pair(car(a)) ? e_true : e_false; }

　　List *fnull(List *a) { return car(a) == 0 ? e_true : e_false; }

　　List *freadobj(List *a) { look = getchar(); gettoken(); return getobj(); }

　　List *fwriteobj(List *a){ print_obj(car(a), 1); puts(""); return e_true; }

　　以上定义了Lisp所需要的基本操作，都使用相同的返回值和参数规范。这些函数将在解释器环境中引用，以便它们可以从Lisp程序中使用。由于我们正在实现的Lisp语言不了解C，不知道C中应该有多少个参数和类型，因此参数使用链表结构来表示，该结构具有使用括号、空格和符号的等价Lisp表示。这些函数的前缀是f，只有当Lisp程序出现并想要应用它时，才会间接调用它们。

　　List * eval(List *exp, List *env);

　　meta-circular evaluator eval转发声明：

　　List * evlist(List *list, List *env) {

　　List *head = 0, **args = &head;

　　for ( ; list ; list = cdr(list) ) {

　　*args = cons( eval(car(list), env) , 0);

　　args = &( (List *) untag(*args) )->next;

　　}

　　return head;

　　}

　　以上是evlist功能，简称"评估列表"。它需要一个列表和一个环境，对列表中的每个项进行评估，返回相应的列表，并对每个输入项进行评估，维护顺序。一个指针指向另一个指针，这种方式虽然会让代码不太明朗，但是我们可以遍历列表，创造一个与所评估的元素相同的并行列表。在Brian Kernighan和Dennis Ritchie的"C编程语言"中，一个指针被认为是一个变量，它包含另一个变量的地址。*操作符取消指针，&获取变量地址。

　　evlist在for循环中遍历列表参数，两个局部变量，指针head，被初始化为0，head的目的是存储将被返回的列表的头部。args是指向指针的指针，它被初始化到头部的地址。在每次迭代中，args被取消引用，指针被分配给新建的单元格。在接下来的一行中，args被分配到构造单元中的下一个字段的地址。这意味着在下一个迭代中，args是指向前一个元素下一个字段指针的指针。

　　List * apply_primitive(void *primfn, List *args) {

　　return ((List * (*) (List *)) primfn) ( args );

　　}

　　apply_primitive函数只将primfn转换为指向一个函数的指针，该函数接受单个List*并返回List *，然后用args调用该函数。

　　List * eval(List *exp, List *env) {

　　if (!is_pair(exp) ) {

　　for ( ; env != 0; env = cdr(env) )

　　if (exp == car(car(env))) return car(cdr(car(env)));

　　return 0;

　　} else {

　　if (!is_pair( car (exp))) { /* special forms */

　　if (car(exp) == intern("quote")) {

　　return car(cdr(exp));

　　} else if (car(exp) == intern("if")) {

　　if (eval (car(cdr(exp)), env) != 0)

　　return eval (car(cdr(cdr(exp))), env);

　　else

　　return eval (car(cdr(cdr(cdr(exp)))), env);

　　} else if (car(exp) == intern("lambda")) {

　　return exp; /* todo: create a closure and capture free vars */

　　} else if (car(exp) == intern("apply")) { /* apply function to list */

　　List *args = evlist (cdr(cdr(exp)), env);

　　args = car(args); /* assumes one argument and that it is a list */

　　return apply_primitive( eval(car(cdr(exp)), env), args);

　　} else { /* function call */

　　List *primop = eval (car(exp), env);

　　if (is_pair(primop)) { /* user defined lambda, arg list eval happens in binding below */

　　return eval( cons(primop, cdr(exp)), env );

　　} else if (primop) { /* built-in primitive */

　　return apply_primitive(primop, evlist(cdr(exp), env));

　　}

　　}

　　} else { /* should be a lambda, bind names into env and eval body */

　　if (car(car(exp)) == intern("lambda")) {

　　List *extenv = env, *names = car(cdr(car(exp))), *vars = cdr(exp);

　　for ( ; names ; names = cdr(names), vars = cdr(vars) )

　　extenv = cons (cons(car(names), cons(eval (car(vars), env), 0)), extenv);

　　return eval (car(cdr(cdr(car(exp)))), extenv);

　　}

　　}

　　}

　　puts("cannot evaluate expression");

　　return 0;

　　}

　　eval函数是LiSP的核心,解释了LisP表达式。

　　int main(int argc, char *argv[]) {

　　List *env = cons (cons(intern("car"), cons((void *)fcar, 0)),

　　cons (cons(intern("cdr"), cons((void *)fcdr, 0)),

　　cons (cons(intern("cons"), cons((void *)fcons, 0)),

　　cons (cons(intern("eq?"), cons((void *)feq, 0)),

　　cons (cons(intern("pair?"), cons((void *)fpair, 0)),

　　cons (cons(intern("symbol?"), cons((void *)fsym, 0)),

　　cons (cons(intern("null?"), cons((void *)fnull, 0)),

　　cons (cons(intern("read"), cons((void *)freadobj, 0)),

　　cons (cons(intern("write"), cons((void *)fwriteobj, 0)),

　　cons (cons(intern("null"), cons(0,0)), 0))))))))));

　　look = getchar();

　　gettoken();

　　print_obj( eval(getobj(), env), 1 );

　　printf(" ");

　　return 0;

　　}

　　main是该程序运行的入口，它有一个变量env，被分配给一个列表列表，有效地将一个符号与一个原始函数关联起来。

　　尽管这个小项目还有很多局限性，但是它提供了足够的原始函数来实现等价的eval。更完整的源代码和测试可以在上查看https://github.com/carld/micro-lisp。