# 排序函数

1. 首先我们检查错误情形。
2. 然后我们比较参数中的数字获得结果。
3. 最后，我们将结果作为数字返回。
lval* builtin_gt(lenv* e, lval* a) {
return builtin_ord(e, a, ">");
}

lval* builtin_lt(lenv* e, lval* a) {
return builtin_ord(e, a, "<");
}

lval* builtin_ge(lenv* e, lval* a) {
return builtin_ord(e, a, ">=");
}

lval* builtin_le(lenv* e, lval* a) {
return builtin_ord(e, a, "<=");
}

lval* builtin_ord(lenv* e, lval* a, char* op) {
LASSERT_NUM(op, a, 2);
LASSERT_TYPE(op, a, 0, LVAL_NUM);
LASSERT_TYPE(op, a, 1, LVAL_NUM);

int r;
if (strcmp(op, ">")  == 0) {
r = (a->cell[0]->num >  a->cell[1]->num);
}
if (strcmp(op, "<")  == 0) {
r = (a->cell[0]->num <  a->cell[1]->num);
}
if (strcmp(op, ">=") == 0) {
r = (a->cell[0]->num >= a->cell[1]->num);
}
if (strcmp(op, "<=") == 0) {
r = (a->cell[0]->num <= a->cell[1]->num);
}
lval_del(a);
return lval_num(r);
}


# 等于函数

int lval_eq(lval* x, lval* y) {

/* Different Types are always unequal */
if (x->type != y->type) { return 0; }

/* Compare Based upon type */
switch (x->type) {
/* Compare Number Value */
case LVAL_NUM: return (x->num == y->num);

/* Compare String Values */
case LVAL_ERR: return (strcmp(x->err, y->err) == 0);
case LVAL_SYM: return (strcmp(x->sym, y->sym) == 0);

/* If builtin compare, otherwise compare formals and body */
case LVAL_FUN:
if (x->builtin || y->builtin) {
return x->builtin == y->builtin;
} else {
return lval_eq(x->formals, y->formals)
&& lval_eq(x->body, y->body);
}

/* If list compare every individual element */
case LVAL_QEXPR:
case LVAL_SEXPR:
if (x->count != y->count) { return 0; }
for (int i = 0; i < x->count; i++) {
/* If any element not equal then whole list not equal */
if (!lval_eq(x->cell[i], y->cell[i])) { return 0; }
}
/* Otherwise lists must be equal */
return 1;
break;
}
return 0;
}


lval* builtin_cmp(lenv* e, lval* a, char* op) {
LASSERT_NUM(op, a, 2);
int r;
if (strcmp(op, "==") == 0) {
r =  lval_eq(a->cell[0], a->cell[1]);
}
if (strcmp(op, "!=") == 0) {
r = !lval_eq(a->cell[0], a->cell[1]);
}
lval_del(a);
return lval_num(r);
}

lval* builtin_eq(lenv* e, lval* a) {
return builtin_cmp(e, a, "==");
}

lval* builtin_ne(lenv* e, lval* a) {
return builtin_cmp(e, a, "!=");
}


# if 函数

lval* builtin_if(lenv* e, lval* a) {
LASSERT_NUM("if", a, 3);
LASSERT_TYPE("if", a, 0, LVAL_NUM);
LASSERT_TYPE("if", a, 1, LVAL_QEXPR);
LASSERT_TYPE("if", a, 2, LVAL_QEXPR);

/* Mark Both Expressions as evaluable */
lval* x;
a->cell[1]->type = LVAL_SEXPR;
a->cell[2]->type = LVAL_SEXPR;

if (a->cell[0]->num) {
/* If condition is true evaluate first expression */
x = lval_eval(e, lval_pop(a, 1));
} else {
/* Otherwise evaluate second expression */
x = lval_eval(e, lval_pop(a, 2));
}

/* Delete argument list and return */
lval_del(a);
return x;
}


/* Comparison Functions */


# 递归函数

