前文列表

《用 C 语言开发一门编程语言 — 交互式解析器》
《用 C 语言开发一门编程语言 — 跨平台的可移植性》
《用 C 语言开发一门编程语言 — 语法解析器》
《用 C 语言开发一门编程语言 — 抽象语法树》
《用 C 语言开发一门编程语言 — 异常处理》
《用 C 语言开发一门编程语言 — S-表达式》
《用 C 语言开发一门编程语言 — Q-表达式》

变量

我们先前实现的 S-Expression 和 Q-Expression 都是直接为了运算求值，但并没有考虑到变量是什么类型。显然的，一门好的编程语言，需要支持多种类型的变量，让程序员可以灵活的命名变量、声明变量类型。

从代码实现的角度来看，我们需要一个新的数据结构来支撑对变量元素进行设计，这个结构将存储所有的变量名和值，我们将这个数据结构称为 Environment（环境）。每次打开一个新的交互式解析器，就会创建一个新的 Environment，让程序员可以存储和再次调用已经定义好的变量。

变量语法规则

首先，我们需要设计好针对变量的语法规则，使得编程语言可以拥有更多的合法符号（关键字）。区别于 C 语言在变量定义上设计了限制性的语法，我们将编程语言的变量语法设计得更加开放一些，支持多样化的操作，为此而使用了正则表达式：

/[a-zA-Z0-9_+\\-*\\/\\\\=<>!]+/

使得变量名称将可以由数字，字母，加减乘除等符合组成：

