Esempio n. 1
0
object *is_input_port_proc(object *arguments) {
    return make_boolean(is_input_port(car(arguments)));
}
Esempio n. 2
0
File: io.c Progetto: cmatei/yalfs
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;
	}
}