(fun {len l} {
if (== l {})
{0}
{+ 1 (len (tail l))}
})


(fun {reverse l} {
if (== l {})
{{}}
{join (reverse (tail l)) (head l)}
})


# 源代码

#include <stdio.h>
#include <stdlib.h>
#include "mpc.h"

#define LASSERT(args, cond, fmt, ...) \
if (!(cond)) { lval* err = lval_err(fmt, ##__VA_ARGS__); lval_del(args); return err; }

#define LASSERT_TYPE(func, args, index, expect) \
LASSERT(args, args->cell[index]->type == expect, \
"Function '%s' passed incorrect type for argument %i. Got %s, Expected %s.", \
func, index, ltype_name(args->cell[index]->type), ltype_name(expect))

#define LASSERT_NUM(func, args, num) \
LASSERT(args, args->count == num, \
"Function '%s' passed incorrect number of arguments. Got %i, Expected %i.", \
func, args->count, num)

#define LASSERT_NOT_EMPTY(func, args, index) \
LASSERT(args, args->cell[index]->count != 0, \
"Function '%s' passed {} for argument %i.", func, index);

#ifdef _WIN32
#include <string.h>

static char buffer[2048];

fputs(prompt, stdout);
fgets(buffer, 2048, stdin);

char *cpy = malloc(strlen(buffer) + 1);

strcpy(cpy, buffer);
cpy[strlen(cpy) - 1] = '\0';

return cpy;
}

#else

#ifdef __linux__
#endif

#ifdef __MACH__
#endif

#endif

/* Forward Declarations */
struct lval;
struct lenv;
typedef struct lval lval;
typedef struct lenv lenv;

/* Lisp Value Type Enumeration */
enum {
LVAL_NUM,
LVAL_ERR,
LVAL_SYM,
LVAL_FUN,
LVAL_SEXPR,
LVAL_QEXPR
};

typedef lval *(*lbuiltin)(lenv*, lval*);

/* Declare lisp lval Struct */
struct lval {
int type;

/* Basic */
long num;
char *err;
char *sym;

/* Function */
lbuiltin builtin;
lenv *env;
lval *formals;
lval *body;

/* Expression */
int count;
struct lval **cell;
};

/* Construct a pointer to a new Number lval */
lval *lval_num(long x) {
lval *v = malloc(sizeof(lval));
v->type = LVAL_NUM;
v->num = x;
return v;
}

char *ltype_name(int t) {
switch(t) {
case LVAL_FUN: return "Function";
case LVAL_NUM: return "Number";
case LVAL_ERR: return "Error";
case LVAL_SYM: return "Symbol";
case LVAL_SEXPR: return "S-Expression";
case LVAL_QEXPR: return "Q-Expression";
default: return "Unknown";
}
}

/* Construct a pointer to a new Error lval */
lval *lval_err(char *fmt, ...) {
lval *v = malloc(sizeof(lval));
v->type = LVAL_ERR;
/* Create a va list and initialize it */
va_list va;
va_start(va, fmt);

/* Allocate 512 bytes of space */
v->err = malloc(512);

/* printf the error string with a maximum of 511 characters */
vsnprintf(v->err, 511, fmt, va);

/* Reallocate to number of bytes actually used */
v->err = realloc(v->err, strlen(v->err)+1);

/* Cleanup our va list */
va_end(va);

return v;
}

/* Construct a pointer to a new Symbol lval */
lval *lval_sym(char *sym) {
lval *v = malloc(sizeof(lval));
v->type = LVAL_SYM;
v->sym = malloc(strlen(sym) + 1);
strcpy(v->sym, sym);
return v;
}

/* A pointer to a new empty Sexpr lval */
lval *lval_sexpr(void) {
lval *v = malloc(sizeof(lval));
v->type = LVAL_SEXPR;
v->count = 0;
v->cell = NULL;
return v;
}

/* A pointer to a new empty Qexpr lval */
lval *lval_qexpr(void) {
lval *v = malloc(sizeof(lval));
v->type = LVAL_QEXPR;
v->count = 0;
v->cell = NULL;
return v;
}

lval* lval_builtin(lbuiltin func) {
lval *v = malloc(sizeof(lval));
v->type = LVAL_FUN;
v->builtin = func;
return v;
}

struct lenv {
lenv *par;

int count;
char **syms;
lval **vals;
};

lenv *lenv_new(void) {
lenv *e = malloc(sizeof(lenv));
e->par = NULL;
e->count = 0;
e->syms = NULL;
e->vals = NULL;
return e;
}

lval *lval_lambda(lval *formals, lval *body) {
lval *v = malloc(sizeof(lval));
v->type = LVAL_FUN;

/* Set Builtin to Null */
v->builtin = NULL;

/* Build new environment */
v->env = lenv_new();

/* Set Formals and Body */
v->formals = formals;
v->body = body;
return v;
}

void lenv_del(lenv *e);

void lval_del(lval *v) {
switch (v->type) {
/* Do nothing special for number type */
case LVAL_NUM:
break;

/* For Err or Sym free the string data */
case LVAL_ERR:
free(v->err);
break;
case LVAL_SYM:
free(v->sym);
break;

case LVAL_FUN:
if (!v->builtin) {
lenv_del(v->env);
lval_del(v->formals);
lval_del(v->body);
}
break;

/* If Qexpr or Sexpr then delete all elements inside */
case LVAL_QEXPR:
case LVAL_SEXPR:
for (int i = 0; i < v->count; i++) {
lval_del(v->cell[i]);
}
/* Also free the memory allocated to contain the pointers */
free(v->cell);
break;
}
/* Free the memory allocated for the "lval" struct itself */
free(v);
}

void lenv_del(lenv *e) {
for (int i = 0; i < e->count; i++) {
free(e->syms[i]);
lval_del(e->vals[i]);
}
free(e->syms);
free(e->vals);
free(e);
}

lval *lval_copy(lval *v);

lenv *lenv_copy(lenv *e) {
lenv *n = malloc(sizeof(lenv));
n->par = e->par;
n->count = e->count;
n->syms = malloc(sizeof(char*) * n->count);
n->vals = malloc(sizeof(lval*) * 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] = lval_copy(e->vals[i]);
}
return n;
}