mpca_lang(MPCA_LANG_DEFAULT,"                                                     \number : /-?[0-9]+/ ;                               \symbol : /[a-zA-Z0-9_+\\-*\\/\\\\=<>!&]+/ ;         \sexpr  : '(' <expr>* ')' ;                          \qexpr  : '{' <expr>* '}' ;                          \expr   : <number> | <symbol> | <sexpr> | <qexpr> ;  \lispy  : /^/ <expr>* /$/ ;                          \",Number, Symbol, Sexpr, Qexpr, Expr, Lispy);

变量的读取和存储

如此定义了语法规则之后，在我们的编程语言中，符号（Symbol）就不再仅仅代表操作符了，它们现在只是一个名字而已。因此我们还需要一些新标识来区分具有特殊含义的 操作符（lval） 以及 环境（lenv）。

首先添加 lenv 结构体类型，我们将 lenv 结构体类型定义为由一系列的变量名和值组成的。所以使用两个二重指针变量来处理：

struct lenv {int count;char** syms;lval** vals;
};

在定义 lenv 结构体的构造函数和析构函数，用于存储变量：

lenv* lenv_new(void) {lenv* e = malloc(sizeof(lenv));e->count = 0;e->syms = NULL;e->vals = NULL;return e;
}void lenv_del(lenv* e) {for (int i = 0; i < e->count; i++) {free(e->syms[i]);lval_del(e->vals[i]);}free(e->syms);free(e->vals);free(e);
}

接下来将创建两个函数在环境中获取和赋予值：

在获取值的函数 lenv_get 中：我们需要检索数据是不是我们需要的值，如果符合我们的标准就返回值的拷贝，如果不符合就返回一个错误信息。
在赋予值的函数 lenv_put 中：代码相对要复杂一些。我们首先要检查变量名之前是否存在，如果存在就会替换掉原先的内容。如果不存在，我们需要申请一些新的内存资源来存储数据，使用 realloc 并存储 lval 的拷贝。

lval* lenv_get(lenv* e, lval* k) {/* Iterate over all items in environment */for (int i = 0; i < e->count; i++) {/* Check if the stored string matches the symbol string *//* If it does, return a copy of the value */if (strcmp(e->syms[i], k->sym) == 0) {return lval_copy(e->vals[i]);}}/* If no symbol found return error */return lval_err("unbound symbol!");
}void lenv_put(lenv* e, lval* k, lval* v) {/* Iterate over all items in environment *//* This is to see if variable already exists */for (int i = 0; i < e->count; i++) {/* If variable is found delete item at that position *//* And replace with variable supplied by user */if (strcmp(e->syms[i], k->sym) == 0) {lval_del(e->vals[i]);e->vals[i] = lval_copy(v);return;}}/* If no existing entry found allocate space for new entry */e->count++;e->vals = realloc(e->vals, sizeof(lval*) * e->count);e->syms = realloc(e->syms, sizeof(char*) * e->count);/* Copy contents of lval and symbol string into new location */e->vals[e->count-1] = lval_copy(v);e->syms[e->count-1] = malloc(strlen(k->sym)+1);strcpy(e->syms[e->count-1], k->sym);
}

将变量加入 Lisp Value 体系

在先前的章节中，我们实现了很多接受 lval* 类型实参并返回 lval* 类型结果的函数，现在对其进行改造，添加一个形参指向我们的 “环境”，我们将这个新的函数称为 lbuildin，并且为了提高代码效率，我们还将这个函数定义为一个函数指针，并作为 Lisp Value 的类型之一，用于处理变量、操作符、数字、符合的分发。

typedef lval* (*lbuiltin)(lenv*, lval*);

typedef 关键字：为变量取一个别名。
lbuiltin：函数指针名

这行代码的含义是：为了获取 lval* 类型结果，我们创建了 lbuiltin 函数指针变量，并带有 lenv* 和 lval* 两个形参。如此的，我们就可以在继续沿用 Lisp Value 体系的情况下，区分完成针对 环境（lenv） 的操作了。

/* Forward Declarations */struct lval;
struct lenv;
typedef struct lval lval;
typedef struct lenv lenv;/* Lisp Value */enum { LVAL_ERR, LVAL_NUM,   LVAL_SYM,LVAL_FUN, LVAL_SEXPR, LVAL_QEXPR };typedef lval*(*lbuiltin)(lenv*, lval*);struct lval {int type;long num;char* err;char* sym;lbuiltin fun;int count;lval** cell;
};

LVAL_FUN 类型的构造函数：

lval* lval_fun(lbuiltin func) {lval* v = malloc(sizeof(lval));v->type = LVAL_FUN;v->fun = func;return v;
}

在析构函数中，不需要对 LVAL_FUN 做特殊处理：

case LVAL_FUN: break;

打印函数也要做相应的修改：

case LVAL_FUN:   printf("<function>"); break;

实现一个新的函数用于拷贝 lval，完成从环境中读取并存储数据。对于数字和字符串，我们只需要拷贝值就好了，但是对于字符串，我们还需要考虑分配内存资源，需要使用到 malloc 和 strcpy。对于数组的拷贝，首先需要分配好资源，然后将数组元素一个一个进行拷贝。

lval* lval_copy(lval* v) {lval* x = malloc(sizeof(lval));x->type = v->type;switch (v->type) {/* Copy Functions and Numbers Directly */case LVAL_FUN: x->fun = v->fun; break;case LVAL_NUM: x->num = v->num; break;/* Copy Strings using malloc and strcpy */case LVAL_ERR:x->err = malloc(strlen(v->err) + 1);strcpy(x->err, v->err); break;case LVAL_SYM:x->sym = malloc(strlen(v->sym) + 1);strcpy(x->sym, v->sym); break;/* Copy Lists by copying each sub-expression */case LVAL_SEXPR:case LVAL_QEXPR:x->count = v->count;x->cell = malloc(sizeof(lval*) * x->count);for (int i = 0; i < x->count; i++) {x->cell[i] = lval_copy(v->cell[i]);}break;}return x;
}

变量的计算

因为 Lisp Value 引入了 lenv “变量” 结构体，所以整个运算的逻辑都要进行相应的修改，好在整体的框架不需要变化。

lval* lval_eval(lenv* e, lval* v) {if (v->type == LVAL_SYM) {lval* x = lenv_get(e, v);lval_del(v);return x;}if (v->type == LVAL_SEXPR) { return lval_eval_sexpr(e, v); }return v;
}lval* lval_eval_sexpr(lenv* e, lval* v) {for (int i = 0; i < v->count; i++) {v->cell[i] = lval_eval(e, v->cell[i]);}for (int i = 0; i < v->count; i++) {if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); }}if (v->count == 0) { return v; }if (v->count == 1) { return lval_take(v, 0); }/* Ensure first element is a function after evaluation */lval* f = lval_pop(v, 0);if (f->type != LVAL_FUN) {lval_del(v); lval_del(f);return lval_err("first element is not a function");}/* If so call function to get result */lval* result = f->fun(e, v);lval_del(f);return result;
}

因为引入 lenv 结构的同事也重新定义了符号的语法规则，所以还需要重新定义 builtin 函数：

