rename lambda-case-else to lambda-case-alternate

* module/language/tree-il.scm (<tree-il>): Rename the "else" field of
  <lambda-case> to "alternate". Conflicts less with the "else" keyword
  as used by case, cond, record-case, pmatch, etc.
  (parse-tree-il, unparse-tree-il, tree-il->scheme, tree-il-fold)
  (make-tree-il-folder, post-order!, pre-order!): Adapt traversal
  operators for <lambda-case> change.

* module/language/tree-il/analyze.scm (analyze-lexicals)
  (validate-arity):
* module/language/tree-il/compile-glil.scm (flatten):
* module/language/tree-il/inline.scm (inline!): Adapt for <lambda-case>
  change.

module/language/tree-il.scm

@@ -40,7 +40,7 @@
             <lambda-case> lambda-case? make-lambda-case lambda-case-src
                           lambda-case-req lambda-case-opt lambda-case-rest lambda-case-kw
                           lambda-case-inits lambda-case-vars
-                          lambda-case-body lambda-case-else
+                          lambda-case-body lambda-case-alternate
             <let> let? make-let let-src let-names let-vars let-vals let-body
             <letrec> letrec? make-letrec letrec-src letrec-names letrec-vars letrec-vals letrec-body
             <fix> fix? make-fix fix-src fix-names fix-vars fix-vals fix-body
@@ -70,7 +70,7 @@
   (<application> proc args)
   (<sequence> exps)
   (<lambda> meta body)
-  (<lambda-case> req opt rest kw inits vars body else)
+  (<lambda-case> req opt rest kw inits vars body alternate)
   (<let> names vars vals body)
   (<letrec> names vars vals body)
   (<fix> names vars vals body)
@@ -135,11 +135,11 @@
      ((lambda ,meta ,body)
       (make-lambda loc meta (retrans body)))
 
-     ((lambda-case ((,req ,opt ,rest ,kw ,inits ,vars) ,body) ,else)
+     ((lambda-case ((,req ,opt ,rest ,kw ,inits ,vars) ,body) ,alternate)
       (make-lambda-case loc req opt rest kw 
                         (map retrans inits) vars
                         (retrans body)
-                        (and=> else retrans)))
+                        (and=> alternate retrans)))
 
      ((lambda-case ((,req ,opt ,rest ,kw ,inits ,vars) ,body))
       (make-lambda-case loc req opt rest kw
@@ -206,10 +206,10 @@
     ((<lambda> meta body)
      `(lambda ,meta ,(unparse-tree-il body)))
 
-    ((<lambda-case> req opt rest kw inits vars body else)
+    ((<lambda-case> req opt rest kw inits vars body alternate)
      `(lambda-case ((,req ,opt ,rest ,kw ,(map unparse-tree-il inits) ,vars)
                     ,(unparse-tree-il body))
-                   . ,(if else (list (unparse-tree-il else)) '())))
+                   . ,(if alternate (list (unparse-tree-il alternate)) '())))
 
     ((<const> exp)
      `(const ,exp))
@@ -269,15 +269,15 @@
     ((<lambda> meta body)
      ;; fixme: put in docstring
      (if (and (lambda-case? body)
-              (not (lambda-case-else body)))
+              (not (lambda-case-alternate body)))
          `(lambda ,@(car (tree-il->scheme body)))
          `(case-lambda ,@(tree-il->scheme body))))
     
-    ((<lambda-case> req opt rest kw inits vars body else)
+    ((<lambda-case> req opt rest kw inits vars body alternate)
      ;; FIXME! use parse-lambda-case?
      `((,(if rest (apply cons* vars) vars)
         ,(tree-il->scheme body))
-       ,@(if else (tree-il->scheme else) '())))
+       ,@(if alternate (tree-il->scheme alternate) '())))
     
     ((<const> exp)
      (if (and (self-evaluating? exp) (not (vector? exp)))
@@ -333,9 +333,9 @@ This is an implementation of `foldts' as described by Andy Wingo in
            (up tree (loop exps (down tree result))))
           ((<lambda> body)
            (up tree (loop body (down tree result))))
-          ((<lambda-case> inits body else)
+          ((<lambda-case> inits body alternate)
-           (up tree (if else
+           (up tree (if alternate
-                        (loop else
+                        (loop alternate
                               (loop body (loop inits (down tree result))))
                         (loop body (loop inits (down tree result))))))
           ((<let> vals body)
@@ -389,11 +389,11 @@ This is an implementation of `foldts' as described by Andy Wingo in
                   (fold-values foldts exps seed ...))
                  ((<lambda> body)
                   (foldts body seed ...))
-                 ((<lambda-case> inits body else)
+                 ((<lambda-case> inits body alternate)
                   (let-values (((seed ...) (fold-values foldts inits seed ...)))
-                    (if else
+                    (if alternate
                         (let-values (((seed ...) (foldts body seed ...)))
-                          (foldts else seed ...))
+                          (foldts alternate seed ...))
                         (foldts body seed ...))))
                  ((<let> vals body)
                   (let*-values (((seed ...) (fold-values foldts vals seed ...)))
@@ -438,11 +438,11 @@ This is an implementation of `foldts' as described by Andy Wingo in
       ((<lambda> body)
        (set! (lambda-body x) (lp body)))
       
-      ((<lambda-case> inits body else)
+      ((<lambda-case> inits body alternate)
        (set! inits (map lp inits))
        (set! (lambda-case-body x) (lp body))
-       (if else
+       (if alternate
-           (set! (lambda-case-else x) (lp else))))
+           (set! (lambda-case-alternate x) (lp alternate))))
       
       ((<sequence> exps)
        (set! (sequence-exps x) (map lp exps)))
@@ -495,10 +495,10 @@ This is an implementation of `foldts' as described by Andy Wingo in
         ((<lambda> body)
          (set! (lambda-body x) (lp body)))
 
-        ((<lambda-case> inits body else)
+        ((<lambda-case> inits body alternate)
          (set! inits (map lp inits))
          (set! (lambda-case-body x) (lp body))
-         (if else (set! (lambda-case-else x) (lp else))))
+         (if alternate (set! (lambda-case-alternate x) (lp alternate))))
 
         ((<sequence> exps)
          (set! (sequence-exps x) (map lp exps)))

module/language/tree-il/analyze.scm

@@ -191,7 +191,7 @@
                                          (not (lambda-case-opt c))
                                          (not (lambda-case-kw c))
                                          (not (lambda-case-rest c)))
-                                    (lp (lambda-case-else c)))))))))
+                                    (lp (lambda-case-alternate c)))))))))
            (hashq-set! labels gensym #f))
        (list gensym))
       
