diff options
author | Andy Wingo <wingo@pobox.com> | 2009-11-16 22:32:54 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-11-16 22:32:54 +0100 |
commit | ff74e44ecba55f50b2c2c84bad2f13bed9489455 (patch) | |
tree | 005790d41437107aadd115332cb3038392378777 /libguile/vm-i-system.c | |
parent | 222831b443a14dd58ef646e8b313a38c38237f69 (diff) | |
download | guile-ff74e44ecba55f50b2c2c84bad2f13bed9489455.tar.gz |
with a rest arg, allow for keywords anywhere
* libguile/vm-i-system.c (br-if-nargs-gt): Fix variable declaration
placement.
(bind-kwargs): Patch mostly by Ludovic: it seems that in the mode in
which we have rest args, the keywords can appear anywhere. Bummer.
Change to allow for this.
* module/ice-9/optargs.scm (parse-lambda-case): Same, add a
permissive-keys clause that handles the case in which there's a rest
argument.
Diffstat (limited to 'libguile/vm-i-system.c')
-rw-r--r-- | libguile/vm-i-system.c | 68 |
1 files changed, 40 insertions, 28 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 8383a12af..205771924 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -537,9 +537,10 @@ VM_DEFINE_INSTRUCTION (42, br_if_nargs_lt, "br-if-nargs-lt", 5, 0, 0) VM_DEFINE_INSTRUCTION (43, br_if_nargs_gt, "br-if-nargs-gt", 5, 0, 0) { scm_t_ptrdiff n; + scm_t_int32 offset; + n = FETCH () << 8; n += FETCH (); - scm_t_int32 offset; FETCH_OFFSET (offset); if (sp - (fp - 1) > n) ip += offset; @@ -613,54 +614,65 @@ VM_DEFINE_INSTRUCTION (47, bind_optionals_shuffle, "bind-optionals/shuffle", 6, NEXT; } +/* Flags that determine whether other keywords are allowed, and whether a + rest argument is expected. These values must match those used by the + glil->assembly compiler. */ +#define F_ALLOW_OTHER_KEYS 1 +#define F_REST 2 + VM_DEFINE_INSTRUCTION (48, bind_kwargs, "bind-kwargs", 5, 0, 0) { scm_t_uint16 idx; scm_t_ptrdiff nkw; - int allow_other_keys_and_rest; + int kw_and_rest_flags; SCM kw; idx = FETCH () << 8; idx += FETCH (); + /* XXX: We don't actually use NKW. */ nkw = FETCH () << 8; nkw += FETCH (); - allow_other_keys_and_rest = FETCH (); + kw_and_rest_flags = FETCH (); - if (!(allow_other_keys_and_rest & 2) - &&(sp - (fp - 1) - nkw) % 2) + if (!(kw_and_rest_flags & F_REST) + && ((sp - (fp - 1) - nkw) % 2)) goto vm_error_kwargs_length_not_even; CHECK_OBJECT (idx); kw = OBJECT_REF (idx); - /* switch nkw to be a negative index below sp */ - for (nkw = -(sp - (fp - 1) - nkw) + 1; nkw < 0; nkw += 2) + + /* Switch NKW to be a negative index below SP. */ + for (nkw = -(sp - (fp - 1) - nkw) + 1; nkw < 0; nkw++) { SCM walk; - if (!scm_is_keyword (sp[nkw])) - { - if (allow_other_keys_and_rest & 2) - /* reached the end of keywords, but we have a rest arg; just cut - out */ - break; - else - goto vm_error_kwargs_invalid_keyword; - } - for (walk = kw; scm_is_pair (walk); walk = SCM_CDR (walk)) - { - if (scm_is_eq (SCM_CAAR (walk), sp[nkw])) - { - SCM si = SCM_CDAR (walk); - LOCAL_SET (SCM_I_INUMP (si) ? SCM_I_INUM (si) : scm_to_long (si), - sp[nkw + 1]); - break; - } - } - if (!(allow_other_keys_and_rest & 1) && !scm_is_pair (walk)) - goto vm_error_kwargs_unrecognized_keyword; + + if (scm_is_keyword (sp[nkw])) + { + for (walk = kw; scm_is_pair (walk); walk = SCM_CDR (walk)) + { + if (scm_is_eq (SCM_CAAR (walk), sp[nkw])) + { + SCM si = SCM_CDAR (walk); + LOCAL_SET (SCM_I_INUMP (si) ? SCM_I_INUM (si) : scm_to_long (si), + sp[nkw + 1]); + break; + } + } + if (!(kw_and_rest_flags & F_ALLOW_OTHER_KEYS) && !scm_is_pair (walk)) + goto vm_error_kwargs_unrecognized_keyword; + + nkw++; + } + else if (!(kw_and_rest_flags & F_REST)) + goto vm_error_kwargs_invalid_keyword; } NEXT; } +#undef F_ALLOW_OTHER_KEYS +#undef F_REST + + VM_DEFINE_INSTRUCTION (49, push_rest, "push-rest", 2, -1, -1) { scm_t_ptrdiff n; |