Q表达式
添加特性的一般步骤
从这以后我们可以发现,给这个编程语言添加某个特性都有一定的步骤
- 语法:定义新的语法规则
- 表示:添加新的数据类型
- 解析:添加新的函数,正确处理AST
- 语义:添加新的函数,用于求值和操作
Q表达式
这里我们会实现一个新的Lisp值类型,叫做Q表达式(Quoted Expression),与S表达式一样,也是Lisp表达式的一种,但他不受Lisp求值机制的作用
也就是说,当受到函数作用时,Q表达式不会被求值
因此我们可以使用Q表达式来存储和管理其他的Lisp值类型,例如数字,符号,S表达式
在添加Q表达式之后,我们需要定义一些操作来管理,类似于之前的数学操作,这些操作定义了Q表达式的具体行为
Q表达式与S表达式非常类似,不同的是Q表达式存在大括号内,S表达式存在小括号内
原生的Lisp并不支持Q表达式,他们通常使用宏来做到禁止表达式求值的功能。我们这里定义Q表达式来达到类似的效果
// 创建解析器
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\" \
| \"eval\" | \"join\" | \"add\" \
| \"sub\" | \"mul\" | \"div\" | \"min\" \
| \"max\" | \"mod\" | \"len\" | \"cons\" \
| \"init\" ; \
sexpr : '(' <expr>* ')' ; \
qexpr : '{' <expr>* '}' ; \
expr : <number> | <symbol> | <sexpr> | <qexpr> ; \
mylisp : /^/ <expr>* /$/ ; \
",
Number, Symbol, Sexpr, Qexpr, Expr, MyLisp);
mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, MyLisp);
读取Q表达式
在读取时,我们需要多定义一个Q表达式类型,为他编写构造函数,增加打印函数和析构函数,最后增加一下读取功能即可
// 数据类型
enum
{
MLVAL_ERR, // 表示错误
MLVAL_NUM, // 表示数字
MLVAL_SYM, // 表示符号
MLVAL_SEXPR, // 表示S表达式
MLVAL_QEXPR // 表示Q表达式
};
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;
}
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_print(MLval* v)
{
switch (v->type)
{
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_expr_print(v, '(', ')'); break;
case MLVAL_QEXPR: MLval_expr_print(v, '{', '}'); break;
default:
break;
}
}
void MLval_del(MLval* v) // 析构函数
{
switch (v->type)
{
case MLVAL_NUM: 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:
break;
}
free(v);
}
内建函数
我们已经可以读取Q表达式了,之后需要构建一些函数来操作Q表达式
这些表达式要用于操作列表类型,先定义一些简单的类型
- list 接收一个或多个参数,返回一个包含所有参数的Q表达式
- head 接收一个Q表达式,返回包含第一个元素的Q表达式
- tail 接收一个Q表达式,返回除第一个元素的Q表达式
- join 接收一个或多个Q表达式,将其合并成一个Q表达式
- eval 接收一个Q表达式,将其作为一个S表达式计算
- cons 接收一个值和一个Q表达式,将值添加到Q表达式的首位
- len 返回Q表达式的元素个数
- init 返回除最后一个元素以外的其他元素
首先需要在解析器里面添加相对应的符号标识,这里已经加进去了
Head和Tail
这里我们首先需要确保参数是否正确传递,例如Q表达式只能有一个,Q表达式的内容不能为空
为了简化代码,提高代码可读性,我们可以采用宏函数来定义
// 处理异常
#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* builtin_head(MLval* a)
{
MLASSERT_NUM(a, a, 1, "Function 'head' takes exactly one argument.");
MLASSERT_NOT_EMPTY(a, a->cell[0], "Function 'head' passed {}.");
MLval* v = MLval_take(a, 0);
while (v->count>1)
{
MLval_del(MLval_pop(v, 1));
}
return v;
}
MLval* builtin_tail(MLval* a)
{
MLASSERT_NUM(a, a, 1, "Function 'tail' takes exactly one argument.");
MLASSERT_NOT_EMPTY(a, a->cell[0], "Function 'tail' passed {}.");
MLval* v = MLval_take(a, 0);
MLval_del(MLval_pop(v, 0));
return v;
}
List和Eval
list与eval的功能刚好相反
list将s表达式转化为q表达式
eval将q表达式转化为s表达式并计算
MLval* builtin_list(MLval* a)
{
a->type = MLVAL_QEXPR;
return a;
}
MLval* builtin_eval(MLval* a)
{
MLASSERT_NUM(a, a, 1, "Function 'eval' takes exactly one argument.");
MLASSERT(a, a->cell[0]->type == MLVAL_QEXPR, "Function 'eval' passed incorrect type.");
MLval* x = MLval_take(a, 0);
x->type = MLVAL_SEXPR;
return MLval_eval(x);
}
join和cons
join是将多个表达式合并
cons是将一个值添加到Q表达式的首位
其实功能是类似的,我们都提供给用户
MLval* builtin_join(MLval* a)
{
for (int i = 0; i < a->count; i++)
{
MLASSERT(a, a->cell[i]->type == MLVAL_QEXPR, "Function 'join' passed incorrect type.");
}
MLval* x = MLval_pop(a, 0);
while (a->count)
{
x = MLval_join(x, MLval_pop(a, 0));
}
MLval_del(a);
return x;
}
// 将一个值添加到Q表达式的首位
MLval* builtin_cons(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*)MLval_copy(a->cell[0]));
// 将 Q-表达式中的其他元素添加到新的 Q-表达式中
for (int i = 0; i < a->cell[1]->count; i++)
{
qexpr = MLval_add(qexpr, (MLval*)MLval_copy(a->cell[1]->cell[i]));
}
// 释放原始参数
MLval_del(a);
return qexpr;
}
copy
这里为了添加方便,我们写了一个copy函数
MLval* MLval_copy(MLval* v) {
MLval* x = (MLval*)malloc(sizeof(MLval));
assert(x != NULL); // 检查内存分配是否成功
x->type = v->type;
switch (v->type) {
case MLVAL_NUM: x->num = v->num; break;
case MLVAL_ERR:
x->err = (char*)malloc(strlen(v->err) + 1);
assert(x->err != NULL); // 检查内存分配是否成功
strcpy(x->err, v->err);
break;
case MLVAL_SYM:
x->sym = (char*)malloc(strlen(v->sym) + 1);
assert(x->sym != NULL); // 检查内存分配是否成功
strcpy(x->sym, v->sym);
break;
case MLVAL_SEXPR:
case MLVAL_QEXPR:
x->count = v->count;
x->cell = (MLval**)malloc(sizeof(MLval*) * v->count);
assert(x->cell != NULL); // 检查内存分配是否成功
for (int i = 0; i < v->count; i++) {
x->cell[i] = (MLval*)MLval_copy(v->cell[i]);
}
break;
}
return x;
}
len和init
// 返回出最后一个元素以外的其他元素
MLval* builtin_init(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;
}
// 返回Q表达式中的元素个数
MLval* builtin_len(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;
}
索引函数
我们的内建函数以及都定义了,但是symbol的量实在是有点多,我们可以构建一个builtin函数当作索引函数,然后需要在sexpr计算函数中调用即可
MLval* builtin(MLval* a, char* func)
{
if (strcmp("list", func) == 0) { return builtin_list(a); }
if (strcmp("head", func) == 0) { return builtin_head(a); }
if (strcmp("tail", func) == 0) { return builtin_tail(a); }
if (strcmp("join", func) == 0) { return builtin_join(a); }
if (strcmp("eval", func) == 0) { return builtin_eval(a); }
if (strcmp("len", func) == 0) { return builtin_len(a); }
if (strcmp("init", func) == 0) { return builtin_init(a); }
if (strcmp("cons", func) == 0) { return builtin_cons(a); }
if (strstr("+-/*add|sub|mul|div|min|max|mod|", func)) { return builtin_op(a, func); }
MLval_del(a);
return MLval_err("Unknown Function!");
}
v0.3.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.3.2\n");
printf("By jasmine-leaf\n");
printf("Press Ctrl+c 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
// 优化了解析器的书写与读取
// 处理异常
#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
// 数据类型
enum
{
MLVAL_ERR, // 表示错误
MLVAL_NUM, // 表示数字
MLVAL_SYM, // 表示符号
MLVAL_SEXPR, // 表示S表达式
MLVAL_QEXPR // 表示Q表达式
};
typedef struct MLval
{
int type; // 表示类型
double num;
char* err;
char* sym;
int count; //列表元素数量
struct MLval** cell;
} MLval;
MLval* MLval_num(double x);
MLval* MLval_err(char* m);
MLval* MLval_sym(char* s);
MLval* MLval_sexpr();
MLval* MLval_qexpr();
void MLval_del(MLval* v);
MLval* MLval_add(MLval* v, MLval* x);
MLval* MLval_pop(MLval* v, int i);
MLval* MLval_join(MLval* x, MLval* y);
MLval* MLval_take(MLval* v, int i);
void MLval_print(MLval* v);
void MLval_expr_print(MLval* v, char open, char close);
void MLval_println(MLval* v);
MLval* MLval_eval(MLval* v);
MLval* builtin_list(MLval* a);
MLval* builtin_head(MLval* a);
MLval* builtin_tail(MLval* a);
MLval* builtin_eval(MLval* a);
MLval* builtin_join(MLval* a);
MLval* builtin_op(MLval* a, char* op);
MLval* MLval_eval_sexpr(MLval* v);
MLval* builtin_len(MLval* a);
MLval* MLval_copy(MLval* v);
MLval* builtin_cons(MLval* a);
MLval* builtin_init(MLval* a);
MLval* builtin(MLval* a, char* func);
MLval* MLval_read_num(mpc_ast_t* t);
MLval* MLval_read(mpc_ast_t* t);
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* m)
{ // 错误类型初始化
MLval* v = (MLval*)malloc(sizeof(MLval));
assert(v);
v->type = MLVAL_ERR;
v->err = (char*)malloc(strlen(m) + 1);
assert(v->err);
strcpy(v->err, m);
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_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_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:
break;
}
free(v);
}
MLval* MLval_add(MLval* v, MLval* x) // 列表添加元素
{
v->count++;
MLval** temp = (MLval**)realloc(v->cell, sizeof(MLval*) * v->count);
if (temp == NULL)
{
printf("realloc fail!!\n");
free(v->cell);
return NULL;
}
v->cell = temp;
v->cell[v->count - 1] = x;
return v;
}
MLval* MLval_pop(MLval* v, int i) // 列表删除元素
{
// 找到第i个元素
MLval* x = v->cell[i];
memmove(&v->cell[i], &v->cell[i + 1],
sizeof(MLval*) * (v->count - i - 1));
v->count--;
v->cell = (MLval**)realloc(v->cell, sizeof(MLval*) * v->count);
return x;
}
MLval* MLval_join(MLval* x, MLval* y)
{
while (y->count)
{
x = MLval_add(x, MLval_pop(y, 0));
}
MLval_del(y);
return x;
}
MLval* MLval_take(MLval* v, int i) // 取出元素
{
MLval* x = MLval_pop(v, i);
MLval_del(v);
return x;
}
void MLval_expr_print(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_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_expr_print(v, '(', ')'); break;
case MLVAL_QEXPR: MLval_expr_print(v, '{', '}'); break;
default:
break;
}
}
void MLval_println(MLval* v)
{
MLval_print(v);
putchar('\n');
}
MLval* builtin_list(MLval* a)
{
a->type = MLVAL_QEXPR;
return a;
}
MLval* builtin_head(MLval* a)
{
MLASSERT_NUM(a, a, 1, "Function 'head' takes exactly one argument.");
MLASSERT_NOT_EMPTY(a, a->cell[0], "Function 'head' passed {}.");
MLval* v = MLval_take(a, 0);
while (v->count>1)
{
MLval_del(MLval_pop(v, 1));
}
return v;
}
MLval* builtin_tail(MLval* a)
{
MLASSERT_NUM(a, a, 1, "Function 'tail' takes exactly one argument.");
MLASSERT_NOT_EMPTY(a, a->cell[0], "Function 'tail' passed {}.");
MLval* v = MLval_take(a, 0);
MLval_del(MLval_pop(v, 0));
return v;
}
MLval* builtin_eval(MLval* a)
{
MLASSERT_NUM(a, a, 1, "Function 'eval' takes exactly one argument.");
MLASSERT(a, a->cell[0]->type == MLVAL_QEXPR, "Function 'eval' passed incorrect type.");
MLval* x = MLval_take(a, 0);
x->type = MLVAL_SEXPR;
return MLval_eval(x);
}
MLval* builtin_join(MLval* a)
{
for (int i = 0; i < a->count; i++)
{
MLASSERT(a, a->cell[i]->type == MLVAL_QEXPR, "Function 'join' passed incorrect type.");
}
MLval* x = MLval_pop(a, 0);
while (a->count)
{
x = MLval_join(x, MLval_pop(a, 0));
}
MLval_del(a);
return x;
}
MLval* builtin_op(MLval* a, char* op)
{
// 确保操作数为数字
for (int i = 0; i < a->count; i++)
{
MLASSERT(a, a->cell[i]->type == MLVAL_NUM, "Cannot operate on non-number!");
}
// 得到第一个操作数
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 || strcmp(op, "add") == 0) { x->num += y->num; }
if (strcmp(op, "-") == 0 || strcmp(op, "sub") == 0) { x->num -= y->num; }
if (strcmp(op, "*") == 0 || strcmp(op, "mul") == 0) { x->num *= y->num; }
if (strcmp(op, "/") == 0 || strcmp(op, "div") == 0)
{
if (y->num == 0)
{
MLval_del(x);
MLval_del(y);
x = MLval_err("Division By Zero.");
}
x->num /= y->num;
}
if (strcmp(op, "%") == 0 || strcmp(op, "mod") == 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;
}
// 返回Q表达式中的元素个数
MLval* builtin_len(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;
}
MLval* MLval_copy(MLval* v) {
MLval* x = (MLval*)malloc(sizeof(MLval));
assert(x != NULL); // 检查内存分配是否成功
x->type = v->type;
switch (v->type) {
case MLVAL_NUM: x->num = v->num; break;
case MLVAL_ERR:
x->err = (char*)malloc(strlen(v->err) + 1);
assert(x->err != NULL); // 检查内存分配是否成功
strcpy(x->err, v->err);
break;
case MLVAL_SYM:
x->sym = (char*)malloc(strlen(v->sym) + 1);
assert(x->sym != NULL); // 检查内存分配是否成功
strcpy(x->sym, v->sym);
break;
case MLVAL_SEXPR:
case MLVAL_QEXPR:
x->count = v->count;
x->cell = (MLval**)malloc(sizeof(MLval*) * v->count);
assert(x->cell != NULL); // 检查内存分配是否成功
for (int i = 0; i < v->count; i++) {
x->cell[i] = (MLval*)MLval_copy(v->cell[i]);
}
break;
}
return x;
}
// 将一个值添加到Q表达式的首位
MLval* builtin_cons(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*)MLval_copy(a->cell[0]));
// 将 Q-表达式中的其他元素添加到新的 Q-表达式中
for (int i = 0; i < a->cell[1]->count; i++)
{
qexpr = MLval_add(qexpr, (MLval*)MLval_copy(a->cell[1]->cell[i]));
}
// 释放原始参数
MLval_del(a);
return qexpr;
}
// 返回出最后一个元素以外的其他元素
MLval* builtin_init(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(MLval* a, char* func)
{
if (strcmp("list", func) == 0) { return builtin_list(a); }
if (strcmp("head", func) == 0) { return builtin_head(a); }
if (strcmp("tail", func) == 0) { return builtin_tail(a); }
if (strcmp("join", func) == 0) { return builtin_join(a); }
if (strcmp("eval", func) == 0) { return builtin_eval(a); }
if (strcmp("len", func) == 0) { return builtin_len(a); }
if (strcmp("init", func) == 0) { return builtin_init(a); }
if (strcmp("cons", func) == 0) { return builtin_cons(a); }
if (strstr("+-/*add|sub|mul|div|min|max|mod|", func)) { return builtin_op(a, func); }
MLval_del(a);
return MLval_err("Unknown Function!");
}
MLval* MLval_eval_sexpr(MLval* v)
{
for (int i = 0; i < v->count; i++)
{
v->cell[i] = MLval_eval(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_SYM)
{
MLval_del(f); MLval_del(v);
return MLval_err("S-expression Does not start with symbol.");
}
MLval* result = builtin(v, f->sym);
MLval_del(f);
return result;
}
MLval* MLval_eval(MLval* v)
{
if (v->type == MLVAL_SEXPR) { return MLval_eval_sexpr(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\" \
| \"eval\" | \"join\" | \"add\" \
| \"sub\" | \"mul\" | \"div\" | \"min\" \
| \"max\" | \"mod\" | \"len\" | \"cons\" \
| \"init\" ; \
sexpr : '(' <expr>* ')' ; \
qexpr : '{' <expr>* '}' ; \
expr : <number> | <symbol> | <sexpr> | <qexpr> ; \
mylisp : /^/ <expr>* /$/ ; \
",
Number, Symbol, Sexpr, Qexpr, Expr, MyLisp);
while (1)
{
char* input = readline("MyLisp> ");
add_history(input);
// 分析用户输入
mpc_result_t r;
if (mpc_parse("<stdin>", input, MyLisp, &r))
{
MLval* x = MLval_eval(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);
}
mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, MyLisp);
}
int main()
{
PrintPrompt();
Lisp();
return 0;
}