void print_tree(VALUE tree) { if(NIL_P(tree)) printf("()"); else if(FALSE_P(tree)) printf("#f"); else if(TRUE_P(tree)) printf("#t"); else if(FIXNUM_P(tree)) printf("%ld", FIX2INT(tree)); else if(SYMBOL_P(tree)) printf("%s", SYMBOL_NAME(tree)); else if(CLOSURE_P(tree)) printf("#<closure>"); else if(MACRO_P(tree)) printf("#<macro>"); else if(NATIVE_PROCEDURE_P(tree)) printf("#<subr>"); else if (PAIR_P(tree)) { printf("("); while(1) { print_tree(CAR(tree)); tree = CDR(tree); if(NIL_P(tree)) break; if(DIRECTVAL_P(tree) || SYMBOL_P(tree) || CLOSURE_P(tree) || MACRO_P(tree) || NATIVE_PROCEDURE_P(tree)) { printf(" . "); print_tree(tree); break; } printf(" "); } printf(")"); } else { fprintf(stderr, "print error"); exit(1); } }
/* * <peculiar identifier> + | - | ... * */ static SCM read_number_or_peculiar(FILE *file, int first_char) { SCM number; char *buf = read_word(file, first_char); number = c_string_to_number(buf); if (FALSE_P(number)) { SCM symbol = intern(buf); free(buf); return symbol; } free(buf); return number; }
static void primop_table_p(long argc) { if (TABLE_P(*sp) && FALSE_P(VECTOR_TAG(TABLE_BINDINGS(*sp)))) return; *sp = false_object; }
static void primop_not(long argc) { if (FALSE_P(*sp)) *sp = true_object; else *sp = false_object; }