lval* builtin_add(lenv* e, lval* a) {return builtin_op(e, a, "+");
}lval* builtin_sub(lenv* e, lval* a) {return builtin_op(e, a, "-");
}lval* builtin_mul(lenv* e, lval* a) {return builtin_op(e, a, "*");
}lval* builtin_div(lenv* e, lval* a) {return builtin_op(e, a, "/");
}

完成了上面的部分后，就可以编写函数进行注册，将上面的函数作为函数指针在内建函数的关键部分进行调用：

void lenv_add_builtin(lenv* e, char* name, lbuiltin func) {lval* k = lval_sym(name);lval* v = lval_fun(func);lenv_put(e, k, v);lval_del(k); lval_del(v);
}void lenv_add_builtins(lenv* e) {/* List Functions */lenv_add_builtin(e, "list", builtin_list);lenv_add_builtin(e, "head", builtin_head);lenv_add_builtin(e, "tail", builtin_tail);lenv_add_builtin(e, "eval", builtin_eval);lenv_add_builtin(e, "join", builtin_join);/* Mathematical Functions */lenv_add_builtin(e, "+", builtin_add);lenv_add_builtin(e, "-", builtin_sub);lenv_add_builtin(e, "*", builtin_mul);lenv_add_builtin(e, "/", builtin_div);
}

最后我们需要在交互环境启动之前调用这些函数，当然在用完了之后还需要删除这些函数：

lenv* e = lenv_new();
lenv_add_builtins(e);while (1) {char* input = readline("lispy> ");add_history(input);mpc_result_t r;if (mpc_parse("<stdin>", input, Lispy, &r)) {lval* x = lval_eval(e, lval_read(r.output));lval_println(x);lval_del(x);mpc_ast_delete(r.output);} else {mpc_err_print(r.error);mpc_err_delete(r.error);}free(input);}lenv_del(e);

变量的定义与赋值

现在，我们的编程语言就可以计算变量了，但是用户依旧无法定义自己的变量，无法给变量赋值，所以我们需要继续实现这部分逻辑。让程序员可以使用 {} 来定义自己的变量，如果用户的定义有问题，将返回一个错误，如果定义是对的，将打印一个 ()：

lval* builtin_def(lenv* e, lval* a) {LASSERT(a, a->cell[0]->type == LVAL_QEXPR,"Function 'def' passed incorrect type!");/* First argument is symbol list */lval* syms = a->cell[0];/* Ensure all elements of first list are symbols */for (int i = 0; i < syms->count; i++) {LASSERT(a, syms->cell[i]->type == LVAL_SYM,"Function 'def' cannot define non-symbol");}/* Check correct number of symbols and values */LASSERT(a, syms->count == a->count-1,"Function 'def' cannot define incorrect ""number of values to symbols");/* Assign copies of values to symbols */for (int i = 0; i < syms->count; i++) {lenv_put(e, syms->cell[i], a->cell[i+1]);}lval_del(a);return lval_sexpr();
}

异常处理优化

此外，现在我们的异常处理还不完善，所以我们需要添加新的错误处理的代码，把 lval_err 修改得像 printf 一样，具有输出功能。为了灵活的实现，我们采用了 C 语言中的 可变长形参列表 的特性，C 语言提供了 stdarg.h 头文件，该文件提供了实现可变参数功能的函数和宏。

lval* lval_err(char* fmt, ...);

第一步是创建 va_list 类型变量
然后使用 va_start 宏来初始化 va_list 变量为一个参数列表
使用 va_arg 宏和 va_list 变量来访问参数列表中的每个项
使用宏 va_end 来清理赋予 va_list 变量的内存。

此外，还使用了 vsnprintf 内建函数，vsnprintf 类似于 printf，默认输出字符串，因为我们不知道字符串的大小，默认分配了 512 个字节，当输出的字符串小于这个值，就会重新分配资源，如果大于这个值，就会报错，希望不会出现这个问题：

lval* lval_err(char* fmt, ...) {lval* v = malloc(sizeof(lval));v->type = LVAL_ERR;/* Create a va list and initialize it */va_list va;va_start(va, fmt);/* Allocate 512 bytes of space */v->err = malloc(512);/* printf the error string with a maximum of 511 characters */vsnprintf(v->err, 511, fmt, va);/* Reallocate to number of bytes actually used */v->err = realloc(v->err, strlen(v->err)+1);/* Cleanup our va list */va_end(va);return v;
}

现在我们可以更新错误信息的提示，让它更加的完整：

