Add code for rewriting disjunctions where the predicate is a conditional.

diff --git a/src/sf/object.scm b/src/sf/object.scm
index f04c2ac51e45c628e3f8167323090122a8e112bd..44d877f83d2438888da268fccc028c78b21dccea 100644 (file)
--- a/src/sf/object.scm
+++ b/src/sf/object.scm
@@ -478,7 +478,7 @@ USA.
 ;;
 ;; This has been tested at very large values, so don't worry about
 ;; cranking it up.  The code will be correct, but it will get larger.
-(define sf:maximum-duplicate-expression-size 2)
+(define sf:maximum-duplicate-expression-size 16)
 
 (define (expression/can-duplicate? expression)
   (define (descend size subexpression)

diff --git a/src/sf/sf.pkg b/src/sf/sf.pkg
index e134e8fc7da74f1972c42b9e4bd0cb5b4a085054..7975a53b35d06c715e78c5f07567619aa354852e 100644 (file)
--- a/src/sf/sf.pkg
+++ b/src/sf/sf.pkg
@@ -45,7 +45,9 @@ USA.
          sf:enable-constant-folding?
          sf:enable-disjunction-distribution?
          sf:enable-disjunction-simplification?
-         sf:enable-distribute-primitives?))
+         sf:enable-distribute-primitives?
+         sf:enable-elide-conditional-canonicalization?
+         sf:enable-true-unspecific?))
 
 (define-package (scode-optimizer global-imports)
   (files "gimprt")
@@ -92,8 +94,8 @@ USA.
          sf:enable-disjunction-folding?
          sf:enable-disjunction-inversion?
          sf:enable-disjunction-linearization?
-         sf:enable-elide-conditional-canonicalization?
-         sf:enable-elide-double-negatives?)
+         sf:enable-elide-double-negatives?
+         sf:enable-rewrite-conditional-in-disjunction?)
   (export (scode-optimizer)
          integrate/top-level
          integrate/get-top-level-block
@@ -106,7 +108,7 @@ USA.
   (export (scode-optimizer)
          *sf-associate*
          cgen/external
-         pp-form)
+         pp-expression)
   (export (scode-optimizer expansion)
          cgen/external-with-declarations))
 

diff --git a/src/sf/subst.scm b/src/sf/subst.scm
index 0354e9709e45c6026aa6b65936b03e47827d9c83..7b0d43268f9bb6315136257d5fe08ee48759d2d8 100644 (file)
--- a/src/sf/subst.scm
+++ b/src/sf/subst.scm
@@ -249,6 +249,8 @@ USA.
 
 (define sf:enable-disjunction-folding? #t)
 (define sf:enable-disjunction-inversion? #t)
+(define sf:enable-disjunction-linearization? #t)
+(define sf:enable-rewrite-conditional-in-disjunction? #t)
 
 (define (integrate/disjunction operations environment expression
                               integrated-predicate alternative)
@@ -278,6 +280,13 @@ USA.
                              (list integrated-predicate
                                    integrated-alternative)))))
 
+       ((and (conditional? integrated-predicate)
+             (noisy-test sf:enable-rewrite-conditional-in-disjunction?
+                         "Rewriting conditional within disjunction."))
+        (integrate/conditional-in-disjunction
+         operations environment expression
+         integrated-predicate alternative))
+
        ((and (disjunction? integrated-predicate)
              (noisy-test sf:enable-disjunction-linearization? "Linearizing disjunction"))
         ;; (or (or <e1> <e2>) <e3>) => (or <e1> (or <e2> <e3>))
@@ -305,8 +314,6 @@ USA.
                           integrated-predicate
                           (integrate/expression operations environment alternative)))))
 
