Add some more optimizers.

diff --git a/v7/src/star-parser/shared.scm b/v7/src/star-parser/shared.scm
index 848c045ccd2a924145336db78d819de821ff69d9..3b46355dd53f496b04606d84515e8671b8f89a45 100644 (file)
--- a/v7/src/star-parser/shared.scm
+++ b/v7/src/star-parser/shared.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: shared.scm,v 1.3 2001/06/26 21:02:09 cph Exp $
+;;; $Id: shared.scm,v 1.4 2001/06/26 23:46:20 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -280,6 +280,17 @@
                      ,(cadr expression*)))
           ,(caddr expression)
           ,(cadddr expression*)))))
+
+(define-optimizer '('IF EXPRESSION
+                       ('OR . (+ EXPRESSION))
+                       EXPRESSION)
+    (lambda (expression)
+      (equal? (car (last-pair (caddr expression)))
+             (cadddr expression)))
+  (lambda (expression)
+    `(OR (AND ,(cadr expression)
+             (OR ,@(except-last-pair (cdr (caddr expression)))))
+        ,(cadddr expression))))
 \f
 (define-optimizer '('LET ((IDENTIFIER EXPRESSION))
                     ('IF IDENTIFIER
@@ -318,6 +329,16 @@
                    (cadr expression))
           ,@(map optimize-expression (cddr expression))))))
 
+(define-optimizer '(('LAMBDA (* IDENTIFIER) . (* EXPRESSION)) . (* EXPRESSION))
+    (lambda (expression)
+      (= (length (cadr (car expression)))
+        (length (cdr expression))))
+  (lambda (expression)
+    `(LET ,(map (lambda (v x) (list v x))
+               (cadr (car expression))
+               (map optimize-expression (cdr expression)))
+       ,@(map optimize-expression (cddr (car expression))))))
+
 (define-optimizer '('LAMBDA (* IDENTIFIER) EXPRESSION) #f
   (lambda (expression)
     `(LAMBDA ,(cadr expression) ,(optimize-expression (caddr expression)))))
@@ -380,4 +401,8 @@
                 (eq? (caar expressions) keyword))
            (loop (append (cdar expressions) (cdr expressions)))
            (cons (car expressions) (loop (cdr expressions))))
-       '())))
\ No newline at end of file
+       '())))
+
+;;; Edwin Variables:
+;;; Eval: (scheme-indent-method 'define-optimizer 2)
+;;; End: