case-lambda* question

case-lambda* question

[Daniel Llorens]

(define f
	(case-lambda*
		((a b c #:key x) 3)
		((a #:key x) 1)))

scheme@(guile-user)> (g 0 #:x 1)
$1 = 3

The manual says

> Also, for completeness. Guile defines case-lambda* as well, which is like case-lambda, except with lambda* clauses. A case-lambda* clause matches if the arguments fill the required arguments, but are not too many for the optional and/or rest arguments.
> 
> Keyword arguments are possible with case-lambda*, but they do not contribute to the “matching” behavior. That is to say, case-lambda* matches only on required, optional, and rest arguments, and on the predicate; keyword arguments may be present but do not contribute to the “success” of a match. In fact a bad keyword argument list may cause an error to be raised.

I see that it gives 3 because ‘a b c’ matches ‘0 #:x 1’, so it's counting #:x as an ‘argument’ by itself. This is not what I expected from the description above. I think that the description should make clear that each item in the arg list is counted as an argument for the purposes of matching.

Moreover I think this behavior makes case-lambda* fairly useless, or even treacherous. I wonder what other people think.

Regards,

	Daniel

 

Re: case-lambda* question

[Daniel Hartwig]

On 12 November 2012 21:54, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:
>
> (define f
>         (case-lambda*
>                 ((a b c #:key x) 3)
>                 ((a #:key x) 1)))
>
> scheme@(guile-user)> (g 0 #:x 1)
> $1 = 3

Because “0 #:x 1” is a valid match for “a b c”, you should rearrange
the case-lambda clauses.

When the doc. states keyword arguments do not contribute to the
success of a match, it refers only to keyword arguments in the
case-lambda clause, not at the call site.  This makes sense, otherwise
it would inhibit writing functions that detect keywords internally
from their rest arguments.

scheme@(guile-user)> (define g
                       (case-lambda*
                        ((a #:key x) 1)
                        ((a b c #:key x) 3)))
scheme@(guile-user)> (g 0 #:x 1)
$2 = 1

However, trying to call with three arguments then triggers an error,
and I am not sure why:

scheme@(guile-user)> (g 1 2 3)
<unnamed port>:46:1: In procedure g:
<unnamed port>:46:1: In procedure #<procedure g (a #:key x) | (a b c
#:key x)>: Invalid keyword

Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
scheme@(guile-user) [1]> ,bt
In current input:
     46:1  0 (g 1 #<undefined> 2 3)

Definitely you need to rearrange the clauses.  About this error, I don't know!

Regards

Re: case-lambda* question

[Germán A. Arias]

El mar, 13-11-2012 a las 10:46 +0800, Daniel Hartwig escribió:
> 
> However, trying to call with three arguments then triggers an error,
> and I am not sure why:
> 
> scheme@(guile-user)> (g 1 2 3)
> <unnamed port>:46:1: In procedure g:
> <unnamed port>:46:1: In procedure #<procedure g (a #:key x) | (a b c
> #:key x)>: Invalid keyword
> 
> Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
> scheme@(guile-user) [1]> ,bt
> In current input:
>      46:1  0 (g 1 #<undefined> 2 3)
> 
> Definitely you need to rearrange the clauses.  About this error, I don't know!
> 
> Regards
> 

This should be a bug. I tried with the example at test tree-il.test
(line 1073) but I get the same error. Unfortunately I can't run the
guile-test, I get the error:

In ice-9/boot-9.scm:
2681: 3 [define-module* (test-suite guile-test) #:filename ...]
2656: 2 [resolve-imports ((#) (#) (#) (#) ...)]
2597: 1 [resolve-interface (test-suite lib) #:select ...]
In unknown file:
   ?: 0 [scm-error misc-error #f "~A ~S" ("no code for
module" (test-suite lib)) #f]

ERROR: In procedure scm-error:
ERROR: no code for module (test-suite lib)

Re: case-lambda* question

[Daniel Llorens]

On Nov 13, 2012, at 03:46, Daniel Hartwig wrote:

> On 12 November 2012 21:54, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:
>> 
>> (define f
>>        (case-lambda*
>>                ((a b c #:key x) 3)
>>                ((a #:key x) 1)))
>> 
>> scheme@(guile-user)> (g 0 #:x 1)
>> $1 = 3
> 
> Because “0 #:x 1” is a valid match for “a b c”, you should rearrange
> the case-lambda clauses.
> 
> When the doc. states keyword arguments do not contribute to the
> success of a match, it refers only to keyword arguments in the
> case-lambda clause, not at the call site.  This makes sense, otherwise
> it would inhibit writing functions that detect keywords internally
> from their rest arguments.

Do you mean something like this?

(define* (f a #:key x) x)
(define (g . args) (apply f args))
(g 0) -> #f
(g 0 #:x #t) -> #t

i.e. g must accept being called with 3 'arguments' so that it can forward the keyword args. 

> scheme@(guile-user)> (define g
>                       (case-lambda*
>                        ((a #:key x) 1)
>                        ((a b c #:key x) 3)))
> scheme@(guile-user)> (g 0 #:x 1)
> $2 = 1
> 
> However, trying to call with three arguments then triggers an error,
> and I am not sure why:
> 
> scheme@(guile-user)> (g 1 2 3)
> <unnamed port>:46:1: In procedure g:
> <unnamed port>:46:1: In procedure #<procedure g (a #:key x) | (a b c
> #:key x)>: Invalid keyword

I saw this error too, but I thought it was the same logic as the other case, where '1 2 3' = 3 arguments, so it matches 'a #:key x', just as '0 #:x 1' matches 'a b c'. I think I see the difference now, but I still find the manual unclear, it should at least give some examples of the edge cases.

On Nov 14, 2012, at 01:55, Germán A. Arias wrote:

> This should be a bug. I tried with the example at test tree-il.test
> (line 1073) but I get the same error. [...]


Is this the test?

(pass-if "case-lambda*"
       (null? (call-with-warnings
                (lambda ()
                  (compile '(let ((f (case-lambda*
                                       ((x #:optional y) 1)
                                       ((x #:key y)      2)
                                       ((x y #:key z)    3))))
                              (list (f 1)
                                    (f 1 2)
                                    (f #:y 2)
                                    (f 1 2 #:z 3)))
                           #:opts %opts-w-arity
                           #:to 'assembly)))))

I also get an error here. Strangely, I can run make check without anything being reported. I get a warning 

UNRESOLVED: tree-il.test: warnings: unused-toplevel: used by macro

But I still don't understand how case-lambda* works or should work. The error is in the last call (f 1 2 #:z 3). If I remove it I get '(1 1 1), but how can (f #:y 2) match (x #:optional y) ??

I'm running acc1d8… but this test has been in there since 2009 apparently.

Re: case-lambda* question

[Germán A. Arias]

El mié, 14-11-2012 a las 11:20 +0100, Daniel Llorens escribió:
> 
> Is this the test?
> 
> (pass-if "case-lambda*"
>        (null? (call-with-warnings
>                 (lambda ()
>                   (compile '(let ((f (case-lambda*
>                                        ((x #:optional y) 1)
>                                        ((x #:key y)      2)
>                                        ((x y #:key z)    3))))
>                               (list (f 1)
>                                     (f 1 2)
>                                     (f #:y 2)
>                                     (f 1 2 #:z 3)))
>                            #:opts %opts-w-arity
>                            #:to 'assembly)))))
> 

Right.

> I also get an error here. Strangely, I can run make check without anything being reported. I get a warning 
> 
> UNRESOLVED: tree-il.test: warnings: unused-toplevel: used by macro

I can run now the tests, and this test in particular passes without
problem. But I don't know why.

> 
> But I still don't understand how case-lambda* works or should work. The error is in the last call (f 1 2 #:z 3). If I remove it I get '(1 1 1), but how can (f #:y 2) match (x #:optional y) ??
> 
> I'm running acc1d8… but this test has been in there since 2009 apparently.
> 

Re: case-lambda* question

[Germán A. Arias]

Running this.

  (define f (case-lambda*
              ((x #:optional y) 1)
	     ((x #:key y)      2)
	     ((x y #:key z)    3)))

  (f 1 2)
  (f #:y 2)
  (f 1 2 #:z 3)

I get.

Backtrace:
In ice-9/boot-9.scm:
 157: 7 [catch #t #<catch-closure 8f15df0> ...]
In unknown file:
   ?: 6 [apply-smob/1 #<catch-closure 8f15df0>]
In ice-9/boot-9.scm:
  63: 5 [call-with-prompt prompt0 ...]
In ice-9/eval.scm:
 414: 4 [eval # #]
In ice-9/boot-9.scm:
2131: 3 [save-module-excursion #<procedure 8ed31c0 at
ice-9/boot-9.scm:3660:3 ()>]
3667: 2 [#<procedure 8ed31c0 at ice-9/boot-9.scm:3660:3 ()>]
In unknown file:
   ?: 1 [load-compiled/vm
"/home/german/.cache/guile/ccache/2.0-LE-4-2.0/home/german/Escritorio/test.scm.go"]
In /home/german/Escritorio/./test.scm:
   3: 0 [f 1 #<undefined> 2 #:z 3]

/home/german/Escritorio/./test.scm:3:10: In procedure f:
/home/german/Escritorio/./test.scm:3:10: In procedure #<procedure f (x
#:optional y) | (x #:key y) | (x y #:key z)>: Odd length of keyword
argument list

But there is one interest line

3: 0 [f 1 #<undefined> 2 #:z 3]

What mean this? That is taking the second argument as a keyword?

Re: case-lambda* question

[Daniel Hartwig]

On 14 November 2012 18:20, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:
>> When the doc. states keyword arguments do not contribute to the
>> success of a match, it refers only to keyword arguments in the
>> case-lambda clause, not at the call site.  This makes sense, otherwise
>> it would inhibit writing functions that detect keywords internally
>> from their rest arguments.
>
> Do you mean something like this?
>
> (define* (f a #:key x) x)
> (define (g . args) (apply f args))
> (g 0) -> #f
> (g 0 #:x #t) -> #t
>
> i.e. g must accept being called with 3 'arguments' so that it can forward the keyword args.

I was thinking of:

(define f
  (case-lambda*
   ((a . rest)
    (if (memq #:x rest) …

where #:x is picked up from inside rest.

Based on the other error, I'd say that any case-lambda* with keyword
arguments is matched with a rest argument instead, i.e. “a #:key x” is
treated as “a . rest”.

Re: case-lambda* question

[Daniel Llorens]

On Nov 15, 2012, at 02:22, Daniel Hartwig wrote:

> On 14 November 2012 18:20, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:
>>> When the doc. states keyword arguments do not contribute to the
>>> success of a match, it refers only to keyword arguments in the
>>> case-lambda clause, not at the call site.  This makes sense, otherwise
>>> it would inhibit writing functions that detect keywords internally
>>> from their rest arguments.
>> 
>> Do you mean something like this?
>> 
>> (define* (f a #:key x) x)
>> (define (g . args) (apply f args))
>> (g 0) -> #f
>> (g 0 #:x #t) -> #t
>> 
>> i.e. g must accept being called with 3 'arguments' so that it can forward the keyword args.
> 
> I was thinking of:
> 
> (define f
>  (case-lambda*
>   ((a . rest)
>    (if (memq #:x rest) …
> 
> where #:x is picked up from inside rest.
> 
> Based on the other error, I'd say that any case-lambda* with keyword
> arguments is matched with a rest argument instead, i.e. “a #:key x” is
> treated as “a . rest”.

Ok, I think I see how 

 (define f (case-lambda*
             ((x #:optional y) 1)
	     ((x #:key y)      2)
	     ((x y #:key z)    3)))

 (f #:y 2)

works. x is #:y and y is 2.

However, this should go to (x y #:key z) and it doesn't:

 (f 1 2 #:z 3) -> Odd length of keyword argument list

while given

(define g (case-lambda*
                       ((a #:key x) 1)
                       ((a b c #:key x) 3)))

this should match (a b c #:key x) and it doesn't. 

(g 1 2 3) - > Invalid keyword

Or maybe we should say that (g 1 2 3) shouldn't match (a #:key x)? Either way, I'll file these as a bug.

Thanks,

	Daniel

Re: case-lambda* question

[Andy Wingo]

On Wed 14 Nov 2012 11:20, Daniel Llorens <daniel.llorens@bluewin.ch> writes:

> (pass-if "case-lambda*"
>        (null? (call-with-warnings
>                 (lambda ()
>                   (compile '(let ((f (case-lambda*
>                                        ((x #:optional y) 1)
>                                        ((x #:key y)      2)
>                                        ((x y #:key z)    3))))
>                               (list (f 1)
>                                     (f 1 2)
>                                     (f #:y 2)
>                                     (f 1 2 #:z 3)))
>                            #:opts %opts-w-arity
>                            #:to 'assembly)))))
>
> I also get an error here. Strangely, I can run make check without
> anything being reported.

The test doesn't actually run the result, it just compiles it.  That's
why it "works".

Andy
-- 
http://wingolog.org/

Re: case-lambda* question

[Andy Wingo]

On Thu 15 Nov 2012 02:01, Germán "A. Arias" <german@xelalug.org> writes:

> /home/german/Escritorio/./test.scm:3:10: In procedure #<procedure f (x
> #:optional y) | (x #:key y) | (x y #:key z)>: Odd length of keyword
> argument list
>
> But there is one interest line
>
> 3: 0 [f 1 #<undefined> 2 #:z 3]
>
> What mean this? That is taking the second argument as a keyword?

This is an error that occurs during the parsing of keyword arguments.
The arguments have been shuffled around, and you are seeing an
intermediate state.  Perhaps we should treat this case better.

Andy
-- 
http://wingolog.org/

Re: case-lambda* question

[Andy Wingo]

[-- Attachment #1: Type: text/plain, Size: 4452 bytes --]

Hi Daniel,

On Mon 12 Nov 2012 14:54, Daniel Llorens <daniel.llorens@bluewin.ch> writes:

> (define f
> 	(case-lambda*
> 		((a b c #:key x) 3)
> 		((a #:key x) 1)))
>
> scheme@(guile-user)> (g 0 #:x 1)
> $1 = 3
>
> The manual says
>
>> Also, for completeness. Guile defines case-lambda* as well, which is
>> like case-lambda, except with lambda* clauses. A case-lambda* clause
>> matches if the arguments fill the required arguments, but are not too
>> many for the optional and/or rest arguments.
>> 
>> Keyword arguments are possible with case-lambda*, but they do not
>> contribute to the “matching” behavior. That is to say, case-lambda*
>> matches only on required, optional, and rest arguments, and on the
>> predicate; keyword arguments may be present but do not contribute to

I think this mention of a "predicate" probably refers to a brief time
when each clause could have a predicate to determine if it matched;
probably needs fixing.  Fixed the docs.

>> the “success” of a match. In fact a bad keyword argument list may
>> cause an error to be raised.
>
> I see that it gives 3 because ‘a b c’ matches ‘0 #:x 1’, so it's
> counting #:x as an ‘argument’ by itself. This is not what I expected
> from the description above. I think that the description should make
> clear that each item in the arg list is counted as an argument for the
> purposes of matching.
>
> Moreover I think this behavior makes case-lambda* fairly useless, or
> even treacherous. I wonder what other people think.

So, the story here is fairly simple, but the result is complicated.

The principles are:

  1. Case-lambda* clauses match in order.  Order is significant.

  2. Each clause is considered in isolation.  If the clause's formal
     arguments are compatible with the actual arguments, the clause is
     chosen.

  3. Keyword arguments are not checked for compatibility.

Commentary:

  1. Straight-forward.

  2. If you have some actual arguments ARGS... and a sequence of clauses
     CLAUSE1 CLAUSE2... of the form (FORMALS BODY...), to see if CLAUSE1
     applies, consider it in isolation:

       ((lambda* FORMALS1 BODY1...) ARGS...)

     Does it apply?  Then it will be chosen.

  3. This rule is an exception to (2).

     Rationale: At runtime we try to be fast.  Calling functions with
     keyword arguments doesn't allocate anything on the heap.  Instead,
     after required and optional arguments are bound, Guile shuffles up
     the remaining arguments above the space reserved for the final
     values of the keyword arguments, and then binds them in the order
     they are passed to the function.  This process is hairy and it's
     not easy to "roll back" to the initial state of the function call
     if a keyword does not match.  Perhaps it is doable, but I was too
     scared to fully implement it.

So, in your original example:

    (define f
      (case-lambda*
        ((a b c #:key x) 3)
        ((a #:key x) 1)))
    (f 0 #:x 1)

Here we look at the first clause:

    ((lambda* (a b c #:key x) 3) 0 #:x 1)

Does it apply?  Yes, yes it does: the 3 required arguments consume the
three arguments.  So it is chosen, and this is correct, or at least
consistent with lambda*.  (Required arguments are taken by position
only, regardless of what kind of object they are, even for keywords.
Optional arguments are the same, _except_ within a clause that also has
#:key arguments, in which case optionals are bound to positional
arguments only while the positional arguments are not keywords.)

Daniel Hartwig gives this second example, where the clauses are reversed:

    (define f
      (case-lambda*
        ((a #:key x) 1))
        ((a b c #:key x) 3))
    (g 1 2 3)

Again, considering the first clause:

    ((lambda* (a #:key x) 3) 1 2 3)

Does it apply?  It shouldn't: there are three positional arguments,
whereas only one is expected.  However, Guile currently thinks that it
does, in the case-lambda* context, because it only checks that there is
at least one positional argument.  This is probably a bug.

The attached patch fixes the problem.  If there are no comments against
it, I will apply it to stable-2.0.  It does introduce a slight
incompatibility, but I don't think there are many case-lambda* users,
and it makes cases work that previously failed to work.

Andy


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-case-lambda-clauses-fail-to-match-if-too-many-positi.patch --]
[-- Type: text/x-diff, Size: 28057 bytes --]

From 581f410fbd803721eb750ed8e7d6ec4cc4bcda79 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Mon, 14 Jan 2013 11:38:09 +0100
Subject: [PATCH] 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.
---
 doc/ref/api-procedures.texi                     |   61 +++++++++-
 doc/ref/vm.texi                                 |    8 +-
 libguile/eval.c                                 |   10 +-
 libguile/vm-i-system.c                          |   58 +++++++++-
 module/ice-9/eval.scm                           |  137 ++++++++++++-----------
 module/language/assembly/compile-bytecode.scm   |   13 ++-
 module/language/assembly/decompile-bytecode.scm |   14 ++-
 module/language/assembly/disassemble.scm        |    4 +-
 module/language/glil/compile-assembly.scm       |   11 +-
 test-suite/tests/optargs.test                   |   72 +++++++++++-
 10 files changed, 308 insertions(+), 80 deletions(-)

diff --git a/doc/ref/api-procedures.texi b/doc/ref/api-procedures.texi
index e749fdc..bef3386 100644
--- a/doc/ref/api-procedures.texi
+++ b/doc/ref/api-procedures.texi
@@ -599,12 +599,61 @@ A @code{case-lambda*} clause matches if the arguments fill the
 required arguments, but are not too many for the optional and/or rest
 arguments.
 
-Keyword arguments are possible with @code{case-lambda*}, but they do
-not contribute to the ``matching'' behavior. That is to say,
-@code{case-lambda*} matches only on required, optional, and rest
-arguments, and on the predicate; keyword arguments may be present but
-do not contribute to the ``success'' of a match. In fact a bad keyword
-argument list may cause an error to be raised.
+Keyword arguments are possible with @code{case-lambda*} as well, but
+they do not contribute to the ``matching'' behavior, and their
+interactions with required, optional, and rest arguments can be
+surprising.
+
+For the purposes of @code{case-lambda*} (and of @code{case-lambda}, as a
+special case), a clause @dfn{matches} if it has enough required
+arguments, and not too many positional arguments.  The required
+arguments are any arguments before the @code{#:optional}, @code{#:key},
+and @code{#:rest} arguments.  @dfn{Positional} arguments are the
+required arguments, together with the optional arguments.
+
+In the absence of @code{#:key} or @code{#:rest} arguments, it's easy to
+see how there could be too many positional arguments: you pass 5
+arguments to a function that only takes 4 arguments, including optional
+arguments.  If there is a @code{#:rest} argument, there can never be too
+many positional arguments: any application with enough required
+arguments for a clause will match that clause, even if there are also
+@code{#:key} arguments.
+
+Otherwise, for applications to a clause with @code{#:key} arguments (and
+without a @code{#:rest} argument), a clause will match there only if
+there are enough required arguments and if the next argument after
+binding required and optional arguments, if any, is a keyword.  For
+efficiency reasons, Guile is currently unable to include keyword
+arguments in the matching algorithm.  Clauses match on positional
+arguments only, not by comparing a given keyword to the available set of
+keyword arguments that a function has.
+
+Some examples follow.
+
+@example
+(define f
+  (case-lambda*
+    ((a #:optional b) 'clause-1)
+    ((a #:optional b #:key c) 'clause-2)
+    ((a #:key d) 'clause-3)
+    ((#:key e #:rest f) 'clause-4)))
+
+(f) @result{} clause-4
+(f 1) @result{} clause-1
+(f) @result{} clause-4
+(f #:e 10) clause-1
+(f 1 #:foo) clause-1
+(f 1 #:c 2) clause-2
+(f #:a #:b #:c #:d #:e) clause-4
+
+;; clause-2 will match anything that clause-3 would match.
+(f 1 #:d 2) @result{} error: bad keyword args in clause 2
+@end example
+
+Don't forget that the clauses are matched in order, and the first
+matching clause will be taken.  This can result in a keyword being bound
+to a required argument, as in the case of @code{f #:e 10}.
+
 
 @node Higher-Order Functions
 @subsection Higher-Order Functions
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 03356c7..9936ad9 100644
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  2008,2009,2010
+@c Copyright (C)  2008,2009,2010,2013
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -772,6 +772,7 @@ list. The list is then assigned to the @var{idx}th local variable.
 @end deffn
 
 @deffn Instruction bind-optionals/shuffle nreq nreq-and-opt ntotal
+@deffnx Instruction bind-optionals/shuffle-or-br nreq nreq-and-opt ntotal offset
 Shuffle keyword arguments to the top of the stack, filling in the holes
 with @code{SCM_UNDEFINED}. Each argument is encoded over two bytes.
 
@@ -783,6 +784,11 @@ the @var{nreq}th argument up to the @var{nreq-and-opt}th, and start
 shuffling when it sees the first keyword argument or runs out of
 positional arguments.
 
+@code{bind-optionals/shuffle-or-br} does the same, except that it checks
+if there are too many positional arguments before shuffling.  If this is
+the case, it jumps to @var{offset}, encoded using the normal three-byte
+encoding.
+
 Shuffling simply moves the keyword arguments past the total number of
 arguments, @var{ntotal}, which includes keyword and rest arguments. The
 free slots created by the shuffle are filled in with
diff --git a/libguile/eval.c b/libguile/eval.c
index c5b4580..0526f07 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2013
  * Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
@@ -846,6 +846,14 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
               env = scm_cons (args, env);
               i++;
             }
+          else if (scm_is_true (alt)
+                   && scm_is_pair (args) && !scm_is_keyword (CAR (args)))
+            {
+              /* Too many positional args, no rest arg, and we have an
+                 alternate clause.  */
+              mx = alt;
+              goto loop;
+            }
 
           /* Now fill in env with unbound values, limn the rest of the args for
              keywords, and fill in unbound values with their inits. */
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 40d26af..34545dd 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -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 ()
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index 4054bd8..554c88e 100644
--- a/module/ice-9/eval.scm
+++ b/module/ice-9/eval.scm
@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 
-;;;; Copyright (C) 2009, 2010, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 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
@@ -298,72 +298,83 @@
                                  (1- nopt) args (cdr inits))
                              (lp (cons (car args) env)
                                  (1- nopt) (cdr args) (cdr inits)))))
-                   ;; With keywords, we stop binding optionals at the first
-                   ;; keyword.
                    (let lp ((env env)
                             (nopt* nopt)
                             (args args)
                             (inits inits))
-                     (if (> nopt* 0)
-                         (if (or (null? args) (keyword? (car args)))
-                             (lp (cons (eval (car inits) env) env)
-                                 (1- nopt*) args (cdr inits))
-                             (lp (cons (car args) env)
-                                 (1- nopt*) (cdr args) (cdr inits)))
-                         ;; Finished with optionals.
-                         (let* ((aok (car kw))
-                                (kw (cdr kw))
-                                (kw-base (+ nopt nreq (if rest? 1 0)))
-                                (imax (let lp ((imax (1- kw-base)) (kw kw))
-                                        (if (null? kw)
-                                            imax
-                                            (lp (max (cdar kw) imax)
-                                                (cdr kw)))))
-                                ;; Fill in kwargs  with "undefined" vals.
-                                (env (let lp ((i kw-base)
-                                              ;; Also, here we bind the rest
-                                              ;; arg, if any.
-                                              (env (if rest? (cons args env) env)))
-                                       (if (<= i imax)
-                                           (lp (1+ i) (cons unbound-arg env))
-                                           env))))
-                           ;; Now scan args for keywords.
-                           (let lp ((args args))
-                             (if (and (pair? args) (pair? (cdr args))
-                                      (keyword? (car args)))
-                                 (let ((kw-pair (assq (car args) kw))
-                                       (v (cadr args)))
-                                   (if kw-pair
-                                       ;; Found a known keyword; set its value.
-                                       (list-set! env (- imax (cdr kw-pair)) v)
-                                       ;; Unknown keyword.
-                                       (if (not aok)
-                                           (scm-error 'keyword-argument-error
-                                                      "eval" "Unrecognized keyword"
-                                                      '() #f)))
-                                   (lp (cddr args)))
-                                 (if (pair? args)
-                                     (if rest?
-                                         ;; Be lenient parsing rest args.
-                                         (lp (cdr args))
-                                         (scm-error 'keyword-argument-error
-                                                    "eval" "Invalid keyword"
-                                                    '() #f))
-                                     ;; Finished parsing keywords. Fill in
-                                     ;; uninitialized kwargs by evalling init
-                                     ;; expressions in their appropriate
-                                     ;; environment.
-                                     (let lp ((i (- imax kw-base))
-                                              (inits inits))
-                                       (if (pair? inits)
-                                           (let ((tail (list-tail env i)))
-                                             (if (eq? (car tail) unbound-arg)
-                                                 (set-car! tail
-                                                           (eval (car inits)
-                                                                 (cdr tail))))
-                                             (lp (1- i) (cdr inits)))
-                                           ;; Finally, eval the body.
-                                           (eval body env)))))))))))))))
+                     (cond
+                      ;; With keywords, we stop binding optionals at the
+                      ;; first keyword.
+                      ((> nopt* 0)
+                       (if (or (null? args) (keyword? (car args)))
+                           (lp (cons (eval (car inits) env) env)
+                               (1- nopt*) args (cdr inits))
+                           (lp (cons (car args) env)
+                               (1- nopt*) (cdr args) (cdr inits))))
+                      ;; Finished with optionals.
+                      ((and alt (pair? args) (not (keyword? (car args)))
+                            (not rest?))
+                       ;; Too many positional args, no #:rest arg,
+                       ;; and we have an alternate.
+                       (apply alt-proc %args))
+                      (else
+                       (let* ((aok (car kw))
+                              (kw (cdr kw))
+                              (kw-base (+ nopt nreq (if rest? 1 0)))
+                              (imax (let lp ((imax (1- kw-base)) (kw kw))
+                                      (if (null? kw)
+                                          imax
+                                          (lp (max (cdar kw) imax)
+                                              (cdr kw)))))
+                              ;; Fill in kwargs  with "undefined" vals.
+                              (env (let lp ((i kw-base)
+                                            ;; Also, here we bind the rest
+                                            ;; arg, if any.
+                                            (env (if rest?
+                                                     (cons args env)
+                                                     env)))
+                                     (if (<= i imax)
+                                         (lp (1+ i) (cons unbound-arg env))
+                                         env))))
+                         ;; Now scan args for keywords.
+                         (let lp ((args args))
+                           (if (and (pair? args) (pair? (cdr args))
+                                    (keyword? (car args)))
+                               (let ((kw-pair (assq (car args) kw))
+                                     (v (cadr args)))
+                                 (if kw-pair
+                                     ;; Found a known keyword; set its value.
+                                     (list-set! env
+                                                (- imax (cdr kw-pair)) v)
+                                     ;; Unknown keyword.
+                                     (if (not aok)
+                                         (scm-error
+                                          'keyword-argument-error
+                                          "eval" "Unrecognized keyword"
+                                          '() #f)))
+                                 (lp (cddr args)))
+                               (if (pair? args)
+                                   (if rest?
+                                       ;; Be lenient parsing rest args.
+                                       (lp (cdr args))
+                                       (scm-error 'keyword-argument-error
+                                                  "eval" "Invalid keyword"
+                                                  '() #f))
+                                   ;; Finished parsing keywords. Fill in
+                                   ;; uninitialized kwargs by evalling init
+                                   ;; expressions in their appropriate
+                                   ;; environment.
+                                   (let lp ((i (- imax kw-base))
+                                            (inits inits))
+                                     (if (pair? inits)
+                                         (let ((tail (list-tail env i)))
+                                           (if (eq? (car tail) unbound-arg)
+                                               (set-car! tail
+                                                         (eval (car inits)
+                                                               (cdr tail))))
+                                           (lp (1- i) (cdr inits)))
+                                         ;; Finally, eval the body.
+                                         (eval body env))))))))))))))))
 
     ;; The "engine". EXP is a memoized expression.
     (define (eval exp env)
diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm
index 85805a5..181fb06 100644
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -1,6 +1,6 @@
 ;;; Guile VM assembler
 
-;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 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
@@ -136,6 +136,17 @@
               ((br-if-nargs-ne ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l))
               ((br-if-nargs-lt ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l))
               ((br-if-nargs-gt ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l))
+              ((bind-optionals/shuffle-or-br ,nreq-hi ,nreq-lo
+                                             ,nreq-and-nopt-hi ,nreq-and-nopt-lo
+                                             ,ntotal-hi ,ntotal-lo
+                                             ,l)
+               (write-byte nreq-hi)
+               (write-byte nreq-lo)
+               (write-byte nreq-and-nopt-hi)
+               (write-byte nreq-and-nopt-lo)
+               (write-byte ntotal-hi)
+               (write-byte ntotal-lo)
+               (write-break l))
               ((mv-call ,n ,l) (write-byte n) (write-break l))
               ((prompt ,escape-only? ,l) (write-byte escape-only?) (write-break l))
               (else
diff --git a/module/language/assembly/decompile-bytecode.scm b/module/language/assembly/decompile-bytecode.scm
index 605e3df..c3469bd 100644
--- a/module/language/assembly/decompile-bytecode.scm
+++ b/module/language/assembly/decompile-bytecode.scm
@@ -1,6 +1,6 @@
 ;;; Guile VM code converters
 
-;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 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
@@ -43,7 +43,7 @@
 (define (br-instruction? x)
   (memq x '(br br-if br-if-not br-if-eq br-if-not-eq br-if-null br-if-not-null)))
 (define (br-nargs-instruction? x)
-  (memq x '(br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt)))
+  (memq x '(br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt br-if-nargs-lt/non-kw)))
 
 (define (bytes->s24 a b c)
   (let ((x (+ (ash a 16) (ash b 8) c)))
@@ -88,6 +88,16 @@
                   (lp (cons `(,br ,(ensure-label rel1 rel2 rel3)) out)))
                  ((,br ,hi ,lo ,rel1 ,rel2 ,rel3) (guard (br-nargs-instruction? br))
                   (lp (cons `(,br ,hi ,lo ,(ensure-label rel1 rel2 rel3)) out)))
+                 ((bind-optionals/shuffle-or-br ,nreq-hi ,nreq-lo
+                                                ,nreq-and-nopt-hi ,nreq-and-nopt-lo
+                                                ,ntotal-hi ,ntotal-lo
+                                                ,rel1 ,rel2 ,rel3)
+                  (lp (cons `(bind-optionals/shuffle-or-br
+                              ,nreq-hi ,nreq-lo
+                              ,nreq-and-nopt-hi ,nreq-and-nopt-lo
+                              ,ntotal-hi ,ntotal-lo
+                              ,(ensure-label rel1 rel2 rel3))
+                            out)))
                  ((mv-call ,n ,rel1 ,rel2 ,rel3)
                   (lp (cons `(mv-call ,n ,(ensure-label rel1 rel2 rel3)) out)))
                  ((prompt ,n0 ,rel1 ,rel2 ,rel3)
diff --git a/module/language/assembly/disassemble.scm b/module/language/assembly/disassemble.scm
index ced5f26..5d30be3 100644
--- a/module/language/assembly/disassemble.scm
+++ b/module/language/assembly/disassemble.scm
@@ -1,6 +1,6 @@
 ;;; Guile VM code converters
 
-;; Copyright (C) 2001, 2009, 2010, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 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
@@ -129,6 +129,8 @@
        (list "-> ~A" (assq-ref labels (car args))))
       ((br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt)
        (list "-> ~A" (assq-ref labels (caddr args))))
+      ((bind-optionals/shuffle-or-br)
+       (list "-> ~A" (assq-ref labels (car (last-pair args)))))
       ((object-ref)
        (and objs (list "~s" (vector-ref objs (car args)))))
       ((local-ref local-boxed-ref local-set local-boxed-set)
diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index 83a5007..767fda3 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -1,6 +1,6 @@
 ;;; Guile VM assembler
 
-;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 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
@@ -486,13 +486,18 @@
                                     ,(modulo nreq 256)))))
             (ntotal (apply max (+ nreq nopt) (map 1+ (map cdr kw))))
             (bind-optionals-and-shuffle
-             `((bind-optionals/shuffle
+             `((,(if (and else-label (not rest))
+                     'bind-optionals/shuffle-or-br
+                     'bind-optionals/shuffle)
                 ,(quotient nreq 256)
                 ,(modulo nreq 256)
                 ,(quotient (+ nreq nopt) 256)
                 ,(modulo (+ nreq nopt) 256)
                 ,(quotient ntotal 256)
-                ,(modulo ntotal 256))))
+                ,(modulo ntotal 256)
+                ,@(if (and else-label (not rest))
+                      `(,else-label)
+                      '()))))
             (bind-kw
              ;; when this code gets called, all optionals are filled
              ;; in, space has been made for kwargs, and the kwargs
diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test
index a1e62bd..396fdec 100644
--- a/test-suite/tests/optargs.test
+++ b/test-suite/tests/optargs.test
@@ -1,7 +1,7 @@
 ;;;; optargs.test --- test suite for optional arg processing -*- scheme -*-
 ;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
 ;;;;
-;;;; 	Copyright (C) 2001, 2006, 2009, 2010 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2001, 2006, 2009, 2010, 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
@@ -22,6 +22,9 @@
   #:use-module (system base compile)
   #:use-module (ice-9 optargs))
 
+(define exception:invalid-keyword
+  '(keyword-argument-error . "Invalid keyword"))
+
 (define exception:unrecognized-keyword
   '(keyword-argument-error . "Unrecognized keyword"))
 
@@ -217,3 +220,70 @@
   (pass-if "default arg"
     (equal? (transmogrify quote)
             10)))
+
+(with-test-prefix/c&e "case-lambda*"
+  (pass-if "unambiguous"
+    ((case-lambda*
+      ((a b) #t)
+      ((a) #f))
+     1 2))
+
+  (pass-if "unambiguous (reversed)"
+    ((case-lambda*
+      ((a) #f)
+      ((a b) #t))
+     1 2))
+
+  (pass-if "optionals (order disambiguates)"
+    ((case-lambda*
+      ((a #:optional b) #t)
+      ((a b) #f))
+     1 2))
+
+  (pass-if "optionals (order disambiguates (2))"
+    ((case-lambda*
+      ((a b) #t)
+      ((a #:optional b) #f))
+     1 2))
+
+  (pass-if "optionals (one arg)"
+    ((case-lambda*
+      ((a b) #f)
+      ((a #:optional b) #t))
+     1))
+
+  (pass-if "optionals (one arg (2))"
+    ((case-lambda*
+      ((a #:optional b) #t)
+      ((a b) #f))
+     1))
+
+  (pass-if "keywords without keyword"
+    ((case-lambda*
+      ((a #:key c) #t)
+      ((a b) #f))
+     1))
+
+  (pass-if "keywords with keyword"
+    ((case-lambda*
+      ((a #:key c) #t)
+      ((a b) #f))
+     1 #:c 2))
+
+  (pass-if "keywords (too many positionals)"
+    ((case-lambda*
+      ((a #:key c) #f)
+      ((a b) #t))
+     1 2))
+
+  (pass-if "keywords (order disambiguates)"
+    ((case-lambda*
+      ((a #:key c) #t)
+      ((a b c) #f))
+     1 #:c 2))
+
+  (pass-if "keywords (order disambiguates (2))"
+    ((case-lambda*
+      ((a b c) #t)
+      ((a #:key c) #f))
+     1 #:c 2)))
-- 
1.7.10.4


[-- Attachment #3: Type: text/plain, Size: 26 bytes --]


-- 
http://wingolog.org/

Re: case-lambda* question

[Ludovic Courtès]

Hi!

Andy Wingo <wingo@pobox.com> skribis:

> So, the story here is fairly simple, but the result is complicated.

Woow, thanks for the clear and thorough explanation!

[...]

> Again, considering the first clause:
>
>     ((lambda* (a #:key x) 3) 1 2 3)
>
> Does it apply?  It shouldn't: there are three positional arguments,
> whereas only one is expected.  However, Guile currently thinks that it
> does, in the case-lambda* context, because it only checks that there is
> at least one positional argument.  This is probably a bug.
>
> The attached patch fixes the problem.  If there are no comments against
> it, I will apply it to stable-2.0.  It does introduce a slight
> incompatibility, but I don't think there are many case-lambda* users,
> and it makes cases work that previously failed to work.

Yes, makes sense to me.

Ludo’.

Re: case-lambda* question

[Daniel Llorens]

On Jan 14, 2013, at 11:39, Andy Wingo wrote:

…

> The attached patch fixes the problem.  If there are no comments against
> it, I will apply it to stable-2.0.  It does introduce a slight
> incompatibility, but I don't think there are many case-lambda* users,
> and it makes cases work that previously failed to work.

Thanks a lot for the clear explanation and the bug fix, and especially for updating the manual.

Regards

	Daniel