LASSERT(a, a->count == 1,"Function 'head' passed too many arguments. ""Got %i, Expected %i.",a->count, 1);

现在我们提高错误信息的内容：

char* ltype_name(int t) {switch(t) {case LVAL_FUN: return "Function";case LVAL_NUM: return "Number";case LVAL_ERR: return "Error";case LVAL_SYM: return "Symbol";case LVAL_SEXPR: return "S-Expression";case LVAL_QEXPR: return "Q-Expression";default: return "Unknown";}
}LASSERT(a, a->cell[0]->type == LVAL_QEXPR,"Function 'head' passed incorrect type for argument 0. ""Got %s, Expected %s.",ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR));

我们把错误审查做的很详细是为了后面的编写，一旦出错，有 log 可以查看，这是良好的编程风格。并且使用宏可以减少很多代码的编写。

源代码

#include <stdio.h>
#include <stdlib.h>
#include "mpc.h"#define LASSERT(args, cond, fmt, ...) \if (!(cond)) { lval* err = lval_err(fmt, ##__VA_ARGS__); lval_del(args); return err; }#define LASSERT_TYPE(func, args, index, expect) \LASSERT(args, args->cell[index]->type == expect, \"Function '%s' passed incorrect type for argument %i. Got %s, Expected %s.", \func, index, ltype_name(args->cell[index]->type), ltype_name(expect))#define LASSERT_NUM(func, args, num) \LASSERT(args, args->count == num, \"Function '%s' passed incorrect number of arguments. Got %i, Expected %i.", \func, args->count, num)#define LASSERT_NOT_EMPTY(func, args, index) \LASSERT(args, args->cell[index]->count != 0, \"Function '%s' passed {} for argument %i.", func, index);#ifdef _WIN32
#include <string.h>static char buffer[2048];char *readline(char *prompt) {fputs(prompt, stdout);fgets(buffer, 2048, stdin);char *cpy = malloc(strlen(buffer) + 1);strcpy(cpy, buffer);cpy[strlen(cpy) - 1] = '\0';return cpy;
}void add_history(char *unused) {}#else#ifdef __linux__
#include <readline/readline.h>
#include <readline/history.h>
#endif#ifdef __MACH__
#include <readline/readline.h>
#endif#endif/* Forward Declarations */
struct lval;
struct lenv;
typedef struct lval lval;
typedef struct lenv lenv;/* Lisp Value Type Enumeration */
enum {LVAL_NUM,LVAL_ERR,LVAL_SYM,LVAL_FUN,LVAL_SEXPR,LVAL_QEXPR
};typedef lval *(*lbuiltin)(lenv*, lval*);/* Declare lisp lval Struct */
struct lval {int type;long num;/* Count and Pointer to a list of "lval*" */struct lval **cell;int count;/* Error and Symbol types have some string data */char *err;char *sym;lbuiltin fun;
};/* Construct a pointer to a new Number lval */
lval *lval_num(long x) {lval *v = malloc(sizeof(lval));v->type = LVAL_NUM;v->num = x;return v;
}char *ltype_name(int t) {switch(t) {case LVAL_FUN: return "Function";case LVAL_NUM: return "Number";case LVAL_ERR: return "Error";case LVAL_SYM: return "Symbol";case LVAL_SEXPR: return "S-Expression";case LVAL_QEXPR: return "Q-Expression";default: return "Unknown";}
}/* Construct a pointer to a new Error lval */
lval *lval_err(char *fmt, ...) {lval *v = malloc(sizeof(lval));v->type = LVAL_ERR;/* Create a va list and initialize it */va_list va;va_start(va, fmt);/* Allocate 512 bytes of space */v->err = malloc(512);/* printf the error string with a maximum of 511 characters */vsnprintf(v->err, 511, fmt, va);/* Reallocate to number of bytes actually used */v->err = realloc(v->err, strlen(v->err)+1);/* Cleanup our va list */va_end(va);return v;
}/* Construct a pointer to a new Symbol lval */
lval *lval_sym(char *sym) {lval *v = malloc(sizeof(lval));v->type = LVAL_SYM;v->sym = malloc(strlen(sym) + 1);strcpy(v->sym, sym);return v;
}/* A pointer to a new empty Sexpr lval */
lval *lval_sexpr(void) {lval *v = malloc(sizeof(lval));v->type = LVAL_SEXPR;v->count = 0;v->cell = NULL;return v;
}/* A pointer to a new empty Qexpr lval */
lval *lval_qexpr(void) {lval *v = malloc(sizeof(lval));v->type = LVAL_QEXPR;v->count = 0;v->cell = NULL;return v;
}lval *lval_fun(lbuiltin func) {lval *v = malloc(sizeof(lval));v->type = LVAL_FUN;v->fun = func;return v;
}void lval_del(lval *v) {switch (v->type) {/* Do nothing special for number type */case LVAL_NUM:break;/* For Err or Sym free the string data */case LVAL_ERR:free(v->err);break;case LVAL_SYM:free(v->sym);break;case LVAL_FUN:break;/* If Qexpr or Sexpr then delete all elements inside */case LVAL_QEXPR:case LVAL_SEXPR:for (int i = 0; i < v->count; i++) {lval_del(v->cell[i]);}/* Also free the memory allocated to contain the pointers */free(v->cell);break;}/* Free the memory allocated for the "lval" struct itself */free(v);
}struct lenv {int count;char **syms;lval **vals;
};lenv *lenv_new(void) {lenv *e = malloc(sizeof(lenv));e->count = 0;e->syms = NULL;e->vals = NULL;return e;
}void lenv_del(lenv *e) {for (int i = 0; i < e->count; i++) {free(e->syms[i]);lval_del(e->vals[i]);}free(e->syms);free(e->vals);free(e);
}lval *lval_copy(lval *v) {lval *x = malloc(sizeof(lval));x->type = v->type;switch (v->type) {/* Copy Functions and Numbers Directly */case LVAL_FUN: x->fun = v->fun; break;case LVAL_NUM: x->num = v->num; break;/* Copy Strings using malloc and strcpy */case LVAL_ERR:x->err = malloc(strlen(v->err) + 1);strcpy(x->err, v->err);break;case LVAL_SYM:x->sym = malloc(strlen(v->sym) + 1);strcpy(x->sym, v->sym);break;/* Copy Lists by copying each sub-expression */case LVAL_SEXPR:case LVAL_QEXPR:x->count = v->count;x->cell = malloc(sizeof(lval*) * x->count);for (int i = 0; i < x->count; i++) {x->cell[i] = lval_copy(v->cell[i]);}break;}return x;
}lval *lenv_get(lenv *e, lval *k) {/* Iterate over all items in environment */for (int i = 0; i < e->count; i++) {/* Check if the stored string matches the symbol string *//* If it does, return a copy of the value */if (strcmp(e->syms[i], k->sym) == 0) {return lval_copy(e->vals[i]);}}/* If no symbol found return error */return lval_err("Unbound Symbol '%s'", k->sym);
}void lenv_put(lenv *e, lval *k, lval *v) {/* Iterate over all items in environment *//* This is to see if variable already exists */for (int i = 0; i < e->count; i++) {/* If variable is found delete item at that position *//* And replace with variable supplied by user */if (strcmp(e->syms[i], k->sym) == 0) {lval_del(e->vals[i]);e->vals[i] = lval_copy(v);return;}}/* If no existing entry found allocate space for new entry */e->count++;e->vals = realloc(e->vals, sizeof(lval*) * e->count);e->syms = realloc(e->syms, sizeof(char*) * e->count);/* Copy contents of lval and symbol string into new location */e->vals[e->count-1] = lval_copy(v);e->syms[e->count-1] = malloc(strlen(k->sym)+1);strcpy(e->syms[e->count-1], k->sym);
}lval *lval_add(lval *v, lval *x) {v->count++;v->cell = realloc(v->cell, sizeof(lval*) * v->count);v->cell[v->count-1] = x;return v;
}lval *lval_read_num(mpc_ast_t *t) {errno = 0;long x = strtol(t->contents, NULL, 10);return errno != ERANGE? lval_num(x): lval_err("invalid number");
}lval *lval_read(mpc_ast_t *t) {/* If Symbol or Number return conversion to that type */if (strstr(t->tag, "number")) {return lval_read_num(t);}if (strstr(t->tag, "symbol")) {return lval_sym(t->contents);}/* If root (>) or sexpr then create empty list */lval *x = NULL;if (strcmp(t->tag, ">") == 0) {x = lval_sexpr();}if (strstr(t->tag, "sexpr"))  {x = lval_sexpr();}if (strstr(t->tag, "qexpr")) {x = lval_qexpr();}/* Fill this list with any valid expression contained within */for (int i = 0; i < t->children_num; i++) {if (strcmp(t->children[i]->contents, "(") == 0) { continue; }if (strcmp(t->children[i]->contents, ")") == 0) { continue; }if (strcmp(t->children[i]->contents, "}") == 0) { continue; }if (strcmp(t->children[i]->contents, "{") == 0) { continue; }if (strcmp(t->children[i]->tag,  "regex") == 0) { continue; }x = lval_add(x, lval_read(t->children[i]));}return x;
}void lval_print(lval *v);void lval_expr_print(lval *v, char open, char close) {putchar(open);for (int i = 0; i < v->count; i++) {/* Print Value contained within */lval_print(v->cell[i]);/* Don't print trailing space if last element */if (i != (v->count-1)) {putchar(' ');}}putchar(close);}/* Print an "lval*" */
void lval_print(lval *v) {switch (v->type) {case LVAL_NUM:   printf("%li", v->num); break;case LVAL_ERR:   printf("Error: %s", v->err); break;case LVAL_SYM:   printf("%s", v->sym); break;case LVAL_FUN:   printf("<function>"); break;case LVAL_SEXPR: lval_expr_print(v, '(', ')'); break;case LVAL_QEXPR: lval_expr_print(v, '{', '}'); break;}
}/* Print an "lval" followed by a newline */
void lval_println(lval *v) {lval_print(v);putchar('\n');
}lval *lval_pop(lval *v, int i) {/* Find the item at "i" */lval *x = v->cell[i];/* Shift memory after the item at "i" over the top */memmove(&v->cell[i], &v->cell[i+1],sizeof(lval*) * (v->count-i-1));/* Decrease the count of items in the list */v->count--;/* Reallocate the memory used */v->cell = realloc(v->cell, sizeof(lval*) * v->count);return x;
}lval *lval_take(lval *v, int i) {lval *x = lval_pop(v, i);lval_del(v);return x;
}lval *lval_eval(lenv *e, lval *v);
lval *builtin(lval* a, char* func);lval *lval_eval_sexpr(lenv *e, lval *v) {/* Evaluate Children */for (int i = 0; i < v->count; i++) {v->cell[i] = lval_eval(e, v->cell[i]);}/* Error Checking */for (int i = 0; i < v->count; i++) {if (v->cell[i]->type == LVAL_ERR) {return lval_take(v, i);}}/* Empty Expression */if (v->count == 0) { return v; }/* Single Expression */if (v->count == 1) { return lval_take(v, 0); }/* Ensure first element is a function after evaluation */lval *f = lval_pop(v, 0);if (f->type != LVAL_FUN) {lval_del(f);lval_del(v);return lval_err("first element is not a function");}/* If so call function to get result */lval *result = f->fun(e, v);lval_del(f);return result;
}lval *lval_eval(lenv *e, lval *v) {if (v->type == LVAL_SYM) {lval *x = lenv_get(e, v);lval_del(v);return x;}/* Evaluate Sexpressions */if (v->type == LVAL_SEXPR) {return lval_eval_sexpr(e, v);}/* All other lval types remain the same */return v;
}lval *builtin_op(lenv* e, lval *a, char *op) {/* Ensure all arguments are numbers */for (int i = 0; i < a->count; i++) {LASSERT_TYPE(op, a, i, LVAL_NUM);}/* Pop the first element */lval *x = lval_pop(a, 0);/* If no arguments and sub then perform unary negation */if ((strcmp(op, "-") == 0) && a->count == 0) {x->num = -x->num;}/* While there are still elements remaining */while (a->count > 0) {/* Pop the next element */lval *y = lval_pop(a, 0);if (strcmp(op, "+") == 0) { x->num += y->num; }if (strcmp(op, "-") == 0) { x->num -= y->num; }if (strcmp(op, "*") == 0) { x->num *= y->num; }if (strcmp(op, "/") == 0) {if (y->num == 0) {lval_del(x);lval_del(y);x = lval_err("Division By Zero!");break;}x->num /= y->num;}lval_del(y);}lval_del(a);return x;
}lval *builtin_head(lenv* e, lval *a) {LASSERT_NUM("head", a, 1);LASSERT_TYPE("head", a, 0, LVAL_QEXPR);LASSERT_NOT_EMPTY("head", a, 0);/* Otherwise take first argument */lval *v = lval_take(a, 0);/* Delete all elements that are not head and return */while (v->count > 1) {lval_del(lval_pop(v, 1));}return v;
}lval *builtin_tail(lenv *e, lval *a) {LASSERT_NUM("tail", a, 1);LASSERT_TYPE("tail", a, 0, LVAL_QEXPR);LASSERT_NOT_EMPTY("tail", a, 0);/* Take first argument */lval *v = lval_take(a, 0);/* Delete first element and return */lval_del(lval_pop(v, 0));return v;}lval *builtin_list(lenv* e, lval *a) {a->type = LVAL_QEXPR;return a;
}lval *builtin_eval(lenv* e, lval *a) {LASSERT_NUM("eval", a, 1);LASSERT_TYPE("eval", a, 0, LVAL_QEXPR);lval *x = lval_take(a, 0);x->type = LVAL_SEXPR;return lval_eval(e, x);
}lval *lval_join(lval *x, lval *y) {/* For each cell in 'y' add it to 'x' */while (y->count) {x = lval_add(x, lval_pop(y, 0));}/* Delete the empty 'y' and return 'x' */lval_del(y);return x;
}lval *builtin_join(lenv *e, lval *a) {for (int i = 0; i < a->count; i++) {LASSERT_TYPE("join", a, i, LVAL_QEXPR);}lval *x = lval_pop(a, 0);while (a->count) {x = lval_join(x, lval_pop(a, 0));}lval_del(a);return x;
}lval *builtin_add(lenv *e, lval *a) {return builtin_op(e, a, "+");
}lval *builtin_sub(lenv *e, lval *a) {return builtin_op(e, a, "-");
}lval *builtin_mul(lenv *e, lval *a) {return builtin_op(e, a, "*");
}lval *builtin_div(lenv *e, lval *a) {return builtin_op(e, a, "/");
}void lenv_add_builtin(lenv *e, char *name, lbuiltin func) {lval *k = lval_sym(name);lval *v = lval_fun(func);lenv_put(e, k, v);lval_del(k); lval_del(v);
}lval *builtin_def(lenv *e, lval *a) {LASSERT_TYPE("def", a, 0, LVAL_QEXPR);/* First argument is symbol list */lval *syms = a->cell[0];/* Ensure all elements of first list are symbols */for (int i = 0; i < syms->count; i++) {LASSERT(a, syms->cell[i]->type == LVAL_SYM,"Function 'def' cannot define non-symbol");}/* Check correct number of symbols and values */LASSERT(a, syms->count == a->count-1,"Function 'def' cannot define incorrect ""number of values to symbols");/* Assign copies of values to symbols */for (int i = 0; i < syms->count; i++) {lenv_put(e, syms->cell[i], a->cell[i+1]);}lval_del(a);return lval_sexpr();
}void lenv_add_builtins(lenv *e) {/* Variable Functions */lenv_add_builtin(e, "def", builtin_def);/* List Functions */lenv_add_builtin(e, "list", builtin_list);lenv_add_builtin(e, "head", builtin_head);lenv_add_builtin(e, "tail", builtin_tail);lenv_add_builtin(e, "eval", builtin_eval);lenv_add_builtin(e, "join", builtin_join);/* Mathematical Functions */lenv_add_builtin(e, "+", builtin_add);lenv_add_builtin(e, "-", builtin_sub);lenv_add_builtin(e, "*", builtin_mul);lenv_add_builtin(e, "/", builtin_div);
}int main(int argc, char *argv[]) {/* Create Some Parsers */mpc_parser_t *Number   = mpc_new("number");mpc_parser_t* Symbol   = mpc_new("symbol");mpc_parser_t* Sexpr    = mpc_new("sexpr");mpc_parser_t *Qexpr    = mpc_new("qexpr");mpc_parser_t *Expr     = mpc_new("expr");mpc_parser_t *Lispy    = mpc_new("lispy");/* Define them with the following Language */mpca_lang(MPCA_LANG_DEFAULT,"                                                       \number   : /-?[0-9]+/ ;                                 \symbol   : /[a-zA-Z0-9_+\\-*\\/\\\\=<>!&]+/ ;           \sexpr    : '(' <expr>* ')' ;                            \qexpr    : '{' <expr>* '}' ;                            \expr     : <number> | <symbol> | <sexpr> | <qexpr> ;    \lispy    : /^/ <expr>* /$/ ;                            \",Number, Symbol, Sexpr, Qexpr, Expr, Lispy);puts("Lispy Version 0.1");puts("Press Ctrl+c to Exit\n");lenv *e = lenv_new();lenv_add_builtins(e);while(1) {char *input = readline("lispy> ");add_history(input);/* Attempt to parse the user input */mpc_result_t r;if (mpc_parse("<stdin>", input, Lispy, &r)) {/* On success print and delete the AST */lval *x = lval_eval(e, lval_read(r.output));lval_println(x);lval_del(x);mpc_ast_delete(r.output);} else {/* Otherwise print and delete the Error */mpc_err_print(r.error);mpc_err_delete(r.error);}free(input);}lenv_del(e);/* Undefine and delete our parsers */mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);return 0;
}

编译：

gcc -g -std=c99 -Wall parsing.c mpc.c -lreadline -lm -o parsing

运行：

$ ./parsing
Lispy Version 0.1
Press Ctrl+c to Exitlispy> +
<function>
lispy> eval (head {5 10 11 15})
5
lispy> (head {5 10 11 15})
{5}
lispy> eval (head {+ - + - * / }) 10 20
Error: Function 'eval' passed too many arguments!Got 3, Expected 1.
lispy> (eval (head {+ - + - * /})) 10 20
30
lispy> hello
Error: Unbound Symbol 'hello'
lispy> def {x} 100
()
lispy> def {y} 200
()
lispy> x
100
lispy> y
200
lispy> + x y
300
lispy> def {a b} 5 6
()
lispy> + a b
11
lispy> def {arglist} {a b c d}
()
lispy> arglist
{a b c d}
lispy> def arglist 1 2 3 4
()
lispy> arglist
{a b c d}
lispy> list a b c d
{1 2 3 4}
lispy> + 1 {5 6 7}
Error: Cannot operate on non-number!
lispy> head {1 2 3} {4 5 6}
Error: Function 'head' passed too many arguments. Got 2, Expected 1.
lispy> + 1 1
2

用 C 语言开发一门编程语言 — 变量元素设计相关推荐

用 C 语言开发一门编程语言 — 字符串的设计与实现
目录文章目录目录前言前文列表字符串与文件库字符串 print 关键字函数 error 关键字函数注释文件加载函数注册命令行参数前言通过开发一门类 Lisp 的编程语言来理解编程 ...
用 C 语言开发一门编程语言 — 字符串与文件加载
目录文章目录目录前文列表字符串读取字符串注释文件加载函数命令行参数打印函数报错函数源代码前文列表 <用 C 语言开发一门编程语言 - 交互式解析器> <用 C ...
用 C 语言开发一门编程语言 — 条件分支
目录文章目录目录前文列表条件分支排序函数等于函数 if 函数递归函数源代码前文列表 <用 C 语言开发一门编程语言 - 交互式解析器> <用 C 语言开发一门编程语 ...
用 C 语言开发一门编程语言 — 基于 Lambda 表达式的函数设计
目录文章目录目录前文列表函数 Lambda 表达式函数设计函数的存储实现 Lambda 函数函数的运行环境函数调用可变长的函数参数源代码前文列表 <用 C 语言开发一门编 ...
用 C 语言开发一门编程语言 — S-表达式
目录文章目录目录前文列表使用 S-表达式进行重构读取并存储输入实现 S-Expression 语法解析器实现 S-Expression 存储器实现 lval 变量的构造函数实现 lv ...
用 C 语言开发一门编程语言 — Q-表达式
目录文章目录目录前文列表 Q-表达式读取并存储输入实现 Q-Expression 语法解析器读取 Q-Expression 实现 Q-Expression 的函数 Head & T ...
用 C 语言开发一门编程语言 — 异常处理
目录文章目录目录前文列表异常捕获定义 Lisp Value 函数前文列表 <用 C 语言开发一门编程语言 - 交互式解析器l> <用 C 语言开发一门编程语言 - 跨平台 ...
用 C 语言开发一门编程语言 — 抽象语法树
目录文章目录目录前文列表抽象语法树的结构使用递归来遍历树结构实现求值计算抽象语法树与行为树前文列表 <用 C 语言开发一门编程语言 - 交互式解析器l> <用 C 语 ...
用 C 语言开发一门编程语言 — 语法解析器
目录文章目录目录前文列表编程语言的本质词法分析语法分析使用 MPC 解析器组合库安装快速入门实现波兰表达式的语法解析波兰表达式正则表达式代码实现前文列表 <用 C 语 ...

用 C 语言开发一门编程语言 — 变量元素设计

目录

文章目录