本文共 24598 字，大约阅读时间需要 81 分钟。

目录

前文列表

《》

变量

我们先前实现的 S-Expression 和 Q-Expression 都是直接为了运算求值，但并没有考虑到变量是什么类型。显然的，一门好的编程语言，需要支持多种类型的变量，让程序员可以灵活的命名变量、声明变量类型。

从代码实现的角度来看，我们需要一个新的数据结构来支撑对变量元素进行设计，这个结构将存储所有的变量名和值，我们将这个数据结构称为 Environment（环境）。每次打开一个新的交互式解析器，就会创建一个新的 Environment，让程序员可以存储和再次调用已经定义好的变量。

变量语法规则

首先，我们需要设计好针对变量的语法规则，使得编程语言可以拥有更多的合法符号（关键字）。区别于 C 语言在变量定义上设计了限制性的语法，我们将编程语言的变量语法设计得更加开放一些，支持多样化的操作，为此而使用了正则表达式：

/[a-zA-Z0-9_+\\-*\\/\\\\=<>!]+/

使得变量名称将可以由数字，字母，加减乘除等符合组成：

mpca_lang(MPCA_LANG_DEFAULT,  "                                                     \    number : /-?[0-9]+/ ;                               \    symbol : /[a-zA-Z0-9_+\\-*\\/\\\\=<>!&]+/ ;         \    sexpr  : '(' 
   
    * ')' ;                          \    qexpr  : '{' 
    
     * '}' ;                          \    expr   : 
     
       | 
      
        | 
       
         | 
        
          ; \ lispy : /^/ 
         
          * /$/ ; \ ", Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
         
        
       
      
     
    
   

变量的读取和存储

如此定义了语法规则之后，在我们的编程语言中，符号（Symbol）就不再仅仅代表操作符了，它们现在只是一个名字而已。因此我们还需要一些新标识来区分具有特殊含义的 操作符（lval） 以及 环境（lenv）。

首先添加 lenv 结构体类型，我们将 lenv 结构体类型定义为由一系列的变量名和值组成的。所以使用两个二重指针变量来处理：

struct lenv {
     int count;  char** syms;  lval** vals;};

在定义 lenv 结构体的构造函数和析构函数，用于存储变量：

lenv* lenv_new(void) {
     lenv* e = malloc(sizeof(lenv));  e->count = 0;  e->syms = NULL;  e->vals = NULL;  return e;}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);}

接下来将创建两个函数在环境中获取和赋予值：

• 在获取值的函数 lenv_get 中：我们需要检索数据是不是我们需要的值，如果符合我们的标准就返回值的拷贝，如果不符合就返回一个错误信息。
• 在赋予值的函数 lenv_put 中：代码相对要复杂一些。我们首先要检查变量名之前是否存在，如果存在就会替换掉原先的内容。如果不存在，我们需要申请一些新的内存资源来存储数据，使用 realloc 并存储 lval 的拷贝。

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 found return error */  return lval_err("unbound symbol!");}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);}

将变量加入 Lisp Value 体系

在先前的章节中，我们实现了很多接受 lval* 类型实参并返回 lval* 类型结果的函数，现在对其进行改造，添加一个形参指向我们的 “环境”，我们将这个新的函数称为 lbuildin，并且为了提高代码效率，我们还将这个函数定义为一个函数指针，并作为 Lisp Value 的类型之一，用于处理变量、操作符、数字、符合的分发。

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

• typedef 关键字：为变量取一个别名。
• lbuiltin：函数指针名

这行代码的含义是：为了获取 lval* 类型结果，我们创建了 lbuiltin 函数指针变量，并带有 lenv* 和 lval* 两个形参。如此的，我们就可以在继续沿用 Lisp Value 体系的情况下，区分完成针对 环境（lenv） 的操作了。

/* Forward Declarations */struct lval;struct lenv;typedef struct lval lval;typedef struct lenv lenv;/* Lisp Value */enum {
    LVAL_ERR, LVAL_NUM,   LVAL_SYM,       LVAL_FUN, LVAL_SEXPR, LVAL_QEXPR };typedef lval*(*lbuiltin)(lenv*, lval*);struct lval {
     int type;  long num;  char* err;  char* sym;  lbuiltin fun;  int count;  lval** cell;};

LVAL_FUN 类型的构造函数：

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

在析构函数中，不需要对 LVAL_FUN 做特殊处理：

case LVAL_FUN: break;

打印函数也要做相应的修改：

case LVAL_FUN:   printf("
   
    "); break;
   

实现一个新的函数用于拷贝 lval，完成从环境中读取并存储数据。对于数字和字符串，我们只需要拷贝值就好了，但是对于字符串，我们还需要考虑分配内存资源，需要使用到 malloc 和 strcpy。对于数组的拷贝，首先需要分配好资源，然后将数组元素一个一个进行拷贝。

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: x->fun = v->fun; 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;}

变量的计算

因为 Lisp Value 引入了 lenv “变量” 结构体，所以整个运算的逻辑都要进行相应的修改，好在整体的框架不需要变化。

