fix self-tail-calls for lexical procs with optional, rest, or kwargs

* module/language/tree-il/compile-glil.scm (flatten-lambda): Don't emit
  a self-label, because when we can't match the args for a lexical call,
  we have no space to shuffle args and jump.
  (flatten): Apply the self-tail-call optimization to optional args
  too, but only if the procedure is fix-allocated. If we can't apply the
  optimization, use the normal tail-call sequence.

* test-suite/tests/optargs.test ("lambda* inits"): Add tests.

module/language/tree-il/compile-glil.scm

@@ -204,10 +204,6 @@
        (lambda (emit-code)
          ;; write source info for proc
          (if src (emit-code #f (make-glil-source src)))
-         ;; emit pre-prelude label for self tail calls in which the
-         ;; number of arguments doesn't check out at compile time
-         (if self-label
-             (emit-code #f (make-glil-label self-label)))
          ;; compile the body, yo
          (flatten body allocation x self-label (car (hashq-ref allocation x))
                   emit-code)))))))
@@ -423,17 +419,17 @@
         ((and (lexical-ref? proc)
               self-label (eq? (lexical-ref-gensym proc) self-label)
               (eq? context 'tail))
-         ;; first, evaluate new values, pushing them on the stack
-         (for-each comp-push args)
          (let lp ((lcase (lambda-body self)))
            (cond
             ((and (lambda-case? lcase)
                   (not (lambda-case-kw lcase))
-                  (not (lambda-case-opt lcase))
                   (not (lambda-case-rest lcase))
-                  (= (length args) (length (lambda-case-req lcase))))
+                  (= (length args)
-             ;; we have a case that matches the args; rename variables
+                     (+ (length (lambda-case-req lcase))
-             ;; and goto the case label
+                        (or (and=> (lambda-case-opt lcase) length) 0))))
+             ;; we have a case that matches the args; evaluate new
+             ;; values, rename variables and goto the case label
+             (for-each comp-push args)
              (for-each (lambda (sym)
                          (pmatch (hashq-ref (hashq-ref allocation sym) self)
                            ((#t #f . ,index) ; unboxed
@@ -448,11 +444,12 @@
              ;; no match, try next case
              (lp (lambda-case-alternate lcase)))
             (else
-             ;; no cases left; shuffle args down and jump before the prelude.
+             ;; no cases left -- use the normal tail call mechanism. we
-             (for-each (lambda (i)
+             ;; can't just shuffle the args down and jump back to the
-                         (emit-code #f (make-glil-lexical #t #f 'set i)))
+             ;; self label, because we don't have space.
-                       (reverse (iota (length args))))
+             (comp-push proc)
-             (emit-branch src 'br self-label)))))
+             (for-each comp-push args)
+             (emit-code src (make-glil-call 'tail-call (length args)))))))
         
         ;; lambda, the ultimate goto
         ((and (lexical-ref? proc)

test-suite/tests/optargs.test

@@ -184,7 +184,24 @@
   (pass-if "testing qux"
     (and (equal? (qux) 13)
          (equal? (qux 1) 1)
-         (equal? (qux #:a 2) 2))))
+         (equal? (qux #:a 2) 2)))
+  (pass-if "nested lambda* with optional"
+    (begin
+      (define (foo x)
+        (define baz x)
+        (define* (bar #:optional (y baz))
+          (or (zero? y) (bar (1- y))))
+        (bar))
+      (foo 10)))
+  (pass-if "nested lambda* with key"
+    (begin
+      (define (foo x)
+        (define baz x)
+        (define* (bar #:key (y baz))
+          (or (zero? y) (bar #:y (1- y))))
+        (bar))
+      (foo 10))))
+
 
 (with-test-prefix/c&e "defmacro*"
   (pass-if "definition"