lval *lval_copy(lval *v) {
lval *x = malloc(sizeof(lval));
x->type = v->type;

switch (v->type) {
/* Copy Functions and Numbers Directly */
case LVAL_FUN:
if (v->builtin) {
x->builtin = v->builtin;
} else {
x->builtin = NULL;
x->env = lenv_copy(v->env);
x->formals = lval_copy(v->formals);
x->body = lval_copy(v->body);
}
break;
case LVAL_NUM: x->num = v->num; break;

/* Copy Strings using malloc and strcpy */
case LVAL_ERR:
x->err = malloc(strlen(v->err) + 1);
strcpy(x->err, v->err);
break;

case LVAL_SYM:
x->sym = malloc(strlen(v->sym) + 1);
strcpy(x->sym, v->sym);
break;

/* Copy Lists by copying each sub-expression */
case LVAL_SEXPR:
case LVAL_QEXPR:
x->count = v->count;
x->cell = malloc(sizeof(lval*) * x->count);
for (int i = 0; i < x->count; i++) {
x->cell[i] = lval_copy(v->cell[i]);
}
break;
}
return x;
}

lval *lenv_get(lenv *e, lval *k) {
/* Iterate over all items in environment */
for (int i = 0; i < e->count; i++) {
/* Check if the stored string matches the symbol string */
/* If it does, return a copy of the value */
if (strcmp(e->syms[i], k->sym) == 0) {
return lval_copy(e->vals[i]);
}
}

/* If no symbol check in parent otherwise error */
if (e->par) {
return lenv_get(e->par, k);
} else {
return lval_err("Unbound Symbol '%s'", k->sym);
}
}

