用 C 语言开发一门编程语言 — 变量元素设计
目录
前文列表
《用 C 语言开发一门编程语言 — 交互式解析器》
《用 C 语言开发一门编程语言 — 跨平台的可移植性》
《用 C 语言开发一门编程语言 — 语法解析器》
《用 C 语言开发一门编程语言 — 抽象语法树》
《用 C 语言开发一门编程语言 — 异常处理》
《用 C 语言开发一门编程语言 — S-表达式》
《用 C 语言开发一门编程语言 — Q-表达式》
变量
我们先前实现的 S-Expression 和 Q-Expression 都是直接为了运算求值,但并没有考虑到变量是什么类型。显然的,一门好的编程语言,需要支持多种类型的变量,让程序员可以灵活的命名变量、声明变量类型。
从代码实现的角度来看,我们需要一个新的数据结构来支撑对变量元素进行设计,这个结构将存储所有的变量名和值,我们将这个数据结构称为 Environment(环境)。每次打开一个新的交互式解析器,就会创建一个新的 Environment,让程序员可以存储和再次调用已经定义好的变量。
变量语法规则
首先,我们需要设计好针对变量的语法规则,使得编程语言可以拥有更多的合法符号(关键字)。区别于 C 语言在变量定义上设计了限制性的语法,我们将编程语言的变量语法设计得更加开放一些,支持多样化的操作,为此而使用了正则表达式:
/[a-zA-Z0-9_+\\-*\\/\\\\=<>!]+/
- 1
使得变量名称将可以由数字,字母,加减乘除等符合组成:
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);
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
变量的读取和存储
如此定义了语法规则之后,在我们的编程语言中,符号(Symbol)就不再仅仅代表操作符了,它们现在只是一个名字而已。因此我们还需要一些新标识来区分具有特殊含义的 操作符(lval) 以及 环境(lenv)。
首先添加 lenv 结构体类型,我们将 lenv 结构体类型定义为由一系列的变量名和值组成的。所以使用两个二重指针变量来处理:
struct lenv {
int count;
char** syms;
lval** vals;
};
- 1
- 2
- 3
- 4
- 5
在定义 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);
}
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
接下来将创建两个函数在环境中获取和赋予值:
- 在获取值的函数 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);
}
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
将变量加入 Lisp Value 体系
在先前的章节中,我们实现了很多接受 lval*
类型实参并返回 lval*
类型结果的函数,现在对其进行改造,添加一个形参指向我们的 “环境”,我们将这个新的函数称为 lbuildin,并且为了提高代码效率,我们还将这个函数定义为一个函数指针,并作为 Lisp Value 的类型之一,用于处理变量、操作符、数字、符合的分发。
typedef lval* (*lbuiltin)(lenv*, lval*);
- 1
- 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;
};
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
LVAL_FUN 类型的构造函数:
lval* lval_fun(lbuiltin func) {
lval* v = malloc(sizeof(lval));
v->type = LVAL_FUN;
v->fun = func;
return v;
}
- 1
- 2
- 3
- 4
- 5
- 6
在析构函数中,不需要对 LVAL_FUN 做特殊处理:
case LVAL_FUN: break;
- 1
打印函数也要做相应的修改:
case LVAL_FUN: printf("<function>"); break;
- 1
实现一个新的函数用于拷贝 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;
}
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
变量的计算
因为 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;
}
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
因为引入 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, "/");
}
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
完成了上面的部分后,就可以编写函数进行注册,将上面的函数作为函数指针在内建函数的关键部分进行调用:
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);
}
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
最后我们需要在交互环境启动之前调用这些函数,当然在用完了之后还需要删除这些函数:
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);
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
变量的定义与赋值
现在,我们的编程语言就可以计算变量了,但是用户依旧无法定义自己的变量,无法给变量赋值,所以我们需要继续实现这部分逻辑。让程序员可以使用 {}
来定义自己的变量,如果用户的定义有问题,将返回一个错误,如果定义是对的,将打印一个 ()
:
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();
}
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
异常处理优化
此外,现在我们的异常处理还不完善,所以我们需要添加新的错误处理的代码,把 lval_err 修改得像 printf 一样,具有输出功能。为了灵活的实现,我们采用了 C 语言中的 可变长形参列表 的特性,C 语言提供了 stdarg.h 头文件,该文件提供了实现可变参数功能的函数和宏。
lval* lval_err(char* fmt, ...);
- 1
- 第一步是创建 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;
}
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
现在我们可以更新错误信息的提示,让它更加的完整:
LASSERT(a, a->count == 1,
"Function 'head' passed too many arguments. "
"Got %i, Expected %i.",
a->count, 1);
- 1
- 2
- 3
- 4
现在我们提高错误信息的内容:
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));
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
我们把错误审查做的很详细是为了后面的编写,一旦出错,有 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;
}
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
- 48
- 49
- 50
- 51
- 52
- 53
- 54
- 55
- 56
- 57
- 58
- 59
- 60
- 61
- 62
- 63
- 64
- 65
- 66
- 67
- 68
- 69
- 70
- 71
- 72
- 73
- 74
- 75
- 76
- 77
- 78
- 79
- 80
- 81
- 82
- 83
- 84
- 85
- 86
- 87
- 88
- 89
- 90
- 91
- 92
- 93
- 94
- 95
- 96
- 97
- 98
- 99
- 100
- 101
- 102
- 103
- 104
- 105
- 106
- 107
- 108
- 109
- 110
- 111
- 112
- 113
- 114
- 115
- 116
- 117
- 118
- 119
- 120
- 121
- 122
- 123
- 124
- 125
- 126
- 127
- 128
- 129
- 130
- 131
- 132
- 133
- 134
- 135
- 136
- 137
- 138
- 139
- 140
- 141
- 142
- 143
- 144
- 145
- 146
- 147
- 148
- 149
- 150
- 151
- 152
- 153
- 154
- 155
- 156
- 157
- 158
- 159
- 160
- 161
- 162
- 163
- 164
- 165
- 166
- 167
- 168
- 169
- 170
- 171
- 172
- 173
- 174
- 175
- 176
- 177
- 178
- 179
- 180
- 181
- 182
- 183
- 184
- 185
- 186
- 187
- 188
- 189
- 190
- 191
- 192
- 193
- 194
- 195
- 196
- 197
- 198
- 199
- 200
- 201
- 202
- 203
- 204
- 205
- 206
- 207
- 208
- 209
- 210
- 211
- 212
- 213
- 214
- 215
- 216
- 217
- 218
- 219
- 220
- 221
- 222
- 223
- 224
- 225
- 226
- 227
- 228
- 229
- 230
- 231
- 232
- 233
- 234
- 235
- 236
- 237
- 238
- 239
- 240
- 241
- 242
- 243
- 244
- 245
- 246
- 247
- 248
- 249
- 250
- 251
- 252
- 253
- 254
- 255
- 256
- 257
- 258
- 259
- 260
- 261
- 262
- 263
- 264
- 265
- 266
- 267
- 268
- 269
- 270
- 271
- 272
- 273
- 274
- 275
- 276
- 277
- 278
- 279
- 280
- 281
- 282
- 283
- 284
- 285
- 286
- 287
- 288
- 289
- 290
- 291
- 292
- 293
- 294
- 295
- 296
- 297
- 298
- 299
- 300
- 301
- 302
- 303
- 304
- 305
- 306
- 307
- 308
- 309
- 310
- 311
- 312
- 313
- 314
- 315
- 316
- 317
- 318
- 319
- 320
- 321
- 322
- 323
- 324
- 325
- 326
- 327
- 328
- 329
- 330
- 331
- 332
- 333
- 334
- 335
- 336
- 337
- 338
- 339
- 340
- 341
- 342
- 343
- 344
- 345
- 346
- 347
- 348
- 349
- 350
- 351
- 352
- 353
- 354
- 355
- 356
- 357
- 358
- 359
- 360
- 361
- 362
- 363
- 364
- 365
- 366
- 367
- 368
- 369
- 370
- 371
- 372
- 373
- 374
- 375
- 376
- 377
- 378
- 379
- 380
- 381
- 382
- 383
- 384
- 385
- 386
- 387
- 388
- 389
- 390
- 391
- 392
- 393
- 394
- 395
- 396
- 397
- 398
- 399
- 400
- 401
- 402
- 403
- 404
- 405
- 406
- 407
- 408
- 409
- 410
- 411
- 412
- 413
- 414
- 415
- 416
- 417
- 418
- 419
- 420
- 421
- 422
- 423
- 424
- 425
- 426
- 427
- 428
- 429
- 430
- 431
- 432
- 433
- 434
- 435
- 436
- 437
- 438
- 439
- 440
- 441
- 442
- 443
- 444
- 445
- 446
- 447
- 448
- 449
- 450
- 451
- 452
- 453
- 454
- 455
- 456
- 457
- 458
- 459
- 460
- 461
- 462
- 463
- 464
- 465
- 466
- 467
- 468
- 469
- 470
- 471
- 472
- 473
- 474
- 475
- 476
- 477
- 478
- 479
- 480
- 481
- 482
- 483
- 484
- 485
- 486
- 487
- 488
- 489
- 490
- 491
- 492
- 493
- 494
- 495
- 496
- 497
- 498
- 499
- 500
- 501
- 502
- 503
- 504
- 505
- 506
- 507
- 508
- 509
- 510
- 511
- 512
- 513
- 514
- 515
- 516
- 517
- 518
- 519
- 520
- 521
- 522
- 523
- 524
- 525
- 526
- 527
- 528
- 529
- 530
- 531
- 532
- 533
- 534
- 535
- 536
- 537
- 538
- 539
- 540
- 541
- 542
- 543
- 544
- 545
- 546
- 547
- 548
- 549
- 550
- 551
- 552
- 553
- 554
- 555
- 556
- 557
- 558
- 559
- 560
- 561
- 562
- 563
- 564
- 565
- 566
- 567
- 568
- 569
- 570
- 571
- 572
- 573
- 574
- 575
- 576
- 577
- 578
- 579
- 580
- 581
- 582
- 583
- 584
- 585
- 586
- 587
- 588
- 589
- 590
- 591
- 592
- 593
- 594
- 595
- 596
- 597
- 598
- 599
- 600
- 601
- 602
- 603
- 604
- 605
- 606
- 607
- 608
- 609
- 610
- 611
- 612
- 613
- 614
- 615
- 616
- 617
- 618
- 619
- 620
- 621
- 622
- 623
- 624
- 625
- 626
- 627
- 628
- 629
- 630
- 631
- 632
- 633
- 634
- 635
- 636
- 637
- 638
- 639
- 640
- 641
- 642
- 643
- 644
- 645
- 646
- 647
- 648
- 649
- 650
- 651
- 652
- 653
- 654
- 655
- 656
- 657
- 658
- 659
- 660
- 661
- 662
- 663
- 664
- 665
- 666
- 667
- 668
- 669
- 670
- 671
- 672
- 673
- 674
- 675
- 676
- 677
- 678
- 679
- 680
- 681
- 682
- 683
- 684
- 685
- 686
- 687
- 688
- 689
- 690
- 691
- 692
- 693
- 694
- 695
- 696
- 697
编译:
gcc -g -std=c99 -Wall parsing.c mpc.c -lreadline -lm -o parsing
- 1
运行:
$ ./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
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
文章来源: is-cloud.blog.csdn.net,作者:范桂飓,版权归原作者所有,如需转载,请联系作者。
原文链接:is-cloud.blog.csdn.net/article/details/105449597
- 点赞
- 收藏
- 关注作者
评论(0)