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 markcell(int addr){
if(USED_CELL(addr))
return;
MARK_CELL(addr);
if(car(addr) != 0)
markcell(car(addr));
if(cdr(addr) != 0)
markcell(cdr(addr));
if((GET_BIND(addr) != 0) && (IS_FUNC(addr)))
markcell(GET_BIND(addr));
}
int hygienic_namep(int sym){
int addr;
if(symbolp(sym) && IS_HYGIENIC(GET_BIND(sym)))
return(1);
else
if(identifierp(sym)){
addr = identifier_to_symbol(sym);
if(IS_HYGIENIC(GET_BIND(addr)))
return(1);
else
return(0);
}
else
return(0);
}
//マクロの名前かどうか？
int macro_namep(int sym){
int addr;
if(symbolp(sym) && IS_MACRO(GET_BIND(sym)))
return(1);
else
if(identifierp(sym)){
addr = identifier_to_symbol(sym);
if(IS_MACRO(GET_BIND(addr)))
return(1);
else
return(0);
}
else
return(0);
}
int apply(int func, int args){
int symaddr,lamlis,body,res;
symaddr = findsym(func);
if(symaddr == 0)
error(CANT_FIND_ERR, "apply", func);
else {
switch(GET_TAG(symaddr)){
case SUBR: return((GET_SUBR(symaddr))(args));
case FSUBR: return((GET_SUBR(symaddr))(args));
case LAMBDA: { lamlis = car(GET_BIND(symaddr));
body = cdr(GET_BIND(symaddr));
bindarg(lamlis,args);
while(!(IS_NIL(body))){
res = eval(car(body));
body = cdr(body);
}
unbind();
return(res); }
}
}
}
int apply(int func, int args){
int symaddr,varlist,body,res;
symaddr = findsym(func);
if(symaddr == -1)
error(CANT_FIND_ERR, "apply", func);
else {
switch(GET_TAG(symaddr)){
case SUBR: return((GET_SUBR(symaddr))(args));
case FSUBR: return((GET_SUBR(symaddr))(args));
case FUNC: { varlist = car(GET_BIND(symaddr));
body = cdr(GET_BIND(symaddr));
bindarg(varlist,args);
while(!(IS_NIL(body))){
res = eval(car(body));
body = cdr(body);
}
unbind();
return(res); }
default: error(ILLEGAL_OBJ_ERR, "eval", symaddr);
}
}
return(0);
}
//デバッグ用
void cellprint(int addr){
switch(GET_TAG(addr)){
case EMP: printf("EMP "); break;
case NUM: printf("NUM "); break;
case SYM: printf("SYM "); break;
case LIS: printf("LIS "); break;
case FUN: printf("FUN "); break;
}
printf("name=%s ", GET_NAME(addr));
printf("car=%d ", GET_CAR(addr));
printf("cdr=%d ", GET_CDR(addr));
printf("num=%d ", GET_NUMBER(addr));
printf("bind=&d ", GET_BIND(addr));
printf("subr=%d\n", heap[addr].subr);
}
//--------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);
}
//-------デバッグ用------------------
void cellprint(int addr){
switch(GET_FLAG(addr)){
case FRE: printf("FRE "); break;
case USE: printf("USE "); break;
}
switch(GET_TAG(addr)){
case EMP: printf("EMP "); break;
case NUM: printf("NUM "); break;
case SYM: printf("SYM "); break;
case LIS: printf("LIS "); break;
case SUBR: printf("SUBR "); break;
case FSUBR: printf("FSUBR "); break;
case FUNC: printf("FUNC "); break;
}
printf("%07d ", GET_CAR(addr));
printf("%07d ", GET_CDR(addr));
printf("%07d ", GET_BIND(addr));
printf("%s \n", GET_NAME(addr));
}
//-------デバッグ用------------------
void cellprint(int addr){
switch(GET_FLAG(addr)){
case FRE: printf("FRE "); break;
case USE: printf("USE "); break;
}
switch(GET_TAG(addr)){
case EMP: printf("EMP "); break;
case NUM: printf("NUM "); break;
case SYM: printf("SYM "); break;
case LIS: printf("LIS "); break;
case SUBR: printf("SUBR "); break;
case FSUBR: printf("FSUBR "); break;
case LAMBDA:printf("LAMBDA "); break;
}
printf("car=%d ", GET_CAR(addr));
printf("cdr=%d ", GET_CDR(addr));
printf("bind=%d ", GET_BIND(addr));
printf("name=%s \n", GET_NAME(addr));
}
