From 38685f6aca732c4f745d28678d5a4a6485669a1d Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sat, 31 Aug 2013 20:02:39 +0900 Subject: [PATCH] Adding procedure-arity and procedure-variadic?. --- lib/chibi/ast.c | 12 ++++++++++++ lib/chibi/ast.sld | 1 + 2 files changed, 13 insertions(+) diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c index 90b04c4b..8e48aa3d 100644 --- a/lib/chibi/ast.c +++ b/lib/chibi/ast.c @@ -65,6 +65,16 @@ static sexp sexp_get_procedure_vars (sexp ctx, sexp self, sexp_sint_t n, sexp pr return sexp_procedure_vars(proc); } +static sexp sexp_get_procedure_arity (sexp ctx, sexp self, sexp_sint_t n, sexp proc) { + sexp_assert_type(ctx, sexp_procedurep, SEXP_PROCEDURE, proc); + return sexp_make_fixnum(sexp_procedure_num_args(proc)); +} + +static sexp sexp_get_procedure_variadic_p (sexp ctx, sexp self, sexp_sint_t n, sexp proc) { + sexp_assert_type(ctx, sexp_procedurep, SEXP_PROCEDURE, proc); + return sexp_make_boolean(sexp_procedure_variadic_p(proc)); +} + static sexp sexp_get_opcode_name (sexp ctx, sexp self, sexp_sint_t n, sexp op) { if (! sexp_opcodep(op)) return sexp_type_exception(ctx, self, SEXP_OPCODE, op); @@ -555,6 +565,8 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char sexp_define_accessors(ctx, env, SEXP_MACRO, 2, "macro-source", NULL); sexp_define_foreign(ctx, env, "procedure-code", 1, sexp_get_procedure_code); sexp_define_foreign(ctx, env, "procedure-vars", 1, sexp_get_procedure_vars); + sexp_define_foreign(ctx, env, "procedure-arity", 1, sexp_get_procedure_arity); + sexp_define_foreign(ctx, env, "procedure-variadic?", 1, sexp_get_procedure_variadic_p); sexp_define_foreign(ctx, env, "copy-lambda", 1, sexp_copy_lambda); sexp_define_foreign_opt(ctx, env, "make-lambda", 4, sexp_make_lambda_op, SEXP_NULL); sexp_define_foreign_opt(ctx, env, "make-cnd", 3, sexp_make_cnd_op, SEXP_VOID); diff --git a/lib/chibi/ast.sld b/lib/chibi/ast.sld index ac6b3798..a50730f2 100644 --- a/lib/chibi/ast.sld +++ b/lib/chibi/ast.sld @@ -28,6 +28,7 @@ opcode-class opcode-code opcode-data opcode-variadic? macro-procedure macro-env macro-source procedure-code procedure-vars procedure-name procedure-name-set! + procedure-arity procedure-variadic? bytecode-name bytecode-literals bytecode-source port-line port-line-set! extend-env env-parent env-parent-set! env-lambda env-lambda-set!