lval* lval_eval(lenv* e, lval* v) {
     if (v->type == LVAL_SYM) {
       lval* x = lenv_get(e, v);    lval_del(v);    return x;  }  if (v->type == LVAL_SEXPR) {
    return lval_eval_sexpr(e, v); }  return v;}lval* lval_eval_sexpr(lenv* e, lval* v) {
     for (int i = 0; i < v->count; i++) {
       v->cell[i] = lval_eval(e, v->cell[i]);  }  for (int i = 0; i < v->count; i++) {
       if (v->cell[i]->type == LVAL_ERR) {
    return lval_take(v, i); }  }  if (v->count == 0) {
    return v; }  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_del(v); lval_del(f);    return lval_err("first element is not a function");  }  /* If so call function to get result */  lval* result = f->fun(e, v);  lval_del(f);  return result;}

因为引入 lenv 结构的同事也重新定义了符号的语法规则，所以还需要重新定义 builtin 函数：

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_fun(func);  lenv_put(e, k, v);  lval_del(k); lval_del(v);}void lenv_add_builtins(lenv* e) {
     /* List Functions */  lenv_add_builtin(e, "list", builtin_list);  lenv_add_builtin(e, "head", builtin_head);  lenv_add_builtin(e, "tail", builtin_tail);  lenv_add_builtin(e, "eval", builtin_eval);  lenv_add_builtin(e, "join", builtin_join);  /* Mathematical Functions */  lenv_add_builtin(e, "+", builtin_add);  lenv_add_builtin(e, "-", builtin_sub);  lenv_add_builtin(e, "*", builtin_mul);  lenv_add_builtin(e, "/", builtin_div);}

最后我们需要在交互环境启动之前调用这些函数，当然在用完了之后还需要删除这些函数：

lenv* e = lenv_new();lenv_add_builtins(e);while (1) {
     char* input = readline("lispy> ");  add_history(input);  mpc_result_t r;  if (mpc_parse("
   
    ", input, Lispy, &r)) {
       lval* x = lval_eval(e, lval_read(r.output));    lval_println(x);    lval_del(x);    mpc_ast_delete(r.output);  } else {
       mpc_err_print(r.error);    mpc_err_delete(r.error);  }  free(input);}lenv_del(e);
   

变量的定义与赋值

现在，我们的编程语言就可以计算变量了，但是用户依旧无法定义自己的变量，无法给变量赋值，所以我们需要继续实现这部分逻辑。让程序员可以使用 {} 来定义自己的变量，如果用户的定义有问题，将返回一个错误，如果定义是对的，将打印一个 ()：

lval* builtin_def(lenv* e, lval* a) {
     LASSERT(a, a->cell[0]->type == LVAL_QEXPR,    "Function 'def' passed incorrect type!");  /* First argument is symbol list */  lval* syms = a->cell[0];  /* Ensure all elements of first list are symbols */  for (int i = 0; i < syms->count; i++) {
       LASSERT(a, syms->cell[i]->type == LVAL_SYM,      "Function 'def' cannot define non-symbol");  }  /* Check correct number of symbols and values */  LASSERT(a, syms->count == a->count-1,    "Function 'def' cannot define incorrect "    "number of values to symbols");  /* Assign copies of values to symbols */  for (int i = 0; i < syms->count; i++) {
       lenv_put(e, syms->cell[i], a->cell[i+1]);  }  lval_del(a);  return lval_sexpr();}

异常处理优化

此外，现在我们的异常处理还不完善，所以我们需要添加新的错误处理的代码，把 lval_err 修改得像 printf 一样，具有输出功能。为了灵活的实现，我们采用了 C 语言中的 可变长形参列表 的特性，C 语言提供了 stdarg.h 头文件，该文件提供了实现可变参数功能的函数和宏。

lval* lval_err(char* fmt, ...);

• 第一步是创建 va_list 类型变量
• 然后使用 va_start 宏来初始化 va_list 变量为一个参数列表
• 使用 va_arg 宏和 va_list 变量来访问参数列表中的每个项
• 使用宏 va_end 来清理赋予 va_list 变量的内存。

此外，还使用了 vsnprintf 内建函数，vsnprintf 类似于 printf，默认输出字符串，因为我们不知道字符串的大小，默认分配了 512 个字节，当输出的字符串小于这个值，就会重新分配资源，如果大于这个值，就会报错，希望不会出现这个问题：

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;}

现在我们可以更新错误信息的提示，让它更加的完整：

LASSERT(a, a->count == 1,  "Function 'head' passed too many arguments. "  "Got %i, Expected %i.",  a->count, 1);

现在我们提高错误信息的内容：

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";  }}LASSERT(a, a->cell[0]->type == LVAL_QEXPR,  "Function 'head' passed incorrect type for argument 0. "  "Got %s, Expected %s.",  ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR));

我们把错误审查做的很详细是为了后面的编写，一旦出错，有 log 可以查看，这是良好的编程风格。并且使用宏可以减少很多代码的编写。

源代码

