Ejemplo n.º 1
0
Archivo: mlis.c Proyecto: kzfm1024/misc
//--------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);
}
Ejemplo n.º 2
0
Archivo: mono.c Proyecto: kmizumar/Mono
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);
}
Ejemplo n.º 3
0
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());
}
Ejemplo n.º 4
0
Archivo: mono.c Proyecto: kmizumar/Mono
//環境はリストになっていて次のよう。
// 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);
}
Ejemplo n.º 5
0
//--------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);
}
Ejemplo n.º 6
0
Archivo: mono.c Proyecto: kmizumar/Mono
int symnamep(int addr, char *name){
        if(HAS_NAME(addr,name))
        return(1);
    else
        return(0);
}