Rewrote case-lambda

Sometimes it's good to review what I've done so far. Yes, I've found something not efficient and it can be more efficient. This time it was case-lambda.

The original was SRFI-19 and since R6RS it's a standard macro (or syntax) for Scheme. However neither of implementations is efficient. At least it can be written better in R6RS. The problem of the reference implementation is it creates closures per lambda formals and apply it with given arguments. If the implementation is smart enough, the apply could be inlined however Sagittarius is not so smart (unfortunately).

If the implementation is not smart enough, then programmers need to be smart to let compiler emit efficient codes. So I rewrote it. This is what I think at least better than the references.

;; this is almost only R6RS except reverse!
(define-syntax case-lambda-aux
  (lambda (x)
    (define (construct args formals clause*)
      (define _car #'car)
      (define _cdr #'cdr)
      (define (parse-formals formal args inits)
        (syntax-case formal ()
          (() (reverse! inits))
          ((a . d)
           (with-syntax ((arg `(,_car ,args))
                         (args `(,_cdr ,args)))
             (parse-formals #'d #'args
                            (cons (list #'a #'arg) inits))))
          (v
           (reverse! (cons (list #'v args) inits)))))
      (with-syntax ((((var init) ...) (parse-formals formals args'()))
                    ((clause ...) clause*))
        #'(let ((var init) ...) clause ...)))
    (syntax-case x ()
      ((_ args n)
       #'(assertion-violation #f "unexpected number of arguments" args))
      ((_ args n ((x ...) b ...) more ...)
       (with-syntax ((let-clause (construct #'args #'(x ...) #'(b ...)))
                     (expect-length (length #'(x ...))))
         #'(if (= n expect-length)
               let-clause
               (case-lambda-aux args n more ...))))
      ((_ args n ((x1 x2 ... . r) b ...) more ...)
       (with-syntax ((let-clause (construct #'args #'(x1 x2 ... . r) 
                                            #'(b ...)))
                     (expect-length (length #'(x1 x2 ...))))
         #'(if (>= n expect-length)
               let-clause
               (case-lambda-aux args n more ...))))
      ((_ args n (r b ...) more ...)
       #'(let ((r args)) b ...)))))

(define-syntax case-lambda
  (syntax-rules ()
    ((_ (fmls b1 b2 ...))
     (lambda fmls b1 b2 ...))
    ((_ (fmls b1 b2 ...) ...)
     (lambda args
       (let ((n (length args)))
         (case-lambda-aux args n (fmls b1 b2 ...) ...))))))

The trick is really simple. Just let macro compute the given arguments. Even length is called only once.

With this code, at least on Sagittarius, the compiler emits better code than references (there is no extra closure created).