From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 14 Mar 2003 01:12:39 +0000 (+0000)
Subject: Change expansion of OR to use scode disjunction type.  This produces
X-Git-Tag: 20090517-FFI~1952
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ac597eeb2ced9067599e32619b5f3212cd6bbe18;p=mit-scheme.git

Change expansion of OR to use scode disjunction type.  This produces
more efficient code, because the compiler recognizes it and behaves
specially.
---

diff --git a/v7/src/runtime/mit-syntax.scm b/v7/src/runtime/mit-syntax.scm
index 8660b6138..5ef79fb6d 100644
--- a/v7/src/runtime/mit-syntax.scm
+++ b/v7/src/runtime/mit-syntax.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: mit-syntax.scm,v 14.17 2003/03/08 02:06:43 cph Exp $
+$Id: mit-syntax.scm,v 14.18 2003/03/14 01:11:36 cph Exp $
 
 Copyright 1989,1990,1991,2001,2002,2003 Massachusetts Institute of Technology
 
@@ -594,25 +594,22 @@ USA.
 		     (car operands))))
 	     `#T))))))
 
-(define-er-macro-transformer 'OR system-global-environment
-  (lambda (form rename compare)
-    compare				;ignore
-    (capture-expansion-history
-     (lambda (history)
-       (syntax-check '(KEYWORD * EXPRESSION) form history)
-       (let ((operands (cdr form)))
-	 (if (pair? operands)
-	     (let ((let-keyword (rename 'LET))
-		   (if-keyword (rename 'IF))
-		   (temp (rename 'TEMP)))
-	       (let loop ((operands operands))
-		 (if (pair? (cdr operands))
-		     `(,let-keyword ((,temp ,(car operands)))
-				    (,if-keyword ,temp
-						 ,temp
-						 ,(loop (cdr operands))))
-		     (car operands))))
-	     `#F))))))
+(define-compiler 'OR system-global-environment
+  (lambda (form environment history)
+    (syntax-check '(KEYWORD * EXPRESSION) form history)
+    (if (pair? (cdr form))
+	(let loop ((expressions (cdr form)) (selector select-cdr))
+	  (let ((compiled
+		 (compile/subexpression (car expressions)
+					environment
+					history
+					(selector/add-car selector))))
+	    (if (pair? (cdr expressions))
+		(output/disjunction compiled
+				    (loop (cdr expressions)
+					  (selector/add-cdr selector)))
+		compiled)))
+	`#F)))
 
 (define-er-macro-transformer 'CASE system-global-environment
   (lambda (form rename compare)
diff --git a/v7/src/runtime/syntax-output.scm b/v7/src/runtime/syntax-output.scm
index 51f55adff..eba6592f1 100644
--- a/v7/src/runtime/syntax-output.scm
+++ b/v7/src/runtime/syntax-output.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: syntax-output.scm,v 14.9 2003/02/14 18:28:34 cph Exp $
+$Id: syntax-output.scm,v 14.10 2003/03/14 01:12:39 cph Exp $
 
 Copyright 1989,1990,1991,2001,2002,2003 Massachusetts Institute of Technology
 
@@ -59,6 +59,9 @@ USA.
 (define (output/conditional predicate consequent alternative)
   (make-conditional predicate consequent alternative))
 
+(define (output/disjunction predicate alternative)
+  (make-disjunction predicate alternative))
+
 (define (output/sequence expressions)
   (make-sequence expressions))