#include 
   
    #include 
    
     #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 
     
      static char buffer[2048];char *readline(char *prompt) {
       fputs(prompt, stdout);    fgets(buffer, 2048, stdin);    char *cpy = malloc(strlen(buffer) + 1);    strcpy(cpy, buffer);    cpy[strlen(cpy) - 1] = '\0';    return cpy;}void add_history(char *unused) {
   }#else#ifdef __linux__#include 
      
       #include 
       
        #endif#ifdef __MACH__#include 
        
         #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; long num; /* Count and Pointer to a list of "lval*" */ struct lval **cell; int count; /* Error and Symbol types have some string data */ char *err; char *sym; lbuiltin fun;};/* 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_fun(lbuiltin func) { lval *v = malloc(sizeof(lval)); v->type = LVAL_FUN; v->fun = func; return v;}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: 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);}struct lenv { int count; char **syms; lval **vals;};lenv *lenv_new(void) { lenv *e = malloc(sizeof(lenv)); e->count = 0; e->syms = NULL; e->vals = NULL; return e;}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) { lval *x = malloc(sizeof(lval)); x->type = v->type; switch (v->type) { /* Copy Functions and Numbers Directly */ case LVAL_FUN: x->fun = v->fun; 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 found return error */ 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);}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;}lval *lval_read_num(mpc_ast_t *t) { errno = 0; long x = strtol(t->contents, NULL, 10); return errno != ERANGE ? lval_num(x) : lval_err("invalid number");}lval *lval_read(mpc_ast_t *t) { /* If Symbol or Number return conversion to that type */ if (strstr(t->tag, "number")) { return lval_read_num(t); } 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; } x = lval_add(x, lval_read(t->children[i])); } 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_FUN: printf("
         
          "); break; case LVAL_SEXPR: lval_expr_print(v, '(', ')'); break; case LVAL_QEXPR: lval_expr_print(v, '{', '}'); 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 *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_del(f); lval_del(v); return lval_err("first element is not a function"); } /* If so call function to get result */ lval *result = f->fun(e, 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) { LASSERT_NUM("head", a, 1); LASSERT_TYPE("head", a, 0, LVAL_QEXPR); LASSERT_NOT_EMPTY("head", a, 0); /* 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) { x = lval_add(x, lval_pop(y, 0)); } /* 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_fun(func); lenv_put(e, k, v); lval_del(k); lval_del(v);}lval *builtin_def(lenv *e, lval *a) { LASSERT_TYPE("def", a, 0, LVAL_QEXPR); /* First argument is symbol list */ lval *syms = a->cell[0]; /* Ensure all elements of first list are symbols */ for (int i = 0; i < syms->count; i++) { LASSERT(a, syms->cell[i]->type == LVAL_SYM, "Function 'def' cannot define non-symbol"); } /* Check correct number of symbols and values */ LASSERT(a, syms->count == a->count-1, "Function 'def' cannot define incorrect " "number of values to symbols"); /* Assign copies of values to symbols */ for (int i = 0; i < syms->count; i++) { lenv_put(e, syms->cell[i], a->cell[i+1]); } lval_del(a); return lval_sexpr();}void lenv_add_builtins(lenv *e) { /* Variable Functions */ lenv_add_builtin(e, "def", builtin_def); /* List Functions */ lenv_add_builtin(e, "list", builtin_list); lenv_add_builtin(e, "head", builtin_head); lenv_add_builtin(e, "tail", builtin_tail); lenv_add_builtin(e, "eval", builtin_eval); lenv_add_builtin(e, "join", builtin_join); /* Mathematical Functions */ lenv_add_builtin(e, "+", builtin_add); lenv_add_builtin(e, "-", builtin_sub); lenv_add_builtin(e, "*", builtin_mul); lenv_add_builtin(e, "/", builtin_div);}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 : '(' 
          
           * ')' ; \ qexpr : '{' 
           
            * '}' ; \ expr : 
            
              | 
             
               | 
              
                | 
               
                 ; \ lispy : /^/ 
                
                 * /$/ ; \ ", 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("
                 
                  ", 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

运行：

$ ./parsingLispy Version 0.1Press Ctrl+c to Exitlispy> +
   
    lispy> eval (head {5 10 11 15})5lispy> (head {5 10 11 15}){5}lispy> eval (head {+ - + - * / }) 10 20Error: Function 'eval' passed too many arguments!Got 3, Expected 1.lispy> (eval (head {+ - + - * /})) 10 2030lispy> helloError: Unbound Symbol 'hello'lispy> def {x} 100()lispy> def {y} 200()lispy> x100lispy> y200lispy> + x y300lispy> def {a b} 5 6()lispy> + a b11lispy> def {arglist} {a b c d}()lispy> arglist{a b c d}lispy> def arglist 1 2 3 4()lispy> arglist{a b c d}lispy> list a b c d{1 2 3 4}lispy> + 1 {5 6 7}Error: Cannot operate on non-number!lispy> head {1 2 3} {4 5 6}Error: Function 'head' passed too many arguments. Got 2, Expected 1.lispy> + 1 12
   

转载地址：https://is-cloud.blog.csdn.net/article/details/105449597 如侵犯您的版权，请留言回复原文章的地址，我们会给您删除此文章，给您带来不便请您谅解！