//--------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);
}
int f_regsetq(int arglist){
int arg1,arg2;
checkarg(LEN2_TEST, "regsetq", arglist);
checkarg(SYMBOL_TEST, "regsetq", car(arglist));
arg1 = car(arglist);
arg2 = cadr(arglist);
if(HAS_NAME(arg1,"H"))
H = GET_NUMBER(arg2);
else
if(HAS_NAME(arg1,"E"))
E = GET_NUMBER(arg2);
else
if(HAS_NAME(arg1,"F"))
F = GET_NUMBER(arg2);
else
if(HAS_NAME(arg1,"S"))
S = GET_NUMBER(arg2);
else
if(HAS_NAME(arg1,"C"))
C = GET_NUMBER(arg2);
else
if(HAS_NAME(arg1,"A"))
A = GET_NUMBER(arg2);
else
if(HAS_NAME(arg1,"P"))
P = GET_NUMBER(arg2);
return(makeT());
}
//環境はリストになっていて次のよう。
// env = (sym1 sym2 ...nil)
//数ならtagに値の型を入れて、それに対応した値をnum=数、
//bind=シンボルのアドレスあるいはリストのアドレスをいれておく。
// nilは必ず0番地に割り当てられるので0番地までを手繰ればいい。
int findsym(char *name){
int addr;
addr = E;
while(addr != 0){
if(HAS_NAME(addr,name))
return(addr);
else
addr = GET_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 symnamep(int addr, char *name){
if(HAS_NAME(addr,name))
return(1);
else
return(0);
}