From 742d96af8b41a1601bdf5ef319cabb7305247722 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 7 Nov 2011 01:01:26 +0900 Subject: [PATCH] adding type-num-slots --- lib/chibi/ast.c | 9 ++++++++- lib/chibi/ast.sld | 2 +- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c index 5b70054c..cd997dd4 100644 --- a/lib/chibi/ast.c +++ b/lib/chibi/ast.c @@ -175,9 +175,15 @@ static sexp sexp_type_slots_op (sexp ctx sexp_api_params(self, n), sexp t) { return sexp_type_slots(t); } +static sexp sexp_type_num_slots_op (sexp ctx sexp_api_params(self, n), sexp t) { + sexp_assert_type(ctx, sexp_typep, SEXP_TYPE, t); + return sexp_truep(sexp_type_slots(t)) ? sexp_length(ctx, sexp_type_slots(t)) + : sexp_make_fixnum(sexp_type_field_eq_len_base(t)); +} + static sexp sexp_type_printer_op (sexp ctx sexp_api_params(self, n), sexp t) { sexp_assert_type(ctx, sexp_typep, SEXP_TYPE, t); - return sexp_type_print(t) ? sexp_make_foreign(ctx, "print", 3, 0, (sexp_proc1)sexp_type_print(t), NULL) : SEXP_FALSE; + return sexp_type_print(t) ? sexp_type_print(t) : SEXP_FALSE; } static sexp sexp_object_size (sexp ctx sexp_api_params(self, n), sexp x) { @@ -413,6 +419,7 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) { sexp_define_foreign(ctx, env, "type-name", 1, sexp_type_name_op); sexp_define_foreign(ctx, env, "type-cpl", 1, sexp_type_cpl_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-printer", 1, sexp_type_printer_op); sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size); sexp_define_foreign_opt(ctx, env, "integer->immediate", 2, sexp_integer_to_immediate, SEXP_FALSE); diff --git a/lib/chibi/ast.sld b/lib/chibi/ast.sld index 49da26dd..2be4c90c 100644 --- a/lib/chibi/ast.sld +++ b/lib/chibi/ast.sld @@ -30,7 +30,7 @@ bytecode-name bytecode-literals bytecode-source pair-source pair-source-set! port-line port-line-set! - type-name type-cpl type-parent type-slots type-printer + type-name type-cpl type-parent type-slots type-num-slots type-printer object-size integer->immediate gc string-contains integer->error-string flatten-dot update-free-vars!)