//--------eval--------------- int eval(int addr){ int res; if(atomp(addr)){ if(numberp(addr)) return(addr); if(symbolp(addr)){ res = findsym(addr); if(res == -1) error(CANT_FIND_ERR, "eval", addr); else return(res); } } else if(listp(addr)){ if((symbolp(car(addr))) &&(HAS_NAME(car(addr),"quote"))) return(cadr(addr)); if(numberp(car(addr))) error(ARG_SYM_ERR, "eval", addr); if(subrp(car(addr))) return(apply(car(addr),evlis(cdr(addr)))); if(fsubrp(car(addr))) return(apply(car(addr),cdr(addr))); if(functionp(car(addr))) return(apply(car(addr),evlis(cdr(addr)))); } error(CANT_FIND_ERR, "eval", addr); return(0); }
int eval(int addr){ int res; if(atomp(addr)){ if(IS_NUMBER(addr)) return(addr); if(IS_SYMBOL(addr)){ res = findsym(GET_NAME(addr)); switch(GET_TAG(res)){ case NUM: return(makenum(GET_NUMBER(res))); case SYM: return(GET_BIND(res)); case LIS: return(GET_BIND(res)); } } } else{ if(HAS_NAME(car(addr),"quote")) return(cadr(addr)); if(subrp(car(addr))) return(apply(symname(car(addr)),evlis(cdr(addr)))); if(fsubrp(car(addr))) return(apply(symname(car(addr)),cdr(addr))); if(lambdap(car(addr))) return(apply(symname(car(addr)),evlis(cdr(addr)))); } return(NIL); }
//--------eval--------------- int eval(int addr){ int res; //ctrl+cによる割り込みがあった場合 if(exit_flag == 1){ exit_flag = 0; P = addr; //後で調べられるように退避 printf("exit eval by CTRL_C_EVENT\n"); fflush(stdout); longjmp(buf,1); } if(atomp(addr)){ if(numberp(addr)) return(addr); if(symbolp(addr)){ res = findsym(addr); if(res == 0) error(CANT_FIND_ERR, "eval", addr); else switch(GET_TAG(res)){ case NUM: return(res); case SYM: return(res); case LIS: return(res); case SUBR: return(res); case FSUBR: return(res); case LAMBDA:return(GET_BIND(res)); } } } else if(listp(addr)){ if((symbolp(car(addr))) &&(HAS_NAME(car(addr),"quote"))) return(cadr(addr)); if(numberp(car(addr))) error(ARG_SYM_ERR, "eval", addr); if(subrp(car(addr))) return(apply(car(addr),evlis(cdr(addr)))); if(fsubrp(car(addr))) return(apply(car(addr),cdr(addr))); if(lambdap(car(addr))) return(apply(car(addr),evlis(cdr(addr)))); } error(CANT_FIND_ERR, "eval", addr); }
int evlis(int addr){ int car_addr,cdr_addr; if(IS_NIL(addr)) return(addr); else{ car_addr = eval(car(addr)); cdr_addr = evlis(cdr(addr)); return(cons(car_addr,cdr_addr)); } }
int evlis(int addr){ int car_addr,cdr_addr; argpush(addr); checkgbc(); if(IS_NIL(addr)){ argpop(); return(addr); } else{ car_addr = eval(car(addr)); argpush(car_addr); cdr_addr = evlis(cdr(addr)); argpop(); argpop(); return(cons(car_addr,cdr_addr)); } }
alloc_t *eval(alloc_t *e, alloc_t *a) { eval_op_t eval_op = EVAL; alloc_t *f; int i; /* These three functions are mutually recursive via tail-call. * We could rewrite to "simplify" the control flow but it * wouldn't make much difference in the compiled code. * This way it reflects the Lisp code. */ for (i = 0; i < MAX_STEP; i++) { switch (eval_op) { case EVAL: if (atom(e) != nil) { return cdr(assoc(e, a)); } else if (atom(car(e)) != nil) { if (eq(car(e), quote_symbol) != nil) { return car(cdr(e)); } else if (eq(car(e), cond_symbol) != nil) { eval_op = EVCON; e = cdr(e); } else { eval_op = APPLY; f = car(e); e = evlis(cdr(e), a); } } else { eval_op = APPLY; f = car(e); e = evlis(cdr(e), a); } break; case APPLY: if (f == nil) { longjmp(fatal, ERROR_APPLY_ATOM); } if (atom(f) != nil) { if (eq(f, car_symbol) != nil) { return car(car(e)); } else if (eq(f, cdr_symbol) != nil) { return cdr(car(e)); } else if (eq(f, cons_symbol) != nil) { return cons(car(e), car(cdr(e))); } else if (eq(f, atom_symbol) != nil) { return atom(car(e)); } else if (eq(f, eq_symbol) != nil) { return eq(car(e), car(cdr(e))); } else { /* eval_op = APPLY; */ f = eval(f, a); } } else if (eq(car(f), lambda_symbol) != nil) { eval_op = EVAL; a = pairlis(car(cdr(f)), e, a); e = car(cdr(cdr(f))); } else { /* eq(car(f), label_symbol) != nil */ /* eval_op = APPLY */ a = cons(cons(car(cdr(f)), car(cdr(cdr(f)))), a); f = car(cdr(cdr(f))); } break; default: /* EVCON */ if (e == nil) { return nil; } else if (eval(car(car(e)), a) != nil) { eval_op = EVAL; e = car(cdr(car(e))); } else { /* eval_op = EVCON */ e = cdr(e); } break; } } longjmp(fatal, ERROR_STEP); }