From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 26 Jun 2001 23:46:20 +0000 (+0000)
Subject: Add some more optimizers.
X-Git-Tag: 20090517-FFI~2696
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=307e1ed0ab3cb00c90f00ada4760ed112e8c7ba7;p=mit-scheme.git

Add some more optimizers.
---

diff --git a/v7/src/star-parser/shared.scm b/v7/src/star-parser/shared.scm
index 848c045cc..3b46355dd 100644
--- 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))))
 
 (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: