diff options
Diffstat (limited to 'libguile/programs.c')
-rw-r--r-- | libguile/programs.c | 71 |
1 files changed, 58 insertions, 13 deletions
diff --git a/libguile/programs.c b/libguile/programs.c index 49d4c77b1..ba8e8546b 100644 --- a/libguile/programs.c +++ b/libguile/programs.c @@ -22,6 +22,7 @@ #include <string.h> #include "_scm.h" +#include "instructions.h" #include "modules.h" #include "programs.h" #include "procprop.h" /* scm_sym_name */ @@ -236,25 +237,69 @@ SCM_DEFINE (scm_program_free_variable_set_x, "program-free-variable-set!", 3, 0, } #undef FUNC_NAME +/* It's hacky, but it manages to cover all of the non-keyword cases. */ +static int +try_parse_arity (SCM program, int *req, int *opt, int *rest) +{ + scm_t_uint32 *code = SCM_PROGRAM_CODE (program); + scm_t_uint32 slots, min; + + switch (code[0] & 0xff) { + case scm_op_assert_nargs_ee: + slots = code[0] >> 8; + *req = slots - 1; + *opt = 0; + *rest = 0; + return 1; + case scm_op_assert_nargs_le: + slots = code[0] >> 8; + *req = 0; + *opt = slots - 1; + *rest = 0; + return 1; + case scm_op_bind_rest: + slots = code[0] >> 8; + *req = 0; + *opt = slots - 1; + *rest = 1; + return 1; + case scm_op_assert_nargs_ge: + min = code[0] >> 8; + switch (code[1] & 0xff) { + case scm_op_assert_nargs_le: + slots = code[1] >> 8; + *req = min - 1; + *opt = slots - 1 - *req; + *rest = 0; + return 1; + case scm_op_bind_rest: + slots = code[1] >> 8; + *req = min - 1; + *opt = slots - min; + *rest = 1; + return 1; + default: + return 0; + } + case scm_op_continuation_call: + case scm_op_compose_continuation: + *req = 0; + *opt = 0; + *rest = 1; + return 1; + default: + return 0; + } +} + int scm_i_program_arity (SCM program, int *req, int *opt, int *rest) { static SCM program_minimum_arity = SCM_BOOL_F; SCM l; - if (SCM_PRIMITIVE_P (program)) - return scm_i_primitive_arity (program, req, opt, rest); - - if (SCM_PROGRAM_IS_FOREIGN (program)) - return scm_i_foreign_arity (program, req, opt, rest); - - if (SCM_PROGRAM_IS_CONTINUATION (program) - || SCM_PROGRAM_IS_PARTIAL_CONTINUATION (program)) - { - *req = *opt = 0; - *rest = 1; - return 1; - } + if (try_parse_arity (program, req, opt, rest)) + return 1; if (scm_is_false (program_minimum_arity) && scm_module_system_booted_p) program_minimum_arity = |