天津营销网站建设公司哪家好,用ps设计网页页面,品牌网站建设解决,建设网站的五个步骤文章目录 函数函数类型Lambda函数运行环境函数调用可变参数优化函数定义方式柯里化 函数
我们想让用户可以定义自己的函数#xff0c;而不仅仅是使用我们提供的内建函数
那我们要提供这样的功能就要首先就得提供一个内置函数#xff0c;可以使用户通过这个函数创建自定义的… 文章目录 函数函数类型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);
}函数调用
我们需要在创建完函数后能够使之正确调用
这时就分两种情况第一种是内置函数我们仍然使用之前的函数指针直接调用
另一种就是用户函数了我们需要把每个参数都绑定到形参中然后计算函数主体将父环境设置为调用环境
但是当提供的参数数量和形参的数量不对应时就不能正常工作了当提供的参数小于形参个数时我们可以优先绑定先前的几个形式参数然后返回其余参数不绑定当形参数量大于提供参数的个数时报出错误
还需要更新计算表达式的函数让他支持调用函数的计算
可变参数
我们有一些内建函数是支持可变参数的例如addjoin我们需要让用户也支持这种操作
但是我们没办法让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.hvoid 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平台下
#includeeditline/readline.h
#includeeditline.history.h
#endif#ifdef __MACH__ // 在mac平台下
#includeeditline/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;
}