-(define sf:enable-disjunction-linearization? #t)
-
 (define (disjunction/linearize operations environment expression e1 e2 alternative)
   ;; (or (or <e1> <e2>) <alternative>) => (or <e1> (or <e2> <alternative>))
   ;; We don't make anoter pass through integrate/disjunction here
@@ -326,6 +333,126 @@ USA.
        operations)
     environment #f e2 alternative)))
 
+(define (integrate/conditional-in-disjunction
+         operations environment expression
+         integrated-predicate
+         alternative)
+  (let ((e1 (conditional/predicate integrated-predicate))
+       (e2 (conditional/consequent integrated-predicate))
+       (e3 (conditional/alternative integrated-predicate)))
+
+  ;; (or (if e1 e2 e3) alternative) =>
+  ;;    (if e1 (or e2 alternative) (or e3 alternative))
+  ;; provided alternative can be duplicated, or e2 or e3 are
+  ;; such that alternative doesn't need to be duplicated.
+  ;;
+  ;; e1 e2 and e3 have been integrated, alternative has not.
+
+  (cond ((or (expression/never-false? e2)
+            (expression/unspecific? e2))
+        ;; If e2 is never false, then we can rewrite like this:
+        ;; (if e1 e2 (or e3 alternative))
+        (conditional/make (and expression (object/scode expression))
+                          e1
+                          e2
+                          (integrate/disjunction
+                           ;; alternative is only taken when e1 is false
+                           (if (and (reference? e1)
+                                    (variable/safely-integrable? (reference/variable e1) operations)
+                                    (noisy-test sf:enable-conditional-propagation? "Propagating conditional information"))
+                               (operations/bind operations
+                                                'INTEGRATE
+                                                (reference/variable e1)
+                                                (make-integration-info (constant/make #f #f)))
+                               operations)
+                           environment
+                           #f
+                           e3 alternative)))
+
+       ((or (expression/never-false? e3)
+            (expression/unspecific? e3))
+        ;; If e3 is never false, then we can rewrite like this:
+        ;; (if e1 (or e2 alternative) e3)
+        (conditional/make (and expression (object/scode expression))
+                          e1
+                          (integrate/disjunction operations environment #f e2 alternative)
+                          e3))
+       (else
+        ;; See if we can duplicate the alternative.
+        (let ((e4 (integrate/expression operations environment alternative)))
+          (if (expression/can-duplicate? e4)
+              (conditional/make
+               (and expression (object/scode expression))
+               e1
+               ;; Consequent clause of new conditional
+               ;; (or e2 alternative)
+               ;; if e2 is always false, construct a sequence.
+               (if (expression/always-false? e2)
+                   (if (expression/effect-free? e2) e4 (sequence/make #f (list e2 e4)))
+                   (disjunction/make #f
+                                     e2
+                                     ;; if e2 is a variable that appears in e4,
+                                     ;; re-integrate e4 to eliminate it as a known false.
+                                     (if (and (reference? e2)
+                                              (variable/safely-integrable? (reference/variable e2) operations)
+                                              (variable/free-in-expression? (reference/variable e2) e4)
+                                              (noisy-test sf:enable-conditional-propagation? "Propagating conditional information"))
+                                         (integrate/expression
+                                          (operations/bind operations
+                                                           'INTEGRATE
+                                                           (reference/variable e2)
+                                                           (make-integration-info (constant/make #f #f)))
+                                          environment
+                                          e4)
+                                         e4)))
+               ;; Alternative clause of new conditional
+               ;; (or e3 alternative)
+               ;; first see if e1 is a variable that appears in e4
+               (cond ((and (reference? e1)
+                           (variable/safely-integrable? (reference/variable e1) operations)
+                           (variable/free-in-expression? (reference/variable e1) e4)
+                           (noisy-test sf:enable-conditional-propagation? "Propagating condition information"))
+                      ;; re-integrate e4 to take advantage of information about e1
+                      (let ((e4b (integrate/expression
+                                  (operations/bind
+                                   (if (and (reference? e3)
+                                            (variable/safely-integrable? (reference/variable e3) operations)
+                                            (variable/free-in-expression? (reference/variable e3) e4))
+                                       (operations/bind operations
+                                                        'integrate
+                                                        (reference/variable e3)
+                                                        (make-integration-info (constant/make #f #f)))
+                                       operations)
+                                   'integrate
+                                   (reference/variable e1)
+                                   (make-integration-info (constant/make #F #F)))
+                                  environment
+                                  e4)))
+                        (if (expression/always-false? e3)
+                            (if (expression/effect-free? e3) e4b (sequence/make #f (list e3 e4b)))
+                            (disjunction/make #f e3 e4b))))
+                     ((expression/always-false? e3)
+                      (if (expression/effect-free? e3) e4 (sequence/make #f (list e3 e4))))
+                     (else (disjunction/make #f
+                                             e3
+                                             ;; if e3 is a variable that appears in e4,
+                                             ;; re-integrate e4 to eliminate it as a known false.
+                                             (if (and (reference? e3)
+                                                      (variable/safely-integrable? (reference/variable e3) operations)
+                                                      (variable/free-in-expression? (reference/variable e3) e4)
+                                                      (noisy-test sf:enable-conditional-propagation? "Propagating conditional information"))
+                                                 (integrate/expression
+                                                  (operations/bind operations
+                                                                   'INTEGRATE
+                                                                   (reference/variable e3)
+                                                                   (make-integration-info (constant/make #f #f)))
+                                                  environment
+                                                  e4)
+                                                 e4)))))
+              ;; can't rewrite.
+              (disjunction/make (and expression (object/scode expression))
+                                integrated-predicate
+                                e4)))))))
 
 ;;; OPEN-BLOCK
 (define-method/integrate 'OPEN-BLOCK