/* 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; 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); }
/* xlapply - apply a function to a list of arguments */ NODE *xlapply(NODE *fun,NODE *args) { NODE *env,*val; val = 0; //BUG: uninitialized variable is used if xlfail returns /* check for a null function */ if (fun == NIL) xlfail("bad function"); /* evaluate the function */ if (subrp(fun)) val = (*getsubr(fun))(args); else if (consp(fun)) { if (consp(car(fun))) { env = cdr(fun); fun = car(fun); } else env = xlenv; if (car(fun) != s_lambda) xlfail("bad function type"); val = evfun(fun,args,env); } else xlfail("bad function"); /* return the result value */ return (val); }
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); }
/* check an item instance variable */ static LVAL check_item_ivar P2C(int, which, LVAL, value) { int good=0; switch (which) { case 'T': good = (stringp(value) && strlen(getstring(value)) != 0); break; case 'K': good = (charp(value) || value == NIL); break; case 'M': good = (charp(value) || value == NIL || value == s_true); break; case 'S': good = (symbolp(value) || listp(value)); break; case 'A': good = (value == NIL || symbolp(value) || closurep(value) || subrp(value) || (bcclosurep(value))); break; case 'E': good = TRUE; value = (value != NIL) ? s_true : NIL; break; default: xlfail("unknown item instance variable"); } if (! good) xlerror("bad instance variable value", value); return(value); }
//--------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); }