SCM SCM_prin (SCM x) {
if ( SCM_FixnumP(x) ) {
fprintf(stdout,"%ld",SCM_Fixnum2int(x));
} else {
switch SCM_2tag(x) {
case SCM_NULL_TAG: {
fprintf(stdout,"()");
break;
}
case SCM_PAIR_TAG: {
fprintf(stdout,"(");
SCM_prin(SCM_Car(x));
SCM_prin_list(SCM_cdr(x));
fprintf(stdout,")");
break;
}
case SCM_BOOLEAN_TAG: {
fprintf(stdout,"#%c",(SCM_EqP(x,SCM_true)?'T':'F'));
break;
}
case SCM_UNDEFINED_TAG: {
fprintf(stdout,"#<UFO>");
break;
}
case SCM_SYMBOL_TAG: {
SCM str = SCM_Unwrap(x)->symbol.pname;
char *Cstring = SCM_Unwrap(str)->string.Cstring;
fprintf(stdout,"%s",Cstring);
break;
}
case SCM_STRING_TAG: {
char *Cstring = SCM_Unwrap(x)->string.Cstring;
fprintf(stdout,"\"%s\"",Cstring);
break;
}
case SCM_SUBR_TAG: {
fprintf(stdout,"#<Subr@%p>",(void *)(x));
break;
}
case SCM_CLOSURE_TAG: {
fprintf(stdout,"#<Closure@%p>",(void *)(x));
break;
}
case SCM_ESCAPE_TAG: {
fprintf(stdout,"#<Continuation@%p>",(void *)(x));
break;
}
default:
fprintf(stdout,"#<Something@%p>",(void *)(x));
break;
}
}
return (x);
}
SCM SCM_apply (unsigned long number, va_list arguments) {
SCM args[31];
SCM last_arg;
SCM fun = va_arg(arguments,SCM);
unsigned long i;
for ( i=0 ; i<number-1 ; i++ ) {
args[i] = va_arg(arguments,SCM);
}
last_arg = args[--i];
while ( SCM_PairP(last_arg) ) {
args[i++] = SCM_Car(last_arg);
last_arg = SCM_Cdr(last_arg);
}
if ( ! SCM_NullP(last_arg) ) {
SCM_error(SCM_ERR_APPLY_ARG);
}
switch ( i ) {
case 0: return SCM_invoke(fun,0);
case 1: return SCM_invoke(fun,1,args[0]);
case 2: return SCM_invoke(fun,2,args[0],args[1]);
case 3: return SCM_invoke(fun,3,args[0],args[1],args[2]);
case 4: return SCM_invoke(fun,4,args[0],args[1],args[2],args[3]);
case 5: return SCM_invoke(fun,5,args[0],args[1],args[2],args[3],
args[4]);
case 6: return SCM_invoke(fun,6,args[0],args[1],args[2],args[3],
args[4],args[5]);
case 7: return SCM_invoke(fun,7,args[0],args[1],args[2],args[3],
args[4],args[5],args[6]);
case 8: return SCM_invoke(fun,8,args[0],args[1],args[2],args[3],
args[4],args[5],args[6],args[7]);
case 9: return SCM_invoke(fun,9,args[0],args[1],args[2],args[3],
args[4],args[5],args[6],args[7],args[8]);
case 10: return SCM_invoke(fun,10,args[0],args[1],args[2],args[3],
args[4],args[5],args[6],args[7],args[8],args[9]);
case 11: return SCM_invoke(fun,11,args[0],args[1],args[2],args[3],
args[4],args[5],args[6],args[7],args[8],args[9],
args[10]);
case 12: return SCM_invoke(fun,12,args[0],args[1],args[2],args[3],
args[4],args[5],args[6],args[7],args[8],args[9],
args[10],args[11]);
case 13: return SCM_invoke(fun,13,args[0],args[1],args[2],args[3],
args[4],args[5],args[6],args[7],args[8],args[9],
args[10],args[11],args[12]);
case 14: return SCM_invoke(fun,14,args[0],args[1],args[2],args[3],
args[4],args[5],args[6],args[7],args[8],args[9],
args[10],args[11],args[12],args[13]);
/* If this were less cumbersome, I will add cases up to 31. */
default: return SCM_error(SCM_ERR_APPLY_SIZE);
}
}
SCM SCM_car (SCM x) {
if ( SCM_PairP(x) ) {
return SCM_Car(x);
} else return SCM_error(SCM_ERR_CAR);
}
