bug#9776: case-lambda should accept zero clauses

[ludo@gnu.org (Ludovic Courtès)]

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

Hi Ian,

Sorry for the late reply.

Ian Price <ianprice90@googlemail.com> skribis:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> Hi Göran,
>>
>> Sorry for the delay.
>>
>> Göran Weinholt <goran@weinholt.se> skribis:
>>
>>> the case-lambda form is specified in r6rs-lib as accepting any number of
>>> clauses, including zero. So this should not give an error:
>>
>> My interpretation of the ‘case-lambda’ implementation on p. 15 of
>> r6rs-lib.pdf is that ‘case-lambda-help’ raises an assertion violation
>> when ‘case-lambda’ is called with zero clauses.
> The case-lambda-help macro is expanded from within
> (lambda args
>   (let ((n (length args)))
>     (case-lambda-help args n
>       (fmls b1 b2 ...) ...)))
>
> So, the full expansion is
> (lambda args
>   (let ((n (length args)))
>     (assertion-violation #f "unexpected number of arguments")))
>
> and thus a procedure that always returns an assertion violation.

Indeed, thanks for the correction (I was thinking of
‘assertion-violation’ as a compile-time assertion.)

So, here’s a tentative patch for review:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 3957 bytes --]

	Modified module/ice-9/psyntax.scm
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 728ab12..c3aa6d8 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1778,7 +1778,19 @@
                                   r* w* mod)))))
 
         (syntax-case clauses ()
-          (() (values '() #f))
+          (()                                     ; zero clauses
+           (values
+            '()
+            (build-lambda-case s '() '() 'rest #f '()
+                               (list (build-lexical-var s 'rest))
+                               (build-application s
+                                                  (make-toplevel-ref s 'throw)
+                                                  (list
+                                                   (build-data
+                                                    s 'wrong-number-of-args)
+                                                   (build-data
+                                                    s "Wrong number of arguments")))
+                               #f)))
           (((args e1 e2 ...) (args* e1* e2* ...) ...)
            (call-with-values (lambda () (get-formals #'args))
              (lambda (req opt rest kw)
@@ -2092,12 +2104,12 @@
     (global-extend 'core 'case-lambda
                    (lambda (e r w s mod)
                      (syntax-case e ()
-                       ((_ (args e1 e2 ...) (args* e1* e2* ...) ...)
+                       ((_ (args e1 e2 ...) ...)
                         (call-with-values
                             (lambda ()
                               (expand-lambda-case e r w s mod
                                                   lambda-formals
-                                                  #'((args e1 e2 ...) (args* e1* e2* ...) ...)))
+                                                  #'((args e1 e2 ...) ...)))
                           (lambda (meta lcase)
                             (build-case-lambda s meta lcase))))
                        (_ (syntax-violation 'case-lambda "bad case-lambda" e)))))
@@ -2105,12 +2117,12 @@
     (global-extend 'core 'case-lambda*
                    (lambda (e r w s mod)
                      (syntax-case e ()
-                       ((_ (args e1 e2 ...) (args* e1* e2* ...) ...)
+                       ((_ (args e1 e2 ...) ...)
                         (call-with-values
                             (lambda ()
                               (expand-lambda-case e r w s mod
                                                   lambda*-formals
-                                                  #'((args e1 e2 ...) (args* e1* e2* ...) ...)))
+                                                  #'((args e1 e2 ...) ...)))
                           (lambda (meta lcase)
                             (build-case-lambda s meta lcase))))
                        (_ (syntax-violation 'case-lambda "bad case-lambda*" e)))))
	Modified test-suite/tests/compiler.test
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index ee688c0..bb2be06 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -1,5 +1,5 @@
 ;;;; compiler.test --- tests for the compiler      -*- scheme -*-
-;;;; Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2008, 2009, 2010, 2011, 2012 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
@@ -163,4 +163,11 @@
                        (display (list x y))
                        (list x y))))
                   (display (t 'x)))))
-            "(x y)(x y)")))
+            "(x y)(x y)"))
+
+  (pass-if-exception "zero clauses"
+    exception:wrong-num-args
+    ;; See <http://bugs.gnu.org/9776>.
+    (compile '(let ((p (case-lambda)))
+                (and (procedure? p) (p)))
+             #:to 'value)))


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


The problem is that the new test itself fails with:

  ERROR: compiler.test: case-lambda: zero clauses - arguments: ((wrong-number-of-args "eval" "Wrong number of arguments" () #f))

and then a number of tests in tree-il.test fail because they were
assuming the previous behavior for zero-clause ‘case-lambda’.

In addition, this patch uses the Guilish ‘wrong-number-of-args’
exception, not the R6RS one.  This is consistent, but it means that the
R6RS layer would have to convert exceptions again.

Thoughts?

Thanks,
Ludo’.