void lenv_put(lenv *e, lval *k, lval *v) {
/* Iterate over all items in environment */
/* This is to see if variable already exists */
for (int i = 0; i < e->count; i++) {
/* If variable is found delete item at that position */
/* And replace with variable supplied by user */
if (strcmp(e->syms[i], k->sym) == 0) {
lval_del(e->vals[i]);
e->vals[i] = lval_copy(v);
return;
}
}

/* If no existing entry found allocate space for new entry */
e->count++;
e->vals = realloc(e->vals, sizeof(lval*) * e->count);
e->syms = realloc(e->syms, sizeof(char*) * e->count);

/* Copy contents of lval and symbol string into new location */
e->vals[e->count-1] = lval_copy(v);
e->syms[e->count-1] = malloc(strlen(k->sym)+1);
strcpy(e->syms[e->count-1], k->sym);
}

void lenv_def(lenv *e, lval *k, lval *v) {
/* Iterate till e has no parent */
while (e->par) {
e = e->par;
}
/* Put value in e */
lenv_put(e, k, v);
}

lval *lval_add(lval *v, lval *x) {
v->count++;
v->cell = realloc(v->cell, sizeof(lval*) * v->count);
v->cell[v->count-1] = x;
return v;
}

errno = 0;
long x = strtol(t->contents, NULL, 10);
return errno != ERANGE
? lval_num(x)
: lval_err("invalid number");
}

/* If Symbol or Number return conversion to that type */
if (strstr(t->tag, "number")) {
}
if (strstr(t->tag, "symbol")) {
return lval_sym(t->contents);
}

/* If root (>) or sexpr then create empty list */
lval *x = NULL;
if (strcmp(t->tag, ">") == 0) {
x = lval_sexpr();
}
if (strstr(t->tag, "sexpr"))  {
x = lval_sexpr();
}
if (strstr(t->tag, "qexpr")) {
x = lval_qexpr();
}

/* Fill this list with any valid expression contained within */
for (int i = 0; i < t->children_num; i++) {
if (strcmp(t->children[i]->contents, "(") == 0) { continue; }
if (strcmp(t->children[i]->contents, ")") == 0) { continue; }
if (strcmp(t->children[i]->contents, "}") == 0) { continue; }
if (strcmp(t->children[i]->contents, "{") == 0) { continue; }
if (strcmp(t->children[i]->tag,  "regex") == 0) { continue; }
}
return x;
}

void lval_print(lval *v);

void lval_expr_print(lval *v, char open, char close) {
putchar(open);
for (int i = 0; i < v->count; i++) {

/* Print Value contained within */
lval_print(v->cell[i]);

/* Don't print trailing space if last element */
if (i != (v->count-1)) {
putchar(' ');
}
}
putchar(close);

}

/* Print an "lval*" */
void lval_print(lval *v) {
switch (v->type) {
case LVAL_NUM:   printf("%li", v->num); break;
case LVAL_ERR:   printf("Error: %s", v->err); break;
case LVAL_SYM:   printf("%s", v->sym); break;
case LVAL_SEXPR: lval_expr_print(v, '(', ')'); break;
case LVAL_QEXPR: lval_expr_print(v, '{', '}'); break;
case LVAL_FUN:
if (v->builtin) {
printf("<builtin>");
} else {
printf("(\\ "); lval_print(v->formals);
putchar(' ');
lval_print(v->body);
putchar(')');
}
break;
}
}

/* Print an "lval" followed by a newline */
void lval_println(lval *v) {
lval_print(v);
putchar('\n');
}

lval *lval_pop(lval *v, int i) {

/* Find the item at "i" */
lval *x = v->cell[i];

/* Shift memory after the item at "i" over the top */
memmove(&v->cell[i], &v->cell[i+1],
sizeof(lval*) * (v->count-i-1));

/* Decrease the count of items in the list */
v->count--;

/* Reallocate the memory used */
v->cell = realloc(v->cell, sizeof(lval*) * v->count);
return x;
}

