fix bug bindings lexical vars within optargs initializers

* module/language/tree-il/analyze.scm (analyze-lexicals): Fix bug in
  which variables bound within inits were being improperly allocated.
* module/language/tree-il/compile-glil.scm (vars->bind-list): More
  detail in terrible debugging clause.
* test-suite/tests/optargs.test ("lambda* inits"): Add tests for binding
  vars within inits.

module/language/tree-il/analyze.scm

@@ -388,7 +388,7 @@
                             (allocate! body proc n)
                             ;; inits not logically at the end, but they
                             ;; are the list...
-                            (map (lambda (x) (allocate! x body n)) inits))))
+                            (map (lambda (x) (allocate! x proc n)) inits))))
                 ;; label and nlocs for the case
                 (hashq-set! allocation x (cons (gensym ":LCASE") nlocs))
                 nlocs)

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

@@ -173,7 +173,7 @@
          (pmatch (hashq-ref (hashq-ref allocation v) proc)
            ((#t ,boxed? . ,n)
             (list id boxed? n))
-           (,x (error "badness" x))))
+           (,x (error "badness" id v x))))
        ids
        vars))
 

test-suite/tests/optargs.test

@@ -174,6 +174,18 @@
       (equal? (f 1 2 3 #:x 'x #:z 'z)
               '(x #f z (1 2 3 #:x x #:z z))))))
 
+(with-test-prefix/c&e "lambda* inits"
+  (pass-if "can bind lexicals within inits"
+    (begin
+      (define* (qux #:optional a
+                    #:key (b (or a 13) #:a))
+        b)
+      #t))
+  (pass-if "testing qux"
+    (and (equal? (qux) 13)
+         (equal? (qux 1) 1)
+         (equal? (qux #:a 2) 2))))
+
 (with-test-prefix/c&e "defmacro*"
   (pass-if "definition"
     (begin