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)); }