变量与环境
我们之前已经实现了相当多的功能,例如波兰表达式的处理与计算,S表达式,Q表达式,我们甚至可以吧代码本身放到列表里,现在我们需要为MyLisp添加变量的功能了
不变性
到目前位置,我们所添加的变量是不可变的,只是暂时我们还没有添加这个功能罢了
当我们在计算一个表达式的时候,他的基本逻辑是删除先前的事物(表达式),返回新的事物(结果)
所以我们的变量其实只是命名值的一种方式,给值分配一个名称,然后在需要的时候获取该值的副本
为了允许命名,我们需要创建一个结构体,存储命名中的所有内容的名称和值,我们称之为环境,当我们开始创建一个新的名称-表达式关系时,同时创建一个新的环境匹配他
在MyLisp中,如果我们给变量重新分配一个名称时,在底层上其实是把原先的对象删除,然后再新建一个,再分配名称,与C语言是有很大不同的
符号语法
我们现在需要更新一下符号语法,以更好的适配变量命名
我们需要他灵活一点,可能匹配任何可能有效的符号,没有限制,正则表达式如下
/[a-zA-Z0-9_+\\-*\\/\\\\=<>!&]+/
此规则允许符号是任何普通的 C 标识符字符 a-zA-Z0-9_
、算术运算符字符 +\\-*\\/
、反斜杠字符 \\\\
、比较运算符字符 =<>!
或 & &
符号。这将为我们定义新符号和现有符号所需的所有灵活性
函数指针
一旦我们引入变量,符号在MyLisp中就不再代表函数,而是代表一个名称,用于在我们的环境中查找并获取一些新的返回值
因此,我们需要一个新的值来在我们的语言中表示函数,一旦遇到内置符号之一,就可以返回这个值
为了创建这种新的特性,我们将使用函数指针
函数指针是C语言的一个非常牛的特性,它允许你存储和传递指向函数的指针
我们可以像调用普通函数一样使用它们来调用它们指向的函数
和普通指针一样,函数指针也与某些类型相关联。此类型指定指向的函数的类型,而不是指向的数据的类型
在上一章中,我们的内置函数将MLval*作为输入,并返回MLval*作为输出。在这一章中,我们的内置函数将额外接收一个指向环境MLenv*的指针作为输入。我们可以为这种类型的函数声明一个新的函数指针类型,称为MLbuiltin,如下
typedef MLval* (*MLbuiltin)(MLenv*, MLval*);
这个语法看起来非常奇怪,你可以以函数的角度来理解,这句话的意思是
将返回值为MLval* 参数为MLenv*,MLval* 的函数重新命名为*MLbuiltin
前向声明
因为结构体,函数指针是互相包含的,因此我们需要使用前向声明,这样就能解决问题了
struct MLval;
struct MLenv;
typedef struct MLval MLval;
typedef struct MLenv MLenv;
typedef MLval* (*MLbuiltin)(MLenv*, MLval*);
struct MLval {
int type;
double num;
char* err;
char* sym;
MLbuiltin fun;
int count;
MLval** cell;
};
struct MLenv {
int count;
char** syms;
MLval** vals;
};
函数类型
这是一个新的类型,因此需要新的构造函数
MLval* MLval_fun(MLbuiltin func) { // 函数类型初始化
MLval* v = (MLval*)malloc(sizeof(MLval));
assert(v);
v->type = MLVAL_FUN;
v->fun = func;
return v;
}
在删除时,我们不需要为函数指针做任何特殊处理。
case MLVAL_FUN: break;
在打印时,我们只需打印出一个名义上的字符串。
case MLVAL_FUN: printf("<builtin function>"); break;
拷贝函数需要重新写一下
MLval* MLval_copy(MLval* v) { // 复制
MLval* x = (MLval*)malloc(sizeof(MLval));
assert(x);
x->type = v->type;
switch (v->type) {
// 数字和函数直接复制
case MLVAL_FUN: x->fun = v->fun; break;
case MLVAL_NUM: x->num = v->num; break;
// 字符串需要重新分配空间
case MLVAL_ERR:
x->err = (char*)malloc(strlen(v->err) + 1);
assert(x->err);
strcpy(x->err, v->err); break;
case MLVAL_SYM:
x->sym = (char*)malloc(strlen(v->sym) + 1);
assert(x->err);
strcpy(x->sym, v->sym); break;
// 表达式需要循环递归
case MLVAL_SEXPR:
case MLVAL_QEXPR:
x->count = v->count;
x->cell = (MLval**)malloc(sizeof(MLval*) * x->count);
assert(x->cell);
for (int i = 0; i < x->count; i++) {
x->cell[i] = MLval_copy(v->cell[i]);
}
break;
}
return x;
}
环境
我们的环境结构必须包含名称和值之间的关系列表。有很多方法可以构建可以完成这种工作的结构。我们将选择最简单且有效的方法。这是使用两个等长的列表
一个是lval*
的列表,另一个是char*
的列表。一个列表中的每个条目在另一个列表中的相同位置都有一个对应的条目
struct MLenv {
int count;
char** syms; // 符号列表
MLval** vals; // 参数列表
};
我们需要一些函数来创建和删除这个结构
这些非常简单。创建函数会初始化结构体字段,而删除函数则会遍历两个列表中的项并删除或释放它们
MLenv* MLenv_new() { // 初始化
MLenv* e = (MLenv*)malloc(sizeof(MLenv));
assert(e);
e->count = 0;
e->syms = NULL;
e->vals = NULL;
return e;
}
void MLenv_del(MLenv* e) { // 析构函数
for (int i = 0; i < e->count; i++) {
free(e->syms[i]);
MLval_del(e->vals[i]);
}
free(e->syms);
free(e->vals);
free(e);
}
接下来,我们可以创建两个函数,一个从环境中获取值,另一个将值放入环境中。
要从环境中获取值,我们遍历环境中的所有项,并检查给定的符号是否与存储的字符串中的任何一个匹配
如果找到匹配项,则可以返回存储值的副本
如果没有找到匹配项,则应返回一个错误。
将新变量放入环境的函数稍微复杂一些
首先,要检查是否已存在具有相同名称的变量
如果是,我们应该用新的值替换它的值
如果找到匹配,删除该位置存储的值,并在那里存储输入值的副本。
如果没有找到具有该名称的现有值,就需要直接分配空间
MLval* MLenv_get(MLenv* e, MLval* k) { // 从环境中取值
// 遍历所有项
for (int i = 0; i < e->count; i++) {
// 检查存储的字符串中是否有与符号字符串匹配
// 如果匹配则返回值的副本
if (strcmp(e->syms[i], k->sym) == 0) {
return MLval_copy(e->vals[i]);
}
}
// 没找到则返回错误
return MLval_err("Unbound Symbol '%s'", k->sym);
}
void MLenv_put(MLenv* e, MLval* k, MLval* v) { // 把值存到变量
// 遍历环境中的项
for (int i = 0; i < e->count; i++) {
// 找到遍历就删除该位置的项,用用户提供的项替换
if (strcmp(e->syms[i], k->sym) == 0) {
MLval_del(e->vals[i]);
e->vals[i] = MLval_copy(v);
return;
}
}
// 如果不存在则构造
e->count++;
e->vals = realloc(e->vals, sizeof(MLval*) * e->count);
e->syms = realloc(e->syms, sizeof(char*) * e->count);
e->vals[e->count - 1] = MLval_copy(v);
e->syms[e->count - 1] = malloc(strlen(k->sym) + 1);
strcpy(e->syms[e->count - 1], k->sym);
}
变量计算
我们的计算函数现在依赖于某些环境,应该将其作为参数传入,在遇到符号类型时使用它来获取值
MLval* MLval_eval(MLenv* e, MLval* v) { // 计算
if (v->type == MLVAL_SYM) {
MLval* x = MLenv_get(e, v);
MLval_del(v);
return x;
}
if (v->type == MLVAL_SEXPR) { return MLval_eval_sexpr(e, v); }
return v;
}
MLval* MLval_eval_sexpr(MLenv* e, MLval* v) {
for (int i = 0; i < v->count; i++) {
v->cell[i] = MLval_eval(e, v->cell[i]);
}
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type == MLVAL_ERR) { return MLval_take(v, i); }
}
if (v->count == 0) { return v; }
if (v->count == 1) { return MLval_take(v, 0); }
MLval* f = MLval_pop(v, 0);
if (f->type != MLVAL_FUN) {
MLval* err = MLval_err(
"S-Expression starts with incorrect type. "
"Got %s, Expected %s.",
ltype_name(f->type), ltype_name(MLVAL_FUN));
MLval_del(f); MLval_del(v);
return err;
}
MLval* result = f->fun(e, v);
MLval_del(f);
return result;
}
内置函数
因为我们的内置函数并不大符合定义的函数指针,而且不在环境中,因此我们需要进行重新构建
MLval* builtin_add(MLenv* e, MLval* a) {
return builtin_op(e, a, "+");
}
MLval* builtin_sub(MLenv* e, MLval* a) {
return builtin_op(e, a, "-");
}
MLval* builtin_mul(MLenv* e, MLval* a) {
return builtin_op(e, a, "*");
}
MLval* builtin_div(MLenv* e, MLval* a) {
return builtin_op(e, a, "/");
}
MLval* builtin_mod(MLenv* e, MLval* a) {
return builtin_op(e, a, "%");
}
MLval* builtin_max(MLenv* e, MLval* a) {
return builtin_op(e, a, "max");
}
MLval* builtin_min(MLenv* e, MLval* a) {
return builtin_op(e, a, "min");
}
MLval* builtin_pow(MLenv* e, MLval* a){
return builtin_op(e, a, "^");
}
对于每一个内置函数,我们需要一个函数,将所有内置函数添加到环境里
void MLenv_add_builtin(MLenv* e, char* name, MLbuiltin func) {
MLval* k = MLval_sym(name);
MLval* v = MLval_fun(func);
MLenv_put(e, k, v);
MLval_del(k); MLval_del(v);
}
void MLenv_add_builtins(MLenv* e) {
// 函数
MLenv_add_builtin(e, "def", builtin_def);
// MLenv_add_builtin(e, "print", builtin_print);
MLenv_add_builtin(e, "quit", builtin_quit);
// Q表达式操作
MLenv_add_builtin(e, "list", builtin_list);
MLenv_add_builtin(e, "head", builtin_head);
MLenv_add_builtin(e, "tail", builtin_tail);
MLenv_add_builtin(e, "eval", builtin_eval);
MLenv_add_builtin(e, "join", builtin_join);
MLenv_add_builtin(e, "len", builtin_len);
MLenv_add_builtin(e, "init", builtin_init);
MLenv_add_builtin(e, "cons", builtin_cons);
// 数学操作
MLenv_add_builtin(e, "+", builtin_add);
MLenv_add_builtin(e, "-", builtin_sub);
MLenv_add_builtin(e, "*", builtin_mul);
MLenv_add_builtin(e, "/", builtin_div);
MLenv_add_builtin(e, "add", builtin_add);
MLenv_add_builtin(e, "sub", builtin_sub);
MLenv_add_builtin(e, "mul", builtin_mul);
MLenv_add_builtin(e, "div", builtin_div);
MLenv_add_builtin(e, "%", builtin_mod);
MLenv_add_builtin(e, "mod", builtin_mod);
MLenv_add_builtin(e, "^", builtin_pow);
MLenv_add_builtin(e, "min", builtin_min);
MLenv_add_builtin(e, "max", builtin_max);
}
最后我们需要在允许时调用这些函数创建环境,在完成后删除环境
MLenv* e = MLenv_new();
MLenv_add_builtins(e);
while (1) {
char* input = readline("MyLisp> ");
add_history(input);
mpc_result_t r;
if (mpc_parse("<stdin>", input, MyLisp, &r)) {
MLval* x = MLval_eval(e, MLval_read(r.output));
MLval_println(x);
MLval_del(x);
mpc_ast_delete(r.output);
}
else {
mpc_err_print(r.error);
mpc_err_delete(r.error);
}
free(input);
}
MLenv_del(e);
mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, MyLisp);
定义函数
我们已经将自己的内置函数作为变量存在环境中了,但是用户仍然无法自行定义
直接传递符号不计算的方法就是将其放在大括号内,他将把一个符号列表和许多其他值作为输入,然后将值分配给每一个符号
这个函数需要和其他内置函数一样,首先检查错误,见擦汗参数是否正确,遍历每个符号和值,将其放入环境,如果错误则直接报错,如果正确就返回空表达式
MLval* builtin_def(MLenv* e, MLval* a) { // 定义
MLASSERT_TYPE("def", a, 0, MLVAL_QEXPR);
// 第一个元素一定是符号
MLval* syms = a->cell[0];
// 确保列表中的每一个表达式的第一个都是符号
for (int i = 0; i < syms->count; i++) {
MLASSERT(a, (syms->cell[i]->type == MLVAL_SYM),
"Function 'def' cannot define non-symbol. "
"Got %s, Expected %s.",
ltype_name(syms->cell[i]->type), ltype_name(MLVAL_SYM));
}
// 检查其他的数字和表达式是否正确
MLASSERT(a, (syms->count == a->count - 1),
"Function 'def' passed too many arguments for symbols. "
"Got %i, Expected %i.",
syms->count, a->count - 1);
// 放入环境变量
for (int i = 0; i < syms->count; i++) {
MLenv_put(e, syms->cell[i], a->cell[i + 1]);
}
MLval_del(a);
return MLval_sexpr();
}
v0.4.2
#define _CRT_SECURE_NO_WARNINGS 1
#include "mpc.h"
#include<stdio.h>
#include<stdlib.h>
#include<string.h>
#include<math.h>
#include<assert.h>
void PrintPrompt()
{
printf("MyLisp Version 0.4.1\n");
printf("By jasmine-leaf\n");
printf("Press \"quit 0\" to Exit\n\n\n");
}
// v0.0.1
// 实现了用户输入和读取功能
// v0.0.2
// 增加了波兰表达式的解析功能
// v0.1.0
// 增加了波兰表达式的求值功能
// 增加了min、max、乘方运算
// v0.1.1
// 增加了运算报错
// v0.2.0
// 增加了S表达式
// v0.2.1
// 修复了mpca_lang内存泄漏的bug
// v0.3.0
// 增加了Q表达式
// v0.3.1
// 修复了大括号无法识别的bug
// v0.3.2
// 优化了解析器的书写与读取
// v0.4.0
// 增加了变量存储的功能
// v0.4.1
// 增加了退出功能
// v0.4.2
// 优化了错误提示信息
#define MLASSERT(args, cond, fmt, ...) \
if (!(cond)) { MLval* err = MLval_err(fmt, ##__VA_ARGS__); MLval_del(args); return err; }
#define MLASSERT_TYPE(func, args, index, expect) \
MLASSERT(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 MLASSERT_NUM(func, args, num) \
MLASSERT(args, args->count == num, \
"Function '%s' passed incorrect number of arguments. Got %i, Expected %i.", \
func, args->count, num)
#define MLASSERT_NOT_EMPTY(func, args, index) \
MLASSERT(args, args->cell[index]->count != 0, \
"Function '%s' passed {} for argument %i.", func, index);
// 处理异常
#define _MLASSERT(args, cond, err) \
if(!(cond)) { MLval_del(args); return MLval_err(err);}
// 检测错误的参数个数
#define _MLASSERT_NUM(func, args, expected_num, err) \
if ((args)->count != (expected_num)) { \
MLval_del(func); MLval_del(args); \
return MLval_err(err); \
}
// 检测空列表
#define _MLASSERT_NOT_EMPTY(func, args, err) \
if ((args)->count == 0) { \
MLval_del(func); MLval_del(args); \
return MLval_err(err); \
}
#ifdef _WIN32
// 为实现跨平台功能
// 在windows平台下定义实现editline和history的同名函数
#define INPUT_MAX 2048 // 缓冲区最大值
static char Buffer[INPUT_MAX]; // Buffer输入缓冲区
char* readline(char* prompt) // 模拟实现readline
{
fputs(prompt, stdout);
fgets(Buffer, INPUT_MAX, stdin);
char* tmp = malloc(strlen(Buffer) + 1);
if (tmp != NULL)
{
strcpy(tmp, Buffer);
tmp[strlen(tmp) - 1] = '\0';
}
return tmp;
}
void add_history(char* unused)
{}
#else
#ifdef __linux__ // 在linux平台下
#include<editline/readline.h>
#include<editline.history.h>
#endif
#ifdef __MACH__ // 在mac平台下
#include<editline/readline.h>
#endif
#endif
struct MLval;
struct MLenv;
typedef struct MLval MLval;
typedef struct MLenv MLenv;
enum {
MLVAL_ERR, // 表示错误
MLVAL_NUM, // 表示数字
MLVAL_SYM, // 表示符号
MLVAL_FUN, // 表示函数
MLVAL_SEXPR, // 表示S表达式
MLVAL_QEXPR // 表示Q表达式
};
typedef MLval* (*MLbuiltin)(MLenv*, MLval*);
struct MLval {
int type;
double num;
char* err;
char* sym;
MLbuiltin fun;
int count;
MLval** cell;
};
MLval* MLval_num(double x) { // 数字类型初始化
MLval* v = (MLval*)malloc(sizeof(MLval));
assert(v);
v->type = MLVAL_NUM;
v->num = x;
return v;
}
MLval* MLval_err(char* fmt, ...) { // 错误类型初始化
MLval* v = (MLval*)malloc(sizeof(MLval));
assert(v);
v->type = MLVAL_ERR;
// 创建一个va表,初始化
va_list va;
va_start(va, fmt);
// 分配空间
v->err = (char*)malloc(512);
assert(v->err);
// 打印错误字符串
vsnprintf(v->err, 511, fmt, va);
// 重分配内存
v->err = realloc(v->err, strlen(v->err) + 1);
// 清理va表
va_end(va);
return v;
}
MLval* MLval_sym(char* s) { // 符号类型初始化
MLval* v = (MLval*)malloc(sizeof(MLval));
assert(v);
v->type = MLVAL_SYM;
v->sym = (char*)malloc(strlen(s) + 1);
assert(v->sym);
strcpy(v->sym, s);
return v;
}
MLval* MLval_fun(MLbuiltin func) { // 函数类型初始化
MLval* v = (MLval*)malloc(sizeof(MLval));
assert(v);
v->type = MLVAL_FUN;
v->fun = func;
return v;
}
MLval* MLval_sexpr() { // S表达式初始化
MLval* v = (MLval*)malloc(sizeof(MLval));
assert(v);
v->type = MLVAL_SEXPR;
v->count = 0;
v->cell = NULL;
return v;
}
MLval* MLval_qexpr() { // Q表达式初始化
MLval* v = (MLval*)malloc(sizeof(MLval));
assert(v);
v->type = MLVAL_QEXPR;
v->count = 0;
v->cell = NULL;
return v;
}
void MLval_del(MLval* v) { // 析构函数
switch (v->type) {
case MLVAL_NUM: break;
case MLVAL_FUN: break;
case MLVAL_ERR: free(v->err); break;
case MLVAL_SYM: free(v->sym); break;
case MLVAL_QEXPR:
case MLVAL_SEXPR:
for (int i = 0; i < v->count; i++) {
MLval_del(v->cell[i]);
}
free(v->cell);
break;
default:
assert(0);
break;
}
free(v);
}
MLval* MLval_copy(MLval* v) { // 复制
MLval* x = (MLval*)malloc(sizeof(MLval));
assert(x);
x->type = v->type;
switch (v->type) {
// 数字和函数直接复制
case MLVAL_FUN: x->fun = v->fun; break;
case MLVAL_NUM: x->num = v->num; break;
// 字符串需要重新分配空间
case MLVAL_ERR:
x->err = (char*)malloc(strlen(v->err) + 1);
assert(x->err);
strcpy(x->err, v->err); break;
case MLVAL_SYM:
x->sym = (char*)malloc(strlen(v->sym) + 1);
assert(x->err);
strcpy(x->sym, v->sym); break;
// 表达式需要循环递归
case MLVAL_SEXPR:
case MLVAL_QEXPR:
x->count = v->count;
x->cell = (MLval**)malloc(sizeof(MLval*) * x->count);
assert(x->cell);
for (int i = 0; i < x->count; i++) {
x->cell[i] = MLval_copy(v->cell[i]);
}
break;
}
return x;
}
MLval* MLval_add(MLval* v, MLval* x) { // 向列表添加元素
v->count++;
v->cell = realloc(v->cell, sizeof(MLval*) * v->count);
v->cell[v->count - 1] = x;
return v;
}
MLval* MLval_join(MLval* x, MLval* y) { // 合并列表
for (int i = 0; i < y->count; i++) {
x = MLval_add(x, y->cell[i]);
}
free(y->cell);
free(y);
return x;
}
MLval* MLval_pop(MLval* v, int i) { // 列表删除元素
MLval* x = v->cell[i];
memmove(&v->cell[i], &v->cell[i + 1],
sizeof(MLval*) * (v->count - i - 1));
v->count--;
v->cell = realloc(v->cell, sizeof(MLval*) * v->count);
return x;
}
MLval* MLval_take(MLval* v, int i) { // 取出元素
MLval* x = MLval_pop(v, i);
MLval_del(v);
return x;
}
void MLval_print(MLval* v);
void MLval_print_expr(MLval* v, char open, char close) { // 打印表达式
putchar(open);
for (int i = 0; i < v->count; i++) {
MLval_print(v->cell[i]);
if (i != (v->count - 1)) {
putchar(' ');
}
}
putchar(close);
}
void MLval_print(MLval* v) {
switch (v->type) {
case MLVAL_FUN: printf("<buildin function>"); break;
case MLVAL_NUM: printf("%g", v->num); break;
case MLVAL_ERR: printf("Error: %s", v->err); break;
case MLVAL_SYM: printf("%s", v->sym); break;
case MLVAL_SEXPR: MLval_print_expr(v, '(', ')'); break;
case MLVAL_QEXPR: MLval_print_expr(v, '{', '}'); break;
default:
assert(0);
break;
}
}
void MLval_println(MLval* v) { MLval_print(v); putchar('\n'); }
char* ltype_name(int t) {
switch (t) {
case MLVAL_FUN: return "Function";
case MLVAL_NUM: return "Number";
case MLVAL_ERR: return "Error";
case MLVAL_SYM: return "Symbol";
case MLVAL_SEXPR: return "S-Expression";
case MLVAL_QEXPR: return "Q-Expression";
default: return "Unknown";
}
}
struct MLenv {
int count;
char** syms; // 符号列表
MLval** vals; // 参数列表
};
MLenv* MLenv_new() { // 初始化
MLenv* e = (MLenv*)malloc(sizeof(MLenv));
assert(e);
e->count = 0;
e->syms = NULL;
e->vals = NULL;
return e;
}
void MLenv_del(MLenv* e) { // 析构函数
for (int i = 0; i < e->count; i++) {
free(e->syms[i]);
MLval_del(e->vals[i]);
}
free(e->syms);
free(e->vals);
free(e);
}
MLval* MLenv_get(MLenv* e, MLval* k) { // 从环境中取值
// 遍历所有项
for (int i = 0; i < e->count; i++) {
// 检查存储的字符串中是否有与符号字符串匹配
// 如果匹配则返回值的副本
if (strcmp(e->syms[i], k->sym) == 0) {
return MLval_copy(e->vals[i]);
}
}
// 没找到则返回错误
return MLval_err("Unbound Symbol '%s'", k->sym);
}
void MLenv_put(MLenv* e, MLval* k, MLval* v) { // 把值存到变量
// 遍历环境中的项
for (int i = 0; i < e->count; i++) {
// 找到遍历就删除该位置的项,用用户提供的项替换
if (strcmp(e->syms[i], k->sym) == 0) {
MLval_del(e->vals[i]);
e->vals[i] = MLval_copy(v);
return;
}
}
// 如果不存在则构造
e->count++;
e->vals = realloc(e->vals, sizeof(MLval*) * e->count);
e->syms = realloc(e->syms, sizeof(char*) * e->count);
e->vals[e->count - 1] = MLval_copy(v);
e->syms[e->count - 1] = malloc(strlen(k->sym) + 1);
strcpy(e->syms[e->count - 1], k->sym);
}
MLval* MLval_eval(MLenv* e, MLval* v);
MLval* builtin_list(MLenv* e, MLval* a) {
a->type = MLVAL_QEXPR;
return a;
}
MLval* builtin_head(MLenv* e, MLval* a) {
MLASSERT_NUM("head", a, 1);
MLASSERT_TYPE("head", a, 0, MLVAL_QEXPR);
MLASSERT_NOT_EMPTY("head", a, 0);
MLval* v = MLval_take(a, 0);
while (v->count > 1) { MLval_del(MLval_pop(v, 1)); }
return v;
}
MLval* builtin_tail(MLenv* e, MLval* a) {
MLASSERT_NUM("tail", a, 1);
MLASSERT_TYPE("tail", a, 0, MLVAL_QEXPR);
MLASSERT_NOT_EMPTY("tail", a, 0);
MLval* v = MLval_take(a, 0);
MLval_del(MLval_pop(v, 0));
return v;
}
MLval* builtin_eval(MLenv* e, MLval* a) {
MLASSERT_NUM("eval", a, 1);
MLASSERT_TYPE("eval", a, 0, MLVAL_QEXPR);
MLval* x = MLval_take(a, 0);
x->type = MLVAL_SEXPR;
return MLval_eval(e, x);
}
MLval* builtin_join(MLenv* e, MLval* a) {
for (int i = 0; i < a->count; i++) {
MLASSERT_TYPE("join", a, i, MLVAL_QEXPR);
}
MLval* x = MLval_pop(a, 0);
while (a->count) {
MLval* y = MLval_pop(a, 0);
x = MLval_join(x, y);
}
MLval_del(a);
return x;
}
MLval* builtin_len(MLenv* e, MLval* a) { // 求Q表达式中的元素个数
_MLASSERT_NUM(a, a, 1, "Function 'len' takes exactly one argument.");
_MLASSERT(a, a->cell[0]->type == MLVAL_QEXPR, "Function 'len' passed incorrect type.");
MLval* v = MLval_num(a->cell[0]->count);
assert(v);
MLval_del(a);
return v;
}
// 将一个值添加到Q表达式的首位
MLval* builtin_cons(MLenv* e, MLval* a) {
// 检查参数数量是否正确
_MLASSERT_NUM(a, a, 2, "Function 'cons' takes exactly two arguments.");
// 第一个参数必须是数字或符号
_MLASSERT(a, (a->cell[0]->type == MLVAL_NUM || a->cell[0]->type == MLVAL_SYM),
"Function 'cons' takes a number or symbol as its first argument.");
// 第二个参数必须是Q表达式
_MLASSERT(a, a->cell[1]->type == MLVAL_QEXPR, "Function 'cons' takes a Q-expression as its second argument.");
// 创建一个新的 Q-表达式
MLval* qexpr = MLval_qexpr();
// 将第一个参数添加到 Q-表达式的首位
qexpr = MLval_add(qexpr, MLval_copy(a->cell[0]));
// 将 Q-表达式中的其他元素添加到新的 Q-表达式中
for (int i = 0; i < a->cell[1]->count; i++) {
qexpr = MLval_add(qexpr, MLval_copy(a->cell[1]->cell[i]));
}
// 释放原始参数
MLval_del(a);
return qexpr;
}
// 返回出最后一个元素以外的其他元素
MLval* builtin_init(MLenv* e, MLval* a) {
_MLASSERT_NUM(a, a, 1, "Function 'init' takes exactly one argument.");
_MLASSERT_NOT_EMPTY(a, a->cell[0], "Function 'init' passed {}.");
MLval* v = MLval_qexpr();
for (int i = 0; i < a->cell[0]->count - 1; i++) {
v = MLval_add(v, MLval_copy(a->cell[0]->cell[i]));
}
MLval_del(a);
return v;
}
MLval* builtin_op(MLenv* e, MLval* a, char* op) {
// 确保操作对象的类型
for (int i = 0; i < a->count; i++) {
MLASSERT_TYPE(op, a, i, MLVAL_NUM);
}
// 得到第一个操作数
MLval* x = MLval_pop(a, 0);
// 如果只有一个符号则为负数
if ((strcmp(op, "-") == 0) && a->count == 0) {
x->num = -x->num;
}
while (a->count > 0) {
MLval* y = MLval_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) {
MLval_del(x); MLval_del(y);
x = MLval_err("Division By Zero.");
break;
}
x->num /= y->num;
}
if (strcmp(op, "%") == 0){
if (y->num == 0){
MLval_del(x);
MLval_del(y);
x = MLval_err("Division By Zero.");
break;
}
x->num = fmod(x->num, y->num);
}
if (strcmp(op, "^") == 0) { x->num = pow(x->num, y->num); }
if (strcmp(op, "min") == 0) { x->num = (x->num < y->num) ? x->num : y->num; }
if (strcmp(op, "max") == 0) { x->num = (x->num > y->num) ? x->num : y->num; }
MLval_del(y);
}
MLval_del(a);
return x;
}
MLval* builtin_add(MLenv* e, MLval* a) {
return builtin_op(e, a, "+");
}
MLval* builtin_sub(MLenv* e, MLval* a) {
return builtin_op(e, a, "-");
}
MLval* builtin_mul(MLenv* e, MLval* a) {
return builtin_op(e, a, "*");
}
MLval* builtin_div(MLenv* e, MLval* a) {
return builtin_op(e, a, "/");
}
MLval* builtin_mod(MLenv* e, MLval* a) {
return builtin_op(e, a, "%");
}
MLval* builtin_max(MLenv* e, MLval* a) {
return builtin_op(e, a, "max");
}
MLval* builtin_min(MLenv* e, MLval* a) {
return builtin_op(e, a, "min");
}
MLval* builtin_pow(MLenv* e, MLval* a){
return builtin_op(e, a, "^");
}
MLval* builtin_quit(MLenv* e, MLval* a) {
printf("Exiting MyLisp ...");
exit(0);
return MLval_sexpr();
}
//MLval* builtin_print(MLenv* e, MLval* a) {
// // 打印参数
// for (int i = 0; i < a->count; i++) {
// MLval_print(a->cell[i]);
// if (i != a->count - 1) {
// printf(" "); // 打印参数之间的空格
// }
// }
// printf("\n"); // 打印换行符
// MLval_del(a); // 释放参数列表
// return MLval_sexpr(); // 返回一个空的 S 表达式
//}
MLval* builtin_def(MLenv* e, MLval* a) { // 定义
MLASSERT_TYPE("def", a, 0, MLVAL_QEXPR);
// 第一个元素一定是符号
MLval* syms = a->cell[0];
// 确保列表中的每一个表达式的第一个都是符号
for (int i = 0; i < syms->count; i++) {
MLASSERT(a, (syms->cell[i]->type == MLVAL_SYM),
"Function 'def' cannot define non-symbol. "
"Got %s, Expected %s.",
ltype_name(syms->cell[i]->type), ltype_name(MLVAL_SYM));
}
// 检查其他的数字和表达式是否正确
MLASSERT(a, (syms->count == a->count - 1),
"Function 'def' passed too many arguments for symbols. "
"Got %i, Expected %i.",
syms->count, a->count - 1);
// 将值赋到符号中
for (int i = 0; i < syms->count; i++) {
MLenv_put(e, syms->cell[i], a->cell[i + 1]);
}
MLval_del(a);
return MLval_sexpr();
}
void MLenv_add_builtin(MLenv* e, char* name, MLbuiltin func) {
MLval* k = MLval_sym(name);
MLval* v = MLval_fun(func);
MLenv_put(e, k, v);
MLval_del(k); MLval_del(v);
}
void MLenv_add_builtins(MLenv* e) {
// 函数
MLenv_add_builtin(e, "def", builtin_def);
// 变量打印
// MLenv_add_builtin(e, "print", builtin_print);
MLenv_add_builtin(e, "quit", builtin_quit);
// Q表达式操作
MLenv_add_builtin(e, "list", builtin_list);
MLenv_add_builtin(e, "head", builtin_head);
MLenv_add_builtin(e, "tail", builtin_tail);
MLenv_add_builtin(e, "eval", builtin_eval);
MLenv_add_builtin(e, "join", builtin_join);
MLenv_add_builtin(e, "len", builtin_len);
MLenv_add_builtin(e, "init", builtin_init);
MLenv_add_builtin(e, "cons", builtin_cons);
// 数学操作
MLenv_add_builtin(e, "+", builtin_add);
MLenv_add_builtin(e, "-", builtin_sub);
MLenv_add_builtin(e, "*", builtin_mul);
MLenv_add_builtin(e, "/", builtin_div);
MLenv_add_builtin(e, "add", builtin_add);
MLenv_add_builtin(e, "sub", builtin_sub);
MLenv_add_builtin(e, "mul", builtin_mul);
MLenv_add_builtin(e, "div", builtin_div);
MLenv_add_builtin(e, "%", builtin_mod);
MLenv_add_builtin(e, "mod", builtin_mod);
MLenv_add_builtin(e, "^", builtin_pow);
MLenv_add_builtin(e, "min", builtin_min);
MLenv_add_builtin(e, "max", builtin_max);
}
MLval* MLval_eval_sexpr(MLenv* e, MLval* v) {
for (int i = 0; i < v->count; i++) {
v->cell[i] = MLval_eval(e, v->cell[i]);
}
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type == MLVAL_ERR) { return MLval_take(v, i); }
}
if (v->count == 0) { return v; }
if (v->count == 1) { return MLval_take(v, 0); }
MLval* f = MLval_pop(v, 0);
if (f->type != MLVAL_FUN) {
MLval* err = MLval_err(
"S-Expression starts with incorrect type. "
"Got %s, Expected %s.",
ltype_name(f->type), ltype_name(MLVAL_FUN));
MLval_del(f); MLval_del(v);
return err;
}
MLval* result = f->fun(e, v);
MLval_del(f);
return result;
}
MLval* MLval_eval(MLenv* e, MLval* v) { // 计算
if (v->type == MLVAL_SYM) {
MLval* x = MLenv_get(e, v);
MLval_del(v);
return x;
}
if (v->type == MLVAL_SEXPR) { return MLval_eval_sexpr(e, v); }
return v;
}
MLval* MLval_read_num(mpc_ast_t* t) { // 读取
errno = 0;
double x = strtod(t->contents, NULL);
return errno != ERANGE ? MLval_num(x) : MLval_err("Invalid Number.");
}
MLval* MLval_read(mpc_ast_t* t) {
if (strstr(t->tag, "number")) { return MLval_read_num(t); }
if (strstr(t->tag, "symbol")) { return MLval_sym(t->contents); }
MLval* x = NULL;
if (strcmp(t->tag, ">") == 0) { x = MLval_sexpr(); }
if (strstr(t->tag, "sexpr")) { x = MLval_sexpr(); }
if (strstr(t->tag, "qexpr")) { x = MLval_qexpr(); }
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 = MLval_add(x, MLval_read(t->children[i]));
}
return x;
}
void Lisp() {
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* MyLisp = mpc_new("mylisp");
mpca_lang(MPCA_LANG_DEFAULT,
" \
number : /-?[0-9]+(\\.[0-9]*)?/ ; \
symbol : '+' | '-' | '*' | '/' | '%' | '^' \
| \"list\" | \"head\" | \"tail\"|\"quit\" \
| \"eval\" | \"join\" | \"add\" |\"print\"\
| \"sub\" | \"mul\" | \"div\" | \"min\" \
| \"max\" | \"mod\" | \"len\" | \"cons\" \
| \"init\"| /[a-zA-Z0-9_+\\-*\\/\\\\=<>!&]+/;\
sexpr : '(' <expr>* ')' ; \
qexpr : '{' <expr>* '}' ; \
expr : <number> | <symbol> | <sexpr> | <qexpr> ; \
mylisp : /^/ <expr>* /$/ ; \
",
Number, Symbol, Sexpr, Qexpr, Expr, MyLisp);
PrintPrompt();
MLenv* e = MLenv_new();
MLenv_add_builtins(e);
while (1) {
char* input = readline("MyLisp> ");
add_history(input);
mpc_result_t r;
if (mpc_parse("<stdin>", input, MyLisp, &r)) {
MLval* x = MLval_eval(e, MLval_read(r.output));
MLval_println(x);
MLval_del(x);
mpc_ast_delete(r.output);
}
else {
mpc_err_print(r.error);
mpc_err_delete(r.error);
}
free(input);
}
MLenv_del(e);
mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, MyLisp);
}
int main() {
Lisp();
return 0;
}