From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Mon, 8 Mar 2010 21:56:26 +0000 (-0800)
Subject: Add sf:rewrite-disjunction-in-conditional.
X-Git-Tag: 20100708-Gtk~113
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fd0f3cc5028eb93e3645c65234892fef6389a3d4;p=mit-scheme.git

Add sf:rewrite-disjunction-in-conditional.
---

diff --git a/src/sf/sf.pkg b/src/sf/sf.pkg
index 12b048997..6130b2f9e 100644
--- a/src/sf/sf.pkg
+++ b/src/sf/sf.pkg
@@ -94,7 +94,8 @@ USA.
 	  sf:enable-disjunction-inversion?
 	  sf:enable-disjunction-linearization?
 	  sf:enable-elide-double-negatives?
-	  sf:enable-rewrite-conditional-in-disjunction?)
+	  sf:enable-rewrite-conditional-in-disjunction?
+	  sf:enable-rewrite-disjunction-in-conditional?)
   (export (scode-optimizer)
 	  integrate/top-level
 	  integrate/get-top-level-block
diff --git a/src/sf/subst.scm b/src/sf/subst.scm
index 1252ad40e..057927e33 100644
--- a/src/sf/subst.scm
+++ b/src/sf/subst.scm
@@ -192,6 +192,11 @@ USA.
 				(first (combination/operands integrated-predicate))
 				alternative consequent))
 
+	((disjunction? integrated-predicate)
+	 (integrate/disjunction-in-conditional
+	  operations environment expression
+	  integrated-predicate consequent alternative))
+
 	(else
 	 (conditional/make (and expression (conditional/scode expression))
 			   integrated-predicate
@@ -199,6 +204,34 @@ USA.
 			   (integrate/expression (operations/prepare-false-branch operations integrated-predicate)
 						 environment alternative)))))
 
+(define sf:enable-rewrite-disjunction-in-conditional? #t)
+;; If #t, move disjunctions out of the predicate if possible.
+
+(define (integrate/disjunction-in-conditional operations environment expression 
+					      integrated-predicate consequent alternative)
+  (let ((e1 (disjunction/predicate integrated-predicate))
+	(e2 (disjunction/alternative integrated-predicate)))
+    ;; (if (or e1 e2) e3 e4) => (if e1 e3 (if e2 e3 e4))
+    ;; provided that e3 can be duplicated
+
+    (let* ((e3a (integrate/expression operations environment consequent))
+	   ;; In any case, e4 can only be evaluated if both e1 and e2 are false
+	   (if-e1-false (operations/prepare-false-branch operations e1))
+	   (e4 (integrate/expression (operations/prepare-false-branch if-e1-false e2) environment alternative)))
+
+    (if (and (expression/can-duplicate? e3a)
+	     (noisy-test sf:enable-rewrite-disjunction-in-conditional? "Rewriting disjunction within conditional"))
+	(conditional/make (and expression (object/scode expression))
+			  e1
+			  e3a
+			  (integrate/conditional if-e1-false environment #f
+						 e2 e3a e4))
+	;; nothing we can do.  Just make the conditional.
+	(conditional/make (and expression (object/scode expression))
+			  integrated-predicate
+			  e3a
+			  e4)))))
+
 ;;; CONSTANT
 (define-method/integrate 'CONSTANT
   (lambda (operations environment expression)