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