add type-printer-set! to (chibi ast) (fixes issue #401)

This commit is contained in:
Alex Shinn 2017-03-25 17:52:53 +09:00
parent d482daa106
commit e8c9def652
2 changed files with 10 additions and 1 deletions

View file

@ -311,6 +311,13 @@ sexp sexp_type_printer_op (sexp ctx, sexp self, sexp_sint_t n, sexp t) {
return sexp_type_print(t) ? sexp_type_print(t) : SEXP_FALSE; return sexp_type_print(t) ? sexp_type_print(t) : SEXP_FALSE;
} }
sexp sexp_type_printer_set_op (sexp ctx, sexp self, sexp_sint_t n, sexp t, sexp p) {
sexp_assert_type(ctx, sexp_typep, SEXP_TYPE, t);
sexp_assert_type(ctx, sexp_applicablep, SEXP_PROCEDURE, p);
sexp_type_print(t) = p;
return SEXP_VOID;
}
sexp sexp_object_size (sexp ctx, sexp self, sexp_sint_t n, sexp x) { sexp sexp_object_size (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
sexp t; sexp t;
if ((! sexp_pointerp(x)) || (sexp_pointer_tag(x) >= sexp_context_num_types(ctx))) if ((! sexp_pointerp(x)) || (sexp_pointer_tag(x) >= sexp_context_num_types(ctx)))
@ -677,6 +684,7 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
sexp_define_foreign(ctx, env, "type-slots", 1, sexp_type_slots_op); sexp_define_foreign(ctx, env, "type-slots", 1, sexp_type_slots_op);
sexp_define_foreign(ctx, env, "type-num-slots", 1, sexp_type_num_slots_op); sexp_define_foreign(ctx, env, "type-num-slots", 1, sexp_type_num_slots_op);
sexp_define_foreign(ctx, env, "type-printer", 1, sexp_type_printer_op); sexp_define_foreign(ctx, env, "type-printer", 1, sexp_type_printer_op);
sexp_define_foreign(ctx, env, "type-printer-set!", 2, sexp_type_printer_set_op);
sexp_define_foreign(ctx, env, "env-parent-set!", 2, sexp_env_parent_set_op); sexp_define_foreign(ctx, env, "env-parent-set!", 2, sexp_env_parent_set_op);
sexp_define_foreign(ctx, env, "env-lambda", 1, sexp_env_lambda_op); sexp_define_foreign(ctx, env, "env-lambda", 1, sexp_env_lambda_op);
sexp_define_foreign(ctx, env, "env-lambda-set!", 2, sexp_env_lambda_set_op); sexp_define_foreign(ctx, env, "env-lambda-set!", 2, sexp_env_lambda_set_op);

View file

@ -33,7 +33,8 @@
port-line port-line-set! port-line port-line-set!
extend-env env-parent env-parent-set! env-lambda env-lambda-set! extend-env env-parent env-parent-set! env-lambda env-lambda-set!
env-define! env-push! env-syntactic? env-syntactic?-set! core-code env-define! env-push! env-syntactic? env-syntactic?-set! core-code
type-name type-cpl type-parent type-slots type-num-slots type-printer type-name type-cpl type-parent type-slots type-num-slots
type-printer type-printer-set!
object-size object->integer integer->immediate gc gc-usecs gc-count object-size object->integer integer->immediate gc gc-usecs gc-count
atomically thread-list abort atomically thread-list abort
string-contains string-cursor-copy! errno integer->error-string string-contains string-cursor-copy! errno integer->error-string