summaryrefslogtreecommitdiff
path: root/libguile/programs.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/programs.c')
-rw-r--r--libguile/programs.c71
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 =