object *is_input_port_proc(object *arguments) { return make_boolean(is_input_port(car(arguments))); }
void lisp_print(object exp, FILE *out) { unsigned long i, len; char c; char *str; object *vptr; switch (type_of(exp)) { case T_NIL: fprintf(out, "()"); break; case T_FIXNUM: fprintf(out, "%ld", fixnum_value(exp)); break; case T_CHARACTER: c = character_value(exp); fprintf(out, "#\\"); switch (c) { case '\n': fprintf(out, "newline"); break; case ' ': fprintf(out, "space"); break; default: fprintf(out, "%c", c); } break; case T_PAIR: if (is_finite_list(exp, NULL)) { fprintf(out, "("); write_pair(exp, out); fprintf(out, ")"); } else { fprintf(out, "#<unprintable-structure>"); } break; case T_BOOLEAN: fprintf(out, is_false(exp) ? "#f" : "#t"); break; case T_STRING: fprintf(out, "\""); str = string_value(exp); len = string_length(exp); for (i = 0; i < len; i++) { switch (str[i]) { case '\n': fprintf(out, "\\n"); break; case '"': fprintf(out, "\\\""); break; case '\\': fprintf(out, "\\\\"); break; default: fprintf(out, "%c", str[i]); } } fprintf(out, "\""); break; case T_VECTOR: fprintf(out, "#("); len = vector_length(exp); vptr = vector_ptr(exp); for (i = 0; i < len; i++) { if (i) fputc(' ', out); lisp_print(*vptr++, out); } fprintf(out, ")"); break; case T_SYMBOL: fprintf(out, "%.*s", (int) string_length(symbol_string(exp)), string_value(symbol_string(exp))); break; case T_FOREIGN_PTR: fprintf(out, "#<foreign-pointer %p>", foreign_ptr_value(exp)); break; case T_PRIMITIVE: fprintf(out, "#<primitive-procedure %p>", primitive_implementation(exp)); break; case T_PROCEDURE: fprintf(out, "#<procedure "); lisp_print(procedure_parameters(exp), out); fprintf(out, ">"); break; case T_EOF: fprintf(out, "#<eof>"); break; case T_PORT: fprintf(out, "#<%s-port %p>", is_input_port(exp) ? "input" : "output", port_implementation(exp)); break; case T_UNSPECIFIED: /* actually, I could read this back... */ fprintf(out, "#<unspecified>"); break; case T_MACRO: fprintf(out, "#<macro "); lisp_print(macro_parameters(exp), out); fprintf(out, ">"); break; case T_MAX_TYPE: break; } }