lval *lval_take(lval *v, int i) {
lval *x = lval_pop(v, i);
lval_del(v);
return x;
}

lval *builtin_eval(lenv* e, lval *a);
lval *builtin_list(lenv *e, lval *a);

lval *lval_call(lenv *e, lval *f, lval *a) {
/* If Builtin then simply apply that */
if (f->builtin) {
return f->builtin(e, a);
}

/* Record Argument Counts */
int given = a->count;
int total = f->formals->count;

/* While arguments still remain to be processed */
while (a->count) {
/* If we've ran out of formal arguments to bind */
if (f->formals->count == 0) {
lval_del(a);
return lval_err("Function passed too many arguments. "
"Got %i, Expected %i.", given, total);
}

/* Pop the first symbol from the formals */
lval *sym = lval_pop(f->formals, 0);

/* Special Case to deal with '&' */
if (strcmp(sym->sym, "&") == 0) {
/* Ensure '&' is followed by another symbol */
if (f->formals->count != 1) {
lval_del(a);
return lval_err("Function format invalid. "
"Symbol '&' not followed by single symbol.");
}

/* Next formal should be bound to remaining arguments */
lval *nsym = lval_pop(f->formals, 0);
lenv_put(f->env, nsym, builtin_list(e, a));
lval_del(sym); lval_del(nsym);
break;
}

/* Pop the next argument from the list */
lval* val = lval_pop(a, 0);

/* Bind a copy into the function's environment */
lenv_put(f->env, sym, val);

/* Delete symbol and value */
lval_del(sym); lval_del(val);
}

/* Argument list is now bound so can be cleaned up */
lval_del(a);

/* If '&' remains in formal list bind to empty list */
if (f->formals->count > 0 && strcmp(f->formals->cell[0]->sym, "&") == 0) {
/* Check to ensure that & is not passed invalidly. */
if (f->formals->count != 2) {
return lval_err("Function format invalid. "
"Symbol '&' not followed by single symbol.");
}

/* Pop and delete '&' symbol */
lval_del(lval_pop(f->formals, 0));

/* Pop next symbol and create empty list */
lval* sym = lval_pop(f->formals, 0);
lval* val = lval_qexpr();

/* Bind to environment and delete */
lenv_put(f->env, sym, val);
lval_del(sym); lval_del(val);
}

/* If all formals have been bound evaluate */
if (f->formals->count == 0) {

/* Set environment parent to evaluation environment */
f->env->par = e;

/* Evaluate and return */
lval_copy(f->body)));
} else {
/* Otherwise return partially evaluated function */
return lval_copy(f);
}
}

lval *lval_eval(lenv *e, lval *v);
lval *builtin(lval* a, char* func);

lval *lval_eval_sexpr(lenv *e, lval *v) {
/* Evaluate Children */
for (int i = 0; i < v->count; i++) {
v->cell[i] = lval_eval(e, v->cell[i]);
}

/* Error Checking */
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type == LVAL_ERR) {
return lval_take(v, i);
}
}

/* Empty Expression */
if (v->count == 0) { return v; }

/* Single Expression */
if (v->count == 1) { return lval_take(v, 0); }

/* Ensure first element is a function after evaluation */
lval *f = lval_pop(v, 0);
if (f->type != LVAL_FUN) {
lval *err = lval_err("S-Expression starts with incorrect type. "
"Got %s, Expected %s.",
ltype_name(f->type), ltype_name(LVAL_FUN));
lval_del(f);
lval_del(v);
return err;
}

lval *result = lval_call(e, f, v);
lval_del(f);
return result;
}

lval *lval_eval(lenv *e, lval *v) {
if (v->type == LVAL_SYM) {
lval *x = lenv_get(e, v);
lval_del(v);
return x;
}

/* Evaluate Sexpressions */
if (v->type == LVAL_SEXPR) {
return lval_eval_sexpr(e, v);
}

/* All other lval types remain the same */
return v;
}