@@ -225,7 +225,7 @@
          (hashq-set! free-vars x free)
          free))
       
-      ((<lambda-case> opt kw inits vars body else)
+      ((<lambda-case> opt kw inits vars body alternate)
        (hashq-set! bound-vars proc
                    (append (reverse vars) (hashq-ref bound-vars proc)))
        (lset-union
@@ -235,7 +235,7 @@
                                      (apply lset-union eq? (map step inits))
                                      (step-tail body))
                          vars)
-        (if else (step-tail else) '())))
+        (if alternate (step-tail alternate) '())))
       
       ((<let> vars vals body)
        (hashq-set! bound-vars proc
@@ -379,7 +379,7 @@
          (hashq-set! allocation x (cons labels free-addresses)))
        n)
 
-      ((<lambda-case> opt kw inits vars body else)
+      ((<lambda-case> opt kw inits vars body alternate)
        (max
         (let lp ((vars vars) (n n))
           (if (null? vars)
@@ -397,7 +397,7 @@
                             (make-hashq
                              proc `(#t ,(hashq-ref assigned (car vars)) . ,n)))
                 (lp (cdr vars) (1+ n)))))
-        (if else (allocate! else proc n) n)))
+        (if alternate (allocate! alternate proc n) n)))
       
       ((<let> vars vals body)
        (let ((nmax (apply max (map recur vals))))
@@ -820,8 +820,8 @@
              (if (not proc)
                  (values name (reverse arities))
                  (record-case proc
-                   ((<lambda-case> req opt rest kw else)
+                   ((<lambda-case> req opt rest kw alternate)
-                    (loop name else
+                    (loop name alternate
                           (cons (list (len req) (len opt) rest
                                       (and (pair? kw) (map car (cdr kw)))
                                       (and (pair? kw) (car kw)))

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

@@ -426,7 +426,7 @@
              (emit-branch src 'br (car (hashq-ref allocation lcase))))
             ((lambda-case? lcase)
              ;; no match, try next case
-             (lp (lambda-case-else lcase)))
+             (lp (lambda-case-alternate lcase)))
             (else
              ;; no cases left; shuffle args down and jump before the prelude.
              (for-each (lambda (i)
@@ -463,7 +463,7 @@
              (emit-branch src 'br (car (hashq-ref allocation lcase))))
             ((lambda-case? lcase)
              ;; no match, try next case
-             (lp (lambda-case-else lcase)))
+             (lp (lambda-case-alternate lcase)))
             (else
              ;; no cases left. we can't really handle this currently.
              ;; ideally we would push on a new frame, then do a "local
@@ -664,7 +664,7 @@
                   (emit-code #f (make-glil-call 'make-closure 2)))))))
        (maybe-emit-return))
       
-      ((<lambda-case> src req opt rest kw inits vars else body)
+      ((<lambda-case> src req opt rest kw inits vars alternate body)
        ;; o/~ feature on top of feature o/~
        ;; req := (name ...)
        ;; opt := (name ...) | #f
@@ -688,7 +688,7 @@
               (nargs (apply max (+ nreq nopt (if rest 1 0))
                             (map 1+ (map cdr kw-indices))))
               (nlocs (cdr (hashq-ref allocation x)))
-              (else-label (and else (make-label))))
+              (alternate-label (and alternate (make-label))))
          (or (= nargs
                 (length vars)
                 (+ nreq (length inits) (if rest 1 0)))
@@ -701,11 +701,11 @@
           (cond
            (kw
             (make-glil-kw-prelude nreq nopt rest-idx kw-indices
-                                  allow-other-keys? nlocs else-label))
+                                  allow-other-keys? nlocs alternate-label))
            ((or rest opt)
-            (make-glil-opt-prelude nreq nopt rest-idx nlocs else-label))
+            (make-glil-opt-prelude nreq nopt rest-idx nlocs alternate-label))
            (#t
-            (make-glil-std-prelude nreq nlocs else-label))))
+            (make-glil-std-prelude nreq nlocs alternate-label))))
          ;; box args if necessary
          (for-each
           (lambda (v)
@@ -754,10 +754,10 @@
          (comp-tail body)
          (if (not (null? vars))
              (emit-code #f (make-glil-unbind)))
-         (if else-label
+         (if alternate-label
              (begin
-               (emit-label else-label)
+               (emit-label alternate-label)
-               (comp-tail else)))))
+               (comp-tail alternate)))))
       
       ((<let> src names vars vals body)
        (for-each comp-push vals)
@@ -827,7 +827,7 @@
                 (let lp ((lcase (lambda-body x)))
                   (if lcase
                       (record-case lcase
-                        ((<lambda-case> src req vars body else)
+                        ((<lambda-case> src req vars body alternate)
                          (emit-label (car (hashq-ref allocation lcase)))
                          ;; FIXME: opt & kw args in the bindings
                          (emit-bindings #f req vars allocation self emit-code)
@@ -835,7 +835,7 @@
                              (emit-code #f (make-glil-source src)))
                          (comp-fix body (or RA new-RA))
                          (emit-code #f (make-glil-unbind))
-                         (lp else)))
+                         (lp alternate)))
                       (emit-label POST)))))))
           vals
           vars)
@@ -879,8 +879,8 @@
 
       ((<let-values> src exp body)
        (record-case body
-         ((<lambda-case> req opt kw rest vars body else)
+         ((<lambda-case> req opt kw rest vars body alternate)
-          (if (or opt kw else)
+          (if (or opt kw alternate)
               (error "unexpected lambda-case in let-values" x))
           (let ((MV (make-label)))
             (comp-vals exp MV)

module/language/tree-il/inline.scm

@@ -44,11 +44,11 @@
           (let lp ((lcase body))
             (and lcase
                  (record-case lcase
-                   ((<lambda-case> req opt rest kw inits vars body else)
+                   ((<lambda-case> req opt rest kw inits vars body alternate)
                     (if (and (= (length vars) (length req) (length args)))
                         (let ((x (make-let src req vars args body)))
                           (or (inline1 x) x))
-                        (lp else)))))))
+                        (lp alternate)))))))
 
          ;; (call-with-values (lambda () foo) (lambda (a b . c) bar))
          ;; => (let-values (((a b . c) foo)) bar)
@@ -64,7 +64,7 @@
                          (lambda-case? (lambda-body consumer))
                          (not (lambda-case-opt (lambda-body consumer)))
                          (not (lambda-case-kw (lambda-body consumer)))
-                         (not (lambda-case-else (lambda-body consumer))))
+                         (not (lambda-case-alternate (lambda-body consumer))))
                   (make-let-values
                    src
                    (let ((x (make-application src producer '())))