文章目录
- 函数
- 函数类型
- Lambda函数
- 运行环境
- 函数调用
- 可变参数
- 优化函数定义方式
- 柯里化
函数
我们想让用户可以定义自己的函数,而不仅仅是使用我们提供的内建函数
那我们要提供这样的功能就要首先就得提供一个内置函数,可以使用户通过这个函数创建自定义的函数
他使用起来有两个参数,第一个是形参列表,也就是要使用的参数,第二个参数是另一个列表,也就是函数的具体内容,运行函数时,我们调用对应函数进行处理即可
我们使用\
来表示定义函数
例如
\ {x y} {+ x y}
然后可以将其作为普通的S表达式使用,也就是计算的符号
(\ {x y} {+ x y}) 10 20
如果我们想命名这个函数,只需要使用def给他起个名字,这样就能使用名字直接调用了
def {add-together} (\ {x y} {+ x y})add-together 10 20
函数类型
我们要将函数存储为一种MLval
的值,就需要考虑他的组成部分
根据刚刚功能的描述,可以基本确定如下内容:
- 函数有三个部分构成
- 第一个是形参列表,并且需要绑定参数和值才能计算出值
- 第二个是Q表达式,用来表示函数的主体部分
- 第三个是,用来存储分配给形式参数的空间,这里我们直接可以使用环境存储即可
我们把内置函数和用户定义的函数都放在MLVAL_FUN
中,就需要使用一个方法判断是否为内置函数,如果builtin
是NULL
,就说明不是内置函数
struct MLval {int type;// 基础内容double num;char* err;char* sym;// 函数内容MLbuiltin builtin;MLenv* env;MLval* formals; // 形式参数MLval* body;// 表达式内容int count;MLval** cell;
};
我们还需要为用户定义的MLval
的函数创建构造函数同时构造一个新的环境,把形参和函数主体都传入
// 外部函数初始化
MLval* MLval_lambda(MLval* formals, MLval* body) {MLval* v = malloc(sizeof(MLval));v->type = MLVAL_FUN;// 设置内建指向空v->builtin = NULL;// 新建函数v->env = MLenv_new();// 设置形式参数和函数主体v->formals = formals;v->body = body;return v;
}
因为我们对MLval
的内部结构进行更改了,所以与之对应的删除,复制,打印都需要更改,具体更改内容见最后的汇总
Lambda函数
这里的Lambda函数简单理解就可以认为是用户编写的函数,他的本意是一系列符号的联系
我们需要根据用户的要求构建函数,第一步应该是检查用户输入的格式是否正确,然后取出对应的内容,传递给之前的构造函数即可
MLval* builtin_lambda(MLenv* e, MLval* a) {// 检查两个参数,每个都是Q表达式MLASSERT_NUM("\\", a, 2);MLASSERT_TYPE("\\", a, 0, MLVAL_QEXPR);MLASSERT_TYPE("\\", a, 1, MLVAL_QEXPR);// 检查第一个Q表达式只包含符号for (int i = 0; i < a->cell[0]->count; i++) {MLASSERT(a, (a->cell[0]->cell[i]->type == MLVAL_SYM),"Cannot define non-symbol. Got %s, Expected %s.",ltype_name(a->cell[0]->cell[i]->type), ltype_name(MLVAL_SYM));}// pop前两个参数的首位(formals body),传递给lambda(构建外部函数)MLval* formals = MLval_pop(a, 0);MLval* body = MLval_pop(a, 0);MLval_del(a);return MLval_lambda(formals, body);
}
然后我们这里需要把这个函数放到集中调用的函数中去,这里也不过多赘述
运行环境
我们为函数提供了他们自身的环境,并在这个环境中为形参设置相对应的值,当我们计算函数时,就可以直接在这个环境中运行,并且可以保证这些变量的值一定是正确的
在这里不要忽视,函数是可以访问全局环境中的变量的,例如其他的内置函数,因此我们可以通过更改环境的定义来包含对一些父环境的引用来解决这个问题,这样就能访问全局环境中的变量了
我们在环境的定义中增加一项MLenv* par
来指向父环境,当我们从环境中取变量时,如果找不到,就迭代指向父环境,查看父环境中是否存在目标变量,一直到是根的父环境
如下
struct MLenv {MLenv* par; // 父环境int count;char** syms; // 符号列表MLval** vals; // 参数列表
};// 环境初始化
MLenv* MLenv_new() {MLenv* e = malloc(sizeof(MLenv));e->par = NULL;e->count = 0;e->syms = NULL;e->vals = NULL;return 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]);}}// 如果没有找到则检查父环境中是否匹配,否则返回报错if (e->par) {return MLenv_get(e->par, k);} else {return MLval_err("Unbound Symbol '%s'", k->sym);}
}// 复制环境
MLenv* MLenv_copy(MLenv* e) {MLenv* n = malloc(sizeof(MLenv));n->par = e->par;n->count = e->count;n->syms = malloc(sizeof(char*) * n->count);n->vals = malloc(sizeof(MLval*) * n->count);for (int i = 0; i < e->count; i++) {n->syms[i] = malloc(strlen(e->syms[i]) + 1);strcpy(n->syms[i], e->syms[i]);n->vals[i] = MLval_copy(e->vals[i]);}return n;
}
因为有了父环境和子环境的概念,那么定义变量时就要区分是在父环境中定义还是在子环境中定义,我们提供两个方法,def表示在全局环境中定义,put表示在当前环境中定义
// 把值存到当前变量
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);
}// 在全局中存储变量
void MLenv_def(MLenv* e, MLval* k, MLval* v) {// 迭代到最大的父环境(根节点)while (e->par) {e = e->par;}// 添加到环境中MLenv_put(e, k, v);
}
函数调用
我们需要在创建完函数后,能够使之正确调用
这时就分两种情况,第一种是内置函数,我们仍然使用之前的函数指针直接调用
另一种就是用户函数了,我们需要把每个参数都绑定到形参中,然后计算函数主体,将父环境设置为调用环境
但是当提供的参数数量和形参的数量不对应时,就不能正常工作了,当提供的参数小于形参个数时,我们可以优先绑定先前的几个形式参数,然后返回,其余参数不绑定,当形参数量大于提供参数的个数时,报出错误
还需要更新计算表达式的函数,让他支持调用函数的计算
可变参数
我们有一些内建函数是支持可变参数的,例如add,join,我们需要让用户也支持这种操作
但是我们没办法让C语言原生支持这种操作,只能添加一些特定的语法,将其硬编码到我们的语言中
我们规定&
符号,让其使用类似{x & xs}
的形式参数,意思是表示这个函数的参数列表首先会接收一个参数x,然后是零个或多个其他参数,我们会将这些参数连在一起形成一个xs
列表
在我们的函数处理中,分配形参时,会特别寻找和处理&
符号,如果存在,则采用下一个形参并且分配给他我们剩余的参数
除此之外,我们需要检查&
之后的形参是否有效,无效就应该报错,还需要将参数列表转换为Q表达式
如果用户在调用函数时不提供任何额外参数,只提供第一个有名的参数,那么后面那个参数列表就应该是空列表
最终如下
// 调用函数
MLval* MLval_call(MLenv* e, MLval* f, MLval* a) {// 内建函数直接调用if (f->builtin) {return f->builtin(e, a);}// 记录参数数量int given = a->count;int total = f->formals->count;// 当有参数还需要处理时while (a->count) {// 参数传递过多if (f->formals->count == 0) {MLval_del(a);return MLval_err("Function passed too many arguments. ""Got %i, Expected %i.", given, total);}// 取出形参的第一个符号MLval* sym = MLval_pop(f->formals, 0);// '&'特殊处理if (strcmp(sym->sym, "&") == 0) {// 确保'&'后跟有其他符号if (f->formals->count != 1) {MLval_del(a);return MLval_err("Function format invalid. ""Symbol '&' not followed by single symbol.");}// 下一个参数绑定到剩余的形参MLval* nsym = MLval_pop(f->formals, 0);MLenv_put(f->env, nsym, builtin_list(e, a));MLval_del(sym); MLval_del(nsym);break;}// 取出列表的下一个参数MLval* val = MLval_pop(a, 0);// 绑定一份拷贝到函数的环境中MLenv_put(f->env, sym, val);MLval_del(sym); MLval_del(val);}// 删除已经被绑定的参数列表MLval_del(a);// 如果形参列表中含有'&',将其绑定到空列表if (f->formals->count > 0 &&strcmp(f->formals->cell[0]->sym, "&") == 0) {// 检查并确保'&'没有背无效传递if (f->formals->count != 2) {return MLval_err("Function format invalid. ""Symbol '&' not followed by single symbol.");}// 取出并删除'&'符号MLval_del(MLval_pop(f->formals, 0));// 取出下一个符号并绑定到空列表MLval* sym = MLval_pop(f->formals, 0);MLval* val = MLval_qexpr();// 绑定到环境中MLenv_put(f->env, sym, val);MLval_del(sym); MLval_del(val);}// 如果所有的参数都被绑定,则开始计算if (f->formals->count == 0) {// 将父环境设置为计算环境f->env->par = e;// 计算并返回return builtin_eval(f->env,MLval_add(MLval_sexpr(), MLval_copy(f->body)));} else {// 否则返回函数的拷贝return MLval_copy(f);}
}
优化函数定义方式
直接使用Lambda定义函数蛮不错的,但是语法略显笨拙,需要涉及很多括号和符号,我们可以舱室用一些更简单的语法来编写一个定义函数的函数
从本质上来讲很简单,我们想要的是一个可以同时执行两个步骤的功能
首先第一步是他应该能创建一个函数,然后将其定义为名称,这一步我们直接用def就可以做到
第二步是我们需要人用户提供一个列表,就是args作为形式参数,body作为函数主体
lambda应该是这样的
\ {args body} {def (head args) (\ (tail args) body)}
然后用def定义一下
def {fun} (\ {args body} {def (head args) (\ (tail args) body)})
简单翻译一下是这样,结合下面的例子更容易理解,定义一个函数fun,他有两个参数,第一个是args,第二个是body,函数功能是这样的,从输入列表args中取出第一个元素,这个元素是新函数的名称,取出这个列表的剩余部分,作为参数和body一同构建一个新的函数,名字就是刚刚取出来的第一个参数
这样我们就可以使用fun直接定义函数了
像这样
fun {add-together x y} {+ x y}add-together 1 2
柯里化
虽然我们现在可以传递可变参数了,但是如果要传入一个参数列表,或者列表本身,就比较困难了
我们可以定义一个unpack
函数来做到这一点。它接受某个函数和某个列表作为输入,并将函数附加到列表前面,然后进行求值
fun {unpack f xs} {eval (join (list f) xs)}
同样的,我们可以有一个相反的过程,有一个接收列表作为为输入的函数,但希望使用可变参数来调用,直接打包即可
fun {pack f & xs} {f xs}
这个两个过程也被称之为柯里化与反柯里化
#define _CRT_SECURE_NO_WARNINGS 1
#include <assert.h>
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include "mpc.h"void PrintPrompt() {printf("MyLisp Version 0.5.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
// 优化了错误提示信息
// v0.5.0
// 增加了自定义函数的功能
// v0.5.1
// 优化了解析器的正则表达式#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;// MyLisp的值类型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 builtin;MLenv* env;MLval* formals; // 形式参数MLval* body;// 表达式内容int count;MLval** cell;
};// 数字类型初始化
MLval* MLval_num(double x) {MLval* v = malloc(sizeof(MLval));v->type = MLVAL_NUM;v->num = x;return v;
}// 错误类型初始化
MLval* MLval_err(char* fmt, ...) {MLval* v = malloc(sizeof(MLval));v->type = MLVAL_ERR;va_list va;va_start(va, fmt);v->err = malloc(512);vsnprintf(v->err, 511, fmt, va);v->err = realloc(v->err, strlen(v->err) + 1);va_end(va);return v;
}// 符号类型初始化
MLval* MLval_sym(char* s) {MLval* v = malloc(sizeof(MLval));v->type = MLVAL_SYM;v->sym = malloc(strlen(s) + 1);strcpy(v->sym, s);return v;
}// 内建函数类型初始化
MLval* MLval_builtin(MLbuiltin func) {MLval* v = malloc(sizeof(MLval));v->type = MLVAL_FUN;v->builtin = func;return v;
}// 新建环境
MLenv* MLenv_new();// 外部函数初始化
MLval* MLval_lambda(MLval* formals, MLval* body) {MLval* v = malloc(sizeof(MLval));v->type = MLVAL_FUN;// 设置内建指向空v->builtin = NULL;// 新建函数v->env = MLenv_new();// 设置形式参数和函数主体v->formals = formals;v->body = body;return v;
}// S表达式初始化
MLval* MLval_sexpr() {MLval* v = malloc(sizeof(MLval));v->type = MLVAL_SEXPR;v->count = 0;v->cell = NULL;return v;
}// Q表达式初始化
MLval* MLval_qexpr() {MLval* v = malloc(sizeof(MLval));v->type = MLVAL_QEXPR;v->count = 0;v->cell = NULL;return v;
}// 环境析构
void MLenv_del(MLenv* e);// 表达式析构
void MLval_del(MLval* v) {switch (v->type) {case MLVAL_NUM: break;case MLVAL_FUN:if (!v->builtin) {MLenv_del(v->env);MLval_del(v->formals);MLval_del(v->body);}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;}free(v);
}// 环境复制
MLenv* MLenv_copy(MLenv* e);// 表达式复制
MLval* MLval_copy(MLval* v) {MLval* x = malloc(sizeof(MLval));x->type = v->type;switch (v->type) {case MLVAL_FUN:// 区分内建函数和外部函数if (v->builtin) {x->builtin = v->builtin;} else {x->builtin = NULL;x->env = MLenv_copy(v->env);x->formals = MLval_copy(v->formals);x->body = MLval_copy(v->body);}break;case MLVAL_NUM: x->num = v->num; break;case MLVAL_ERR: x->err = malloc(strlen(v->err) + 1);strcpy(x->err, v->err);break;case MLVAL_SYM: x->sym = malloc(strlen(v->sym) + 1);strcpy(x->sym, v->sym);break;// 表达式循环递归case MLVAL_SEXPR:case MLVAL_QEXPR:x->count = v->count;x->cell = malloc(sizeof(MLval*) * x->count);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:if (v->builtin) {printf("<builtin>");} else {printf("(\\ "); MLval_print(v->formals);putchar(' '); MLval_print(v->body); putchar(')');}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;}
}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 {MLenv* par; // 父环境int count;char** syms; // 符号列表MLval** vals; // 参数列表
};// 环境初始化
MLenv* MLenv_new() {MLenv* e = malloc(sizeof(MLenv));e->par = NULL;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);
}// 复制环境
MLenv* MLenv_copy(MLenv* e) {MLenv* n = malloc(sizeof(MLenv));n->par = e->par;n->count = e->count;n->syms = malloc(sizeof(char*) * n->count);n->vals = malloc(sizeof(MLval*) * n->count);for (int i = 0; i < e->count; i++) {n->syms[i] = malloc(strlen(e->syms[i]) + 1);strcpy(n->syms[i], e->syms[i]);n->vals[i] = MLval_copy(e->vals[i]);}return n;
}// 从环境中取值
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]);}}// 如果没有找到则检查父环境中是否匹配,否则返回报错if (e->par) {return MLenv_get(e->par, k);} else {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);
}// 在全局中存储变量
void MLenv_def(MLenv* e, MLval* k, MLval* v) {// 迭代到最大的父环境(根节点)while (e->par) {e = e->par;}// 添加到环境中MLenv_put(e, k, v);
}/// 内建函数#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); \}MLval* MLval_eval(MLenv* e, MLval* v);MLval* builtin_lambda(MLenv* e, MLval* a) {// 检查两个参数,每个都是Q表达式MLASSERT_NUM("\\", a, 2);MLASSERT_TYPE("\\", a, 0, MLVAL_QEXPR);MLASSERT_TYPE("\\", a, 1, MLVAL_QEXPR);// 检查第一个Q表达式只包含符号for (int i = 0; i < a->cell[0]->count; i++) {MLASSERT(a, (a->cell[0]->cell[i]->type == MLVAL_SYM),"Cannot define non-symbol. Got %s, Expected %s.",ltype_name(a->cell[0]->cell[i]->type), ltype_name(MLVAL_SYM));}// pop前两个参数的首位(formals body),传递给lambda(构建外部函数)MLval* formals = MLval_pop(a, 0);MLval* body = MLval_pop(a, 0);MLval_del(a);return MLval_lambda(formals, body);
}// list函数,构建列表(Q表达式)
MLval* builtin_list(MLenv* e, MLval* a) {a->type = MLVAL_QEXPR;return a;
}// head函数
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;
}// tail函数
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;
}// eval函数
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);
}// join函数
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;
}// len函数
MLval* builtin_len(MLenv* e, MLval* a) {_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);MLval_del(a);return v;
}// cons函数
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.");_MLASSERT(a, a->cell[1]->type == MLVAL_QEXPR, "Function 'cons' takes a Q-expression as its second argument.");MLval* qexpr = MLval_qexpr();qexpr = MLval_add(qexpr, MLval_copy(a->cell[0]));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;
}// init函数
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) {srand((size_t)time(0));size_t r = rand() % 5;switch (r) {case 0:printf("Bye~\n");break;case 1:printf("Goodbye~\n");break;case 2:printf("Bye Bye~\n");break;case 3:printf("See You~\n");break;case 4:printf("Farewell~\n");break;default:assert(0);break;}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_var(MLenv* e, MLval* a, char* func) {MLASSERT_TYPE(func, 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 '%s' cannot define non-symbol. ""Got %s, Expected %s.", func,ltype_name(syms->cell[i]->type), ltype_name(MLVAL_SYM));}MLASSERT(a, (syms->count == a->count - 1),"Function '%s' passed too many arguments for symbols. ""Got %i, Expected %i.", func, syms->count, a->count - 1);for (int i = 0; i < syms->count; i++) {// def在全局定义// put在本地定义if (strcmp(func, "def") == 0) {MLenv_def(e, syms->cell[i], a->cell[i + 1]);}if (strcmp(func, "=") == 0) {MLenv_put(e, syms->cell[i], a->cell[i + 1]);}}MLval_del(a);return MLval_sexpr();
}MLval* builtin_def(MLenv* e, MLval* a) {return builtin_var(e, a, "def");
}MLval* builtin_put(MLenv* e, MLval* a) {return builtin_var(e, a, "=");
}void MLenv_add_builtin(MLenv* e, char* name, MLbuiltin func) {MLval* k = MLval_sym(name);MLval* v = MLval_builtin(func);MLenv_put(e, k, v);MLval_del(k); MLval_del(v);
}void MLenv_add_builtins(MLenv* e) {// 变量函数MLenv_add_builtin(e, "\\", builtin_lambda);MLenv_add_builtin(e, "def", builtin_def);MLenv_add_builtin(e, "=", builtin_put);// 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_call(MLenv* e, MLval* f, MLval* a) {// 内建函数直接调用if (f->builtin) {return f->builtin(e, a);}// 记录参数数量int given = a->count;int total = f->formals->count;// 当有参数还需要处理时while (a->count) {// 参数传递过多if (f->formals->count == 0) {MLval_del(a);return MLval_err("Function passed too many arguments. ""Got %i, Expected %i.", given, total);}// 取出形参的第一个符号MLval* sym = MLval_pop(f->formals, 0);// '&'特殊处理if (strcmp(sym->sym, "&") == 0) {// 确保'&'后跟有其他符号if (f->formals->count != 1) {MLval_del(a);return MLval_err("Function format invalid. ""Symbol '&' not followed by single symbol.");}// 下一个参数绑定到剩余的形参MLval* nsym = MLval_pop(f->formals, 0);MLenv_put(f->env, nsym, builtin_list(e, a));MLval_del(sym); MLval_del(nsym);break;}// 取出列表的下一个参数MLval* val = MLval_pop(a, 0);// 绑定一份拷贝到函数的环境中MLenv_put(f->env, sym, val);MLval_del(sym); MLval_del(val);}// 删除已经被绑定的参数列表MLval_del(a);// 如果形参列表中含有'&',将其绑定到空列表if (f->formals->count > 0 &&strcmp(f->formals->cell[0]->sym, "&") == 0) {// 检查并确保'&'没有背无效传递if (f->formals->count != 2) {return MLval_err("Function format invalid. ""Symbol '&' not followed by single symbol.");}// 取出并删除'&'符号MLval_del(MLval_pop(f->formals, 0));// 取出下一个符号并绑定到空列表MLval* sym = MLval_pop(f->formals, 0);MLval* val = MLval_qexpr();// 绑定到环境中MLenv_put(f->env, sym, val);MLval_del(sym); MLval_del(val);}// 如果所有的参数都被绑定,则开始计算if (f->formals->count == 0) {// 将父环境设置为计算环境f->env->par = e;// 计算并返回return builtin_eval(f->env,MLval_add(MLval_sexpr(), MLval_copy(f->body)));} else {// 否则返回函数的拷贝return MLval_copy(f);}
}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_eval(e, 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 = MLval_call(e, f, 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 : /[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(int argc, char** argv) {Lisp();return 0;
}