lval *builtin_op(lenv* e, lval *a, char *op) {

/* Ensure all arguments are numbers */
for (int i = 0; i < a->count; i++) {
LASSERT_TYPE(op, a, i, LVAL_NUM);
}

/* Pop the first element */
lval *x = lval_pop(a, 0);

/* If no arguments and sub then perform unary negation */
if ((strcmp(op, "-") == 0) && a->count == 0) {
x->num = -x->num;
}

/* While there are still elements remaining */
while (a->count > 0) {
/* Pop the next element */
lval *y = lval_pop(a, 0);

if (strcmp(op, "+") == 0) { x->num += y->num; }
if (strcmp(op, "-") == 0) { x->num -= y->num; }
if (strcmp(op, "*") == 0) { x->num *= y->num; }
if (strcmp(op, "/") == 0) {
if (y->num == 0) {
lval_del(x);
lval_del(y);
x = lval_err("Division By Zero!");
break;
}
x->num /= y->num;
}
lval_del(y);
}
lval_del(a);
return x;
}

lval *builtin_head(lenv* e, lval *a) {

/* Otherwise take first argument */
lval *v = lval_take(a, 0);

/* Delete all elements that are not head and return */
while (v->count > 1) {
lval_del(lval_pop(v, 1));
}

return v;
}

lval *builtin_tail(lenv *e, lval *a) {
LASSERT_NUM("tail", a, 1);
LASSERT_TYPE("tail", a, 0, LVAL_QEXPR);
LASSERT_NOT_EMPTY("tail", a, 0);

/* Take first argument */
lval *v = lval_take(a, 0);

/* Delete first element and return */
lval_del(lval_pop(v, 0));

return v;

}

lval *builtin_list(lenv *e, lval *a) {
a->type = LVAL_QEXPR;
return a;
}

lval *builtin_eval(lenv* e, lval *a) {
LASSERT_NUM("eval", a, 1);
LASSERT_TYPE("eval", a, 0, LVAL_QEXPR);

lval *x = lval_take(a, 0);
x->type = LVAL_SEXPR;
return lval_eval(e, x);
}

lval *lval_join(lval *x, lval *y) {

/* For each cell in 'y' add it to 'x' */
while (y->count) {
}

/* Delete the empty 'y' and return 'x' */
lval_del(y);
return x;
}

lval *builtin_join(lenv *e, lval *a) {
for (int i = 0; i < a->count; i++) {
LASSERT_TYPE("join", a, i, LVAL_QEXPR);
}

lval *x = lval_pop(a, 0);

while (a->count) {
x = lval_join(x, lval_pop(a, 0));
}

lval_del(a);
return x;
}

lval *builtin_add(lenv *e, lval *a) {
return builtin_op(e, a, "+");
}

lval *builtin_sub(lenv *e, lval *a) {
return builtin_op(e, a, "-");
}

lval *builtin_mul(lenv *e, lval *a) {
return builtin_op(e, a, "*");
}

lval *builtin_div(lenv *e, lval *a) {
return builtin_op(e, a, "/");
}

void lenv_add_builtin(lenv *e, char *name, lbuiltin func) {
lval *k = lval_sym(name);
lval* v = lval_builtin(func);
lenv_put(e, k, v);
lval_del(k); lval_del(v);
}

lval *builtin_var(lenv *e, lval *a, char *func) {
LASSERT_TYPE(func, a, 0, LVAL_QEXPR);

lval* syms = a->cell[0];
for (int i = 0; i < syms->count; i++) {
LASSERT(a, (syms->cell[i]->type == LVAL_SYM),
"Function '%s' cannot define non-symbol. "
"Got %s, Expected %s.", func,
ltype_name(syms->cell[i]->type),
ltype_name(LVAL_SYM));
}

LASSERT(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++) {
/* If 'def' define in globally. If 'put' define in locally */
if (strcmp(func, "def") == 0) {
lenv_def(e, syms->cell[i], a->cell[i+1]);
}

if (strcmp(func, "=") == 0) {
lenv_put(e, syms->cell[i], a->cell[i+1]);
}
}

lval_del(a);
return lval_sexpr();
}

