From 307e1ed0ab3cb00c90f00ada4760ed112e8c7ba7 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 26 Jun 2001 23:46:20 +0000
Subject: [PATCH] Add some more optimizers.
---
v7/src/star-parser/shared.scm | 29 +++++++++++++++++++++++++++--
1 file changed, 27 insertions(+), 2 deletions(-)
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:
--
2.25.1