//--------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); }
void release_node(node *o) { if ( nullp(o) ) { return; } if (symp(o)) { name_free(o->name); } else if (subrp(o) or fsubrp(o)) { name_free(o->fname); } node_free(o); }
/* evform - evaluate a form */ LOCAL NODE *evform(NODE *expr) { NODE ***oldstk,*fun __HEAPIFY,*args __HEAPIFY,*env,*val,*type; val = 0; //BUG: uninitialized variable is used if xlfail returns /* create a stack frame */ oldstk = xlsave2(&fun,&args); /* get the function and the argument list */ fun = car(expr); args = cdr(expr); /* evaluate the first expression */ if ((fun = xleval(fun)) == NIL) xlfail("bad function"); /* evaluate the function */ if (subrp(fun) || fsubrp(fun)) { if (subrp(fun)) args = xlevlist(args); val = (*getsubr(fun))(args); } else if (consp(fun)) { if (consp(car(fun))) { env = cdr(fun); fun = car(fun); } else env = xlenv; if ((type = car(fun)) == s_lambda) { args = xlevlist(args); val = evfun(fun,args,env); } else if (type == s_macro) { args = evfun(fun,args,env); val = xleval(args); } else xlfail("bad function type"); } else if (objectp(fun)) val = xlsend(fun,args); else xlfail("bad function"); /* restore the previous stack frame */ xlstack = oldstk; /* return the result value */ return (val); }
//--------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); }