lval *builtin_def(lenv *e, lval *a) {
return builtin_var(e, a, "def");
}

lval *builtin_put(lenv *e, lval *a) {
return builtin_var(e, a, "=");
}

lval *builtin_lambda(lenv *e, lval *a) {
/* Check Two arguments, each of which are Q-Expressions */
LASSERT_NUM("\\", a, 2);
LASSERT_TYPE("\\", a, 0, LVAL_QEXPR);
LASSERT_TYPE("\\", a, 1, LVAL_QEXPR);

/* Check first Q-Expression contains only Symbols */
for (int i = 0; i < a->cell[0]->count; i++) {
LASSERT(a, (a->cell[0]->cell[i]->type == LVAL_SYM),
"Cannot define non-symbol. Got %s, Expected %s.",
ltype_name(a->cell[0]->cell[i]->type),ltype_name(LVAL_SYM));
}

/* Pop first two arguments and pass them to lval_lambda */
lval *formals = lval_pop(a, 0);
lval *body = lval_pop(a, 0);
lval_del(a);

return lval_lambda(formals, body);
}

lval *builtin_ord(lenv *e, lval *a, char *op);

lval *builtin_gt(lenv *e, lval *a) {
return builtin_ord(e, a, ">");
}

lval *builtin_lt(lenv *e, lval *a) {
return builtin_ord(e, a, "<");
}

lval *builtin_ge(lenv *e, lval *a) {
return builtin_ord(e, a, ">=");
}

lval *builtin_le(lenv *e, lval *a) {
return builtin_ord(e, a, "<=");
}

lval *builtin_ord(lenv *e, lval *a, char *op) {
LASSERT_NUM(op, a, 2);
LASSERT_TYPE(op, a, 0, LVAL_NUM);
LASSERT_TYPE(op, a, 1, LVAL_NUM);

int r;
if (strcmp(op, ">")  == 0) {
r = (a->cell[0]->num >  a->cell[1]->num);
}
if (strcmp(op, "<")  == 0) {
r = (a->cell[0]->num <  a->cell[1]->num);
}
if (strcmp(op, ">=") == 0) {
r = (a->cell[0]->num >= a->cell[1]->num);
}
if (strcmp(op, "<=") == 0) {
r = (a->cell[0]->num <= a->cell[1]->num);
}
lval_del(a);
return lval_num(r);
}

int lval_eq(lval *x, lval *y) {
/* Different Types are always unequal */
if (x->type != y->type) { return 0; }

/* Compare Based upon type */
switch (x->type) {
/* Compare Number Value */
case LVAL_NUM: return (x->num == y->num);

/* Compare String Values */
case LVAL_ERR: return (strcmp(x->err, y->err) == 0);
case LVAL_SYM: return (strcmp(x->sym, y->sym) == 0);

/* If builtin compare, otherwise compare formals and body */
case LVAL_FUN:
if (x->builtin || y->builtin) {
return x->builtin == y->builtin;
} else {
return lval_eq(x->formals, y->formals) && lval_eq(x->body, y->body);
}

/* If list compare every individual element */
case LVAL_QEXPR:
case LVAL_SEXPR:
if (x->count != y->count) { return 0; }
for (int i = 0; i < x->count; i++) {
/* If any element not equal then whole list not equal */
if (!lval_eq(x->cell[i], y->cell[i])) { return 0; }
}
/* Otherwise lists must be equal */
return 1;
break;
}
return 0;
}

lval *builtin_cmp(lenv *e, lval *a, char *op) {
LASSERT_NUM(op, a, 2);
int r;
if (strcmp(op, "==") == 0) {
r =  lval_eq(a->cell[0], a->cell[1]);
}
if (strcmp(op, "!=") == 0) {
r = !lval_eq(a->cell[0], a->cell[1]);
}
lval_del(a);
return lval_num(r);
}

