[Guile-commits] GNU Guile branch, master, updated. release_1-9-4-139-gff74e44

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=ff74e44ecba55f50b2c2c84bad2f13bed9489455

The branch, master has been updated
       via  ff74e44ecba55f50b2c2c84bad2f13bed9489455 (commit)
      from  222831b443a14dd58ef646e8b313a38c38237f69 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit ff74e44ecba55f50b2c2c84bad2f13bed9489455
Author: Andy Wingo <address@hidden>
Date:   Mon Nov 16 22:32:54 2009 +0100

    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.

-----------------------------------------------------------------------

Summary of changes:
 libguile/vm-i-system.c   |   68 +++++++++++++++++++++++++++-------------------
 module/ice-9/optargs.scm |   24 +++++++++++++++-
 2 files changed, 63 insertions(+), 29 deletions(-)

diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 8383a12..2057719 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;
diff --git a/module/ice-9/optargs.scm b/module/ice-9/optargs.scm
index 22dfa9f..5ad9e81 100644
--- a/module/ice-9/optargs.scm
+++ b/module/ice-9/optargs.scm
@@ -311,7 +311,7 @@
          ;; it has to be this way, vars are allocated in this order
          (set-car! slots-tail args-tail)
          (if (pair? kw-indices)
-             (key slots (cdr slots-tail) args-tail inits)
+             (permissive-keys slots (cdr slots-tail) args-tail inits)
              (rest-or-key slots (cdr slots-tail) '() inits #f)))
         ((pair? kw-indices)
          ;; fail early here, because once we're in keyword land we throw
@@ -322,6 +322,28 @@
          #f) ;; fail
         (else
          slots)))
+     (define (permissive-keys slots slots-tail args-tail inits)
+       (cond
+        ((null? args-tail)
+         (if (null? inits)
+             slots
+             (begin
+               (if (eq? (car slots-tail) *uninitialized*)
+                   (set-car! slots-tail (apply (car inits) slots)))
+               (permissive-keys slots (cdr slots-tail) '() (cdr inits)))))
+        ((not (keyword? (car args-tail)))
+         (permissive-keys slots slots-tail (cdr args-tail) inits))
+        ((and (keyword? (car args-tail))
+              (pair? (cdr args-tail))
+              (assq-ref kw-indices (car args-tail)))
+         => (lambda (i)
+              (list-set! slots i (cadr args-tail))
+              (permissive-keys slots slots-tail (cddr args-tail) inits)))
+        ((and (keyword? (car args-tail))
+              (pair? (cdr args-tail))
+              allow-other-keys?)
+         (permissive-keys slots slots-tail (cddr args-tail) inits))
+        (else (error "unrecognized keyword" args-tail))))
      (define (key slots slots-tail args-tail inits)
        (cond
         ((null? args-tail)


hooks/post-receive
-- 
GNU Guile