Subject: bug#9776: case-lambda should accept zero clauses

From: [email-masked] (Ludovic Courtès)
Date: Thu, 02 Feb 2012 23:16:45 +0100

Hi Mark,

Mark H Weaver <[email-masked]> skribis:

> 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.

Psyntax is not yet a place where I feel comfortable, so I appreciate.  :-)

> [email-masked] (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.

Oh, OK.

>> +                                                  (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.

Oops, indeed.

> 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.

OK, I see.

[...]

> 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)>

[...]

> +                             ;; 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))

But this is terrrrrible!

What about something along these lines instead (untested):

diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 728ab12..da7f16a 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1704,7 +1704,7 @@
                               orig-args))))
         (req orig-args '())))
 
-    (define expand-lambda-case
+    (define expand-lambda-case*
       (lambda (e r w s mod get-formals clauses)
         (define (parse-req req opt rest kw body)
           (let ((vars (map gen-var req))
@@ -1795,6 +1795,25 @@
                         (build-lambda-case s req opt rest kw inits vars
                                            body else*))))))))))))
 
+    (define expand-lambda-case
+      (lambda (e r w s mod get-formals clauses)
+        (syntax-case clauses ()
+          (()
+           (values
+            '()
+            (build-lambda-case s '() '() 'rest #f '()
+                               (list (build-lexical-var s 'rest))
+                               (build-application s
+                                                  (build-primref s 'throw)
+                                                  (list
+                                                   (build-data
+                                                    s 'wrong-number-of-args)
+                                                   (build-data
+                                                    s "Wrong number of arguments")))
+                               #f)))
+          (((args e1 e2 ...) (args* e1* e2* ...) ...)
+           (expand-lambda-case* e r w s mod get-formal clauses)))))
+
     ;; data
 
     ;; strips syntax-objects down to top-wrap

The idea would be to explicitly check for the zero-clause case before
any recursive call is made.

Thanks,
Ludo’.