目录
前文列表
《用 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] = ' ';
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('
');
}
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
");
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 Exit
lispy> +
<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相关阅读：