1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00

case-lambda* clauses fail to match if too many positionals

* doc/ref/api-procedures.texi (Case-lambda): Expand case-lambda*
  documentation.

* module/ice-9/eval.scm (primitive-eval):
* libguile/eval.c (prepare_boot_closure_env_for_apply): Dispatch to the
  next case-lambda clause if there are too many positionals.

* doc/ref/vm.texi (Function Prologue Instructions):
* libguile/vm-i-system.c (bind-optionals/shuffle-or-br): New
  instruction, like bind-optionals/shuffle but can dispatch to the next
  clause if there are too many positionals.

* module/language/assembly/disassemble.scm (code-annotation):
* module/language/assembly/decompile-bytecode.scm (decode-load-program):
* module/language/assembly/compile-bytecode.scm (compile-bytecode): Add
  case for bind-optionals/shuffle-or-br.
* module/language/glil/compile-assembly.scm (glil->assembly): If there
  is an alternate, use bind-optionals/shuffle-or-br instead of
  bind-optionals/shuffle.

* test-suite/tests/optargs.test ("case-lambda*"): Add tests.
This commit is contained in:
Andy Wingo 2013-01-14 11:38:09 +01:00
parent 18c5bffe96
commit 581f410fbd
10 changed files with 308 additions and 80 deletions

View file

@ -1,4 +1,4 @@
/* Copyright (C) 2001,2008,2009,2010,2011,2012 Free Software Foundation, Inc.
/* Copyright (C) 2001,2008,2009,2010,2011,2012,2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@ -634,6 +634,8 @@ VM_DEFINE_INSTRUCTION (47, bind_optionals_shuffle, "bind-optionals/shuffle", 6,
NEXT;
}
/* See also bind-optionals/shuffle-or-br below. */
/* 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. */
@ -1630,6 +1632,60 @@ VM_DEFINE_INSTRUCTION (93, assert_nargs_ee_locals, "assert-nargs-ee/locals", 1,
NEXT;
}
/* Like bind-optionals/shuffle, but if there are too many positional
arguments, jumps to the next case-lambda clause. */
VM_DEFINE_INSTRUCTION (94, bind_optionals_shuffle_or_br, "bind-optionals/shuffle-or-br", 9, -1, -1)
{
SCM *walk;
scm_t_ptrdiff nreq, nreq_and_opt, ntotal;
scm_t_int32 offset;
nreq = FETCH () << 8;
nreq += FETCH ();
nreq_and_opt = FETCH () << 8;
nreq_and_opt += FETCH ();
ntotal = FETCH () << 8;
ntotal += FETCH ();
FETCH_OFFSET (offset);
/* look in optionals for first keyword or last positional */
/* starting after the last required positional arg */
walk = fp + nreq;
while (/* while we have args */
walk <= sp
/* and we still have positionals to fill */
&& walk - fp < nreq_and_opt
/* and we haven't reached a keyword yet */
&& !scm_is_keyword (*walk))
/* bind this optional arg (by leaving it in place) */
walk++;
if (/* If we have filled all the positionals */
walk - fp == nreq_and_opt
/* and there are still more arguments */
&& walk <= sp
/* and the next argument is not a keyword, */
&& !scm_is_keyword (*walk))
{
/* Jump to the next case-lambda* clause. */
ip += offset;
}
else
{
/* Otherwise, finish as in bind-optionals/shuffle: shuffle up,
from walk to ntotal */
scm_t_ptrdiff nshuf = sp - walk + 1, i;
sp = (fp - 1) + ntotal + nshuf;
CHECK_OVERFLOW ();
for (i = 0; i < nshuf; i++)
sp[-i] = walk[nshuf-i-1];
/* and fill optionals & keyword args with SCM_UNDEFINED */
while (walk <= (fp - 1) + ntotal)
*walk++ = SCM_UNDEFINED;
}
NEXT;
}
/*
(defun renumber-ops ()