diff options
author | Andy Wingo <wingo@pobox.com> | 2010-04-17 16:03:51 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-04-17 16:03:51 +0200 |
commit | cb2ce548441824fe1284fc80a3a95394a9fc03d0 (patch) | |
tree | 1b64e72c2ae227b03ea1b24a5033f67ba70744fe /libguile/programs.c | |
parent | 1e23b461ecd25c582dd0b10ebb1d7fd22f5e5ec4 (diff) | |
download | guile-cb2ce548441824fe1284fc80a3a95394a9fc03d0.tar.gz |
add procedure_minimum_arity
* libguile/procprop.h:
* libguile/procprop.c (scm_procedure_minimum_arity): New public
function, will replace (procedure-property foo 'arity).
* libguile/programs.c (scm_i_program_arity): Rework to always provide
the most permissive arity.
Diffstat (limited to 'libguile/programs.c')
-rw-r--r-- | libguile/programs.c | 52 |
1 files changed, 35 insertions, 17 deletions
diff --git a/libguile/programs.c b/libguile/programs.c index 70c399ba8..12baf68b6 100644 --- a/libguile/programs.c +++ b/libguile/programs.c @@ -334,21 +334,12 @@ SCM_DEFINE (scm_program_objcode, "program-objcode", 1, 0, 0, } #undef FUNC_NAME -/* This one is a shim to pre-case-lambda internal interfaces. Avoid it if you - can -- use program-arguments or the like. */ -static SCM sym_arglist; -int -scm_i_program_arity (SCM program, int *req, int *opt, int *rest) +/* procedure-minimum-arity support. */ +static void +parse_arity (SCM arity, int *req, int *opt, int *rest) { - SCM arities, x; + SCM x = scm_cddr (arity); - arities = scm_program_arities (program); - if (!scm_is_pair (arities)) - return 0; - /* take the last arglist, it will be least specific */ - while (scm_is_pair (scm_cdr (arities))) - arities = scm_cdr (arities); - x = scm_cddar (arities); if (scm_is_pair (x)) { *req = scm_to_int (scm_car (x)); @@ -367,7 +358,37 @@ scm_i_program_arity (SCM program, int *req, int *opt, int *rest) } else *req = *opt = *rest = 0; - +} + +int +scm_i_program_arity (SCM program, int *req, int *opt, int *rest) +{ + SCM arities; + + arities = scm_program_arities (program); + if (!scm_is_pair (arities)) + return 0; + + parse_arity (scm_car (arities), req, opt, rest); + arities = scm_cdr (arities); + + for (; scm_is_pair (arities); arities = scm_cdr (arities)) + { + int thisreq, thisopt, thisrest; + + parse_arity (scm_car (arities), &thisreq, &thisopt, &thisrest); + + if (thisreq < *req + || (thisreq == *req + && ((thisrest && (!*rest || thisopt > *opt)) + || (!thisrest && !*rest && thisopt > *opt)))) + { + *req = thisreq; + *opt = thisopt; + *rest = thisrest; + } + } + return 1; } @@ -376,9 +397,6 @@ scm_i_program_arity (SCM program, int *req, int *opt, int *rest) void scm_bootstrap_programs (void) { - /* arglist can't be snarfed, because snarfage is only loaded when (system vm - program) is loaded. perhaps static-alloc will fix this. */ - sym_arglist = scm_from_locale_symbol ("arglist"); scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, "scm_init_programs", (scm_t_extension_init_func)scm_init_programs, NULL); |