lval *builtin_eq(lenv *e, lval *a) {
return builtin_cmp(e, a, "==");
}

lval *builtin_ne(lenv *e, lval *a) {
return builtin_cmp(e, a, "!=");
}

lval *builtin_if(lenv *e, lval *a) {
LASSERT_NUM("if", a, 3);
LASSERT_TYPE("if", a, 0, LVAL_NUM);
LASSERT_TYPE("if", a, 1, LVAL_QEXPR);
LASSERT_TYPE("if", a, 2, LVAL_QEXPR);

/* Mark Both Expressions as evaluable */
lval *x;
a->cell[1]->type = LVAL_SEXPR;
a->cell[2]->type = LVAL_SEXPR;

if (a->cell[0]->num) {
/* If condition is true evaluate first expression */
x = lval_eval(e, lval_pop(a, 1));
} else {
/* Otherwise evaluate second expression */
x = lval_eval(e, lval_pop(a, 2));
}

/* Delete argument list and return */
lval_del(a);
return x;
}

/* Variable Functions */

/* List Functions */

/* Mathematical Functions */

/* Comparison Functions */
}

int main(int argc, char *argv[]) {

/* Create Some Parsers */
mpc_parser_t *Number   = mpc_new("number");
mpc_parser_t* Symbol   = mpc_new("symbol");
mpc_parser_t* Sexpr    = mpc_new("sexpr");
mpc_parser_t *Qexpr    = mpc_new("qexpr");
mpc_parser_t *Expr     = mpc_new("expr");
mpc_parser_t *Lispy    = mpc_new("lispy");

/* Define them with the following Language */
mpca_lang(MPCA_LANG_DEFAULT,
"                                                       \
number   : /-?[0-9]+/ ;                                 \
symbol   : /[a-zA-Z0-9_+\\-*\\/\\\\=<>!&]+/ ;           \
sexpr    : '(' <expr>* ')' ;                            \
qexpr    : '{' <expr>* '}' ;                            \
expr     : <number> | <symbol> | <sexpr> | <qexpr> ;    \
lispy    : /^/ <expr>* /$/ ; \ ", Number, Symbol, Sexpr, Qexpr, Expr, Lispy); puts("Lispy Version 0.1"); puts("Press Ctrl+c to Exit\n"); lenv *e = lenv_new(); lenv_add_builtins(e); while(1) { char *input = readline("lispy> "); add_history(input); /* Attempt to parse the user input */ mpc_result_t r; if (mpc_parse("<stdin>", input, Lispy, &r)) { /* On success print and delete the AST */ lval *x = lval_eval(e, lval_read(r.output)); lval_println(x); lval_del(x); mpc_ast_delete(r.output); } else { /* Otherwise print and delete the Error */ mpc_err_print(r.error); mpc_err_delete(r.error); } free(input); } lenv_del(e); /* Undefine and delete our parsers */ mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, Lispy); return 0; }  编译： gcc -g -std=c99 -Wall parsing.c mpc.c -lreadline -lm -o parsing  运行： $ ./parsing
Lispy Version 0.1
Press Ctrl+c to Exit

lispy> > 10 5
1
lispy> <= 88 5
0
lispy> == 5 6
0
lispy> == 5 {}
0
lispy> == 1 1
1
lispy> != {} 56
1
lispy> == {1 2 3 {5 6}} {1   2  3   {5 6}}
1
lispy> def {x y} 100 200
()
lispy> if (== x y) {+ x y} {- x y}
-100


08-14 245

09-28 1022

07-25 2753

01-03 1万+

03-26 258

04-11 182

04-30 3万+

04-07 345

11-10 154

03-19 83万+

11-09 48

04-11 207

09-03 142

02-12 1044

04-13 272

04-06 272

02-14 7万+

04-08 196

01-21 29万+

02-06 20万+

#### B 站上有哪些很好的学习资源?

©️2019 CSDN 皮肤主题: 编程工作室 设计师: CSDN官方博客