bug#9776: case-lambda should accept zero clauses

[Mark H Weaver]

Hi Ludovic,

Thanks for tackling this.  Of course this is Andy's area, but psyntax is
still fresh in my mind, so I'll attempt a review as well as my own
tentative approach.

address@hidden (Ludovic Courtès) writes:
> So, here’s a tentative patch for review:
>
>
>       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)

This 'make-toplevel-ref' should instead be 'build-primref', so that it
refers to the 'throw' in the 'guile' module.  As it is now, this won't
work in modules that have bound 'throw' to something else.

> +                                                  (list
> +                                                   (build-data
> +                                                    s 'wrong-number-of-args)
> +                                                   (build-data
> +                                                    s "Wrong number of 
> arguments")))
> +                               #f)))

Unfortunately, the above case is not only triggered for an empty
case-lambda; it is the base case at the end of iteration over the
clauses, so this code will be added to _every_ case-lambda.

Apart from the extra bloat, this will make error reporting much worse.
Right now, if you call a procedure created by 'case-lambda' with an
incorrect number of arguments, the VM will generate a nice error message
that includes the procedure itself, including the procedure's name.

By adding this "catch-all" clause to the end of every 'case-lambda', you
have taken over the job of error reporting for _all_ case-lambdas, but
you produce a much less useful error message than the VM does.

This also destroys the arity information for all case-lambdas.

* * * * *

I think the _right_ way to do this is to change all code that deals with
case-lambdas (in the compiler and evaluator) to gracefully handle the
zero-clause case.

In the meantime, here's my attempt at a temporary fix for this problem.
It contains a terrible hack, but the upside is that it produces helpful
error messages in almost every case, and the tests do the right thing.

Here's how it reports errors:

> scheme@(guile-user)> (define foo (case-lambda))
> scheme@(guile-user)> (foo)
> ;;; <stdin>:2:0: warning: possibly wrong number of arguments to `foo'
> ERROR: In procedure foo:
> ERROR: Wrong number of arguments to #<procedure foo (created by case-lambda 
> with no clauses a b c d e f g h i j k l m n o p q r s t u v w x y z)>

The terrible hack is that (case-lambda) expands into a normal 'lambda'
that takes 32 arguments.  The first six argument names form a message
that informs the user that the procedure was created by an empty case
lambda.  The next 26 arguments make it very unlikely that you will call
it with the correct number of arguments, because an inferior error
message is generated in that case:

> scheme@(guile-user)> (apply foo (iota 32))
> ERROR: In procedure scm-error:
> ERROR: Wrong number of arguments to a procedure created by case-lambda with 
> no clauses

Okay, here's my hackish attempt.  Comments welcome.  *ducks* :)

    Mark


diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 728ab12..3c0623c 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -2092,6 +2092,15 @@
     (global-extend 'core 'case-lambda
                    (lambda (e r w s mod)
                      (syntax-case e ()
+                       ((_) (expand
+                             ;; a terrible hack to produce helpful error 
messages in most cases
+                             #`(lambda (created by case-lambda with no clauses
+                                                a b c d e f g h i j k l m n o 
p q r s t u v w x y z)
+                                 (scm-error
+                                  '#,'wrong-number-of-args #f
+                                  "Wrong number of arguments to a procedure 
created by case-lambda with no clauses"
+                                  '() #f))
+                             r w mod))
                        ((_ (args e1 e2 ...) (args* e1* e2* ...) ...)
                         (call-with-values
                             (lambda ()
@@ -2105,6 +2114,7 @@
     (global-extend 'core 'case-lambda*
                    (lambda (e r w s mod)
                      (syntax-case e ()
+                       ((_) (expand #'(case-lambda) r w mod))
                        ((_ (args e1 e2 ...) (args* e1* e2* ...) ...)
                         (call-with-values
                             (lambda ()
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)))