iron out inconsistency between eval and compile expansion

* libguile/expand.c (expand_lambda_star_case): Harmonize with tree-il,
  expanding keywords to (aok? (kw name gensym) ...), not
  (aok? (kw . index) ...).

* libguile/memoize.c (memoize): Process the (kw name gensym) format into
  (kw . index).

* module/ice-9/psyntax.scm (build-lambda-case): Remove a
  compile-versus-eval special case.

* module/ice-9/psyntax-pp.scm: Regenerate.

libguile/expand.c

@@ -693,7 +693,7 @@ static SCM
 expand_lambda_star_case (SCM clause, SCM alternate, SCM env)
 {
   SCM req, opt, kw, allow_other_keys, rest, formals, vars, body, tmp;
-  SCM inits, kw_indices;
+  SCM inits;
   int nreq, nopt;
 
   const long length = scm_ilength (clause);
@@ -807,14 +807,12 @@ expand_lambda_star_case (SCM clause, SCM alternate, SCM env)
       env = scm_acons (rest, CAR (vars), env);
     }
 
-  /* Build up kw inits, env, and kw-indices alist */
+  /* Build up kw inits, env, and kw-canon list */
   if (scm_is_null (kw))
     kw = SCM_BOOL_F;
   else
     {
-      int idx = nreq + nopt + (scm_is_true (rest) ? 1 : 0);
+      SCM kw_canon = SCM_EOL;
-
-      kw_indices = SCM_EOL;
       kw = scm_reverse_x (kw, SCM_UNDEFINED);
       for (tmp = kw; scm_is_pair (tmp); tmp = scm_cdr (tmp))
         {
@@ -842,13 +840,13 @@ expand_lambda_star_case (SCM clause, SCM alternate, SCM env)
           else
             syntax_error (s_bad_formals, CAR (clause), SCM_UNDEFINED);
 
-          kw_indices = scm_acons (k, SCM_I_MAKINUM (idx++), kw_indices);
           inits = scm_cons (expand (init, env), inits);
           vars = scm_cons (scm_gensym (SCM_UNDEFINED), vars);
+          kw_canon = scm_cons (scm_list_3 (k, sym, CAR (vars)), kw_canon);
           env = scm_acons (sym, CAR (vars), env);
         }
-      kw_indices = scm_reverse_x (kw_indices, SCM_UNDEFINED);
+      kw_canon = scm_reverse_x (kw_canon, SCM_UNDEFINED);
-      kw = scm_cons (allow_other_keys, kw_indices);
+      kw = scm_cons (allow_other_keys, kw_canon);
     }
 
   /* We should check for no duplicates, but given that psyntax does this

libguile/memoize.c

@@ -273,7 +273,7 @@ memoize (SCM exp, SCM env)
       {
         SCM req, rest, opt, kw, inits, vars, body, alt;
         SCM walk, minits, arity, new_env;
-        int nreq, nopt;
+        int nreq, nopt, ntotal;
 
         req = REF (exp, LAMBDA_CASE, REQ);
         rest = REF (exp, LAMBDA_CASE, REST);
@@ -286,6 +286,7 @@ memoize (SCM exp, SCM env)
 
         nreq = scm_ilength (req);
         nopt = scm_is_pair (opt) ? scm_ilength (opt) : 0;
+        ntotal = scm_ilength (vars);
 
         /* The vars are the gensyms, according to the divine plan. But we need
            to memoize the inits within their appropriate environment,
@@ -319,6 +320,22 @@ memoize (SCM exp, SCM env)
 
         minits = scm_reverse_x (minits, SCM_UNDEFINED);
 
+        if (scm_is_true (kw))
+          {
+            /* (aok? (kw name sym) ...) -> (aok? (kw . index) ...) */
+            SCM aok = CAR (kw), indices = SCM_EOL;
+            for (kw = CDR (kw); scm_is_pair (kw); kw = CDR (kw))
+              {
+                SCM k;
+                int idx;
+
+                k = CAR (CAR (kw));
+                idx = ntotal - 1 - lookup (CADDR (CAR (kw)), new_env);
+                indices = scm_acons (k, SCM_I_MAKINUM (idx), indices);
+              }
+            kw = scm_cons (aok, scm_reverse_x (indices, SCM_UNDEFINED));
+          }
+
         if (scm_is_false (alt) && scm_is_false (kw) && scm_is_false (opt))
           {
             if (scm_is_false (rest))

module/ice-9/psyntax.scm

@@ -460,31 +460,7 @@
     ;; the body of a lambda: anything, already expanded
     ;; else: lambda-case | #f
     (lambda (src req opt rest kw inits vars body else-case)
-      ;; FIXME!!!
+      (make-lambda-case src req opt rest kw inits vars body else-case)))
-      (case (fluid-ref *mode*)
-        ((c)
-         ((@ (language tree-il) make-lambda-case)
-          src req opt rest kw inits vars body else-case))
-        (else
-         ;; Very much like the logic of (language tree-il compile-glil).
-         (let* ((nreq (length req))
-                (nopt (if opt (length opt) 0))
-                (rest-idx (and rest (+ nreq nopt)))
-                (allow-other-keys? (if kw (car kw) #f))
-                (kw-indices (map (lambda (x)
-                                   ;; (,key ,name ,var)
-                                   (cons (car x) (list-index vars (caddr x))))
-                                 (if kw (cdr kw) '())))
-                (nargs (apply max (+ nreq nopt (if rest 1 0))
-                              (map 1+ (map cdr kw-indices)))))
-           (or (= nargs
-                  (length vars)
-                  (+ nreq (length inits) (if rest 1 0)))
-               (error "something went wrong"
-                      req opt rest kw inits vars nreq nopt kw-indices nargs))
-           (make-lambda-case src req opt rest
-                             (and kw (cons allow-other-keys? kw-indices))
-                             inits vars body else-case))))))
 
   (define build-primref
     (lambda (src name)