From 5f51af6eeead732ed442cb2310f4f6be3b284608 Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Wed, 3 Mar 2010 08:19:50 -0800 Subject: [PATCH] Move disjunction linearization, propagate conditional value in alternative branch. --- src/sf/object.scm | 41 +++++++++++++---- src/sf/sf.pkg | 5 ++- src/sf/subst.scm | 109 ++++++++++++++++++++++++++++++++++------------ 3 files changed, 116 insertions(+), 39 deletions(-) diff --git a/src/sf/object.scm b/src/sf/object.scm index 92a9a7c25..f04c2ac51 100644 --- a/src/sf/object.scm +++ b/src/sf/object.scm @@ -705,8 +705,11 @@ USA. ;;; Conditional (define sf:enable-conditional->disjunction? #t) +(define sf:enable-conditional-inversion? #t) (define sf:enable-conjunction-linearization? #t) (define sf:enable-disjunction-distribution? #t) +;; Expression such as (if (pair? x) #t #f) don't need the conditional. +(define sf:enable-elide-conditional-canonicalization? #t) (define (conditional/make scode predicate consequent alternative) (cond ((and (expression/unspecific? predicate) @@ -748,11 +751,39 @@ USA. (disjunction/alternative predicate) consequent alternative))) + + ;; (if #t #f) => + ((and (or (expression/constant-eq? consequent #t) + (expression/unspecific? consequent)) + (or (expression/constant-eq? alternative #f) + (expression/unspecific? alternative)) + (expression/boolean? predicate) + (noisy-test sf:enable-elide-conditional-canonicalization? + "Eliding conditional canonicalization")) + predicate) + + ((and (expression/call-to-not? predicate) + (noisy-test sf:enable-conditional-inversion? "Inverting conditional")) + (conditional/make scode (first (combination/operands predicate)) + alternative + consequent)) + + ;; (if #f #t) => (not ) + ;; We know that we're not making a double negative here + ;; because a call to NOT in the predicate would already + ;; have been inverted by the previous clause. + ((and (or (expression/constant-eq? consequent #f) + (expression/unspecific? consequent)) + (or (expression/constant-eq? alternative #t) + (expression/unspecific? alternative)) + (noisy-test sf:enable-elide-conditional-canonicalization? + "Eliding inverse conditional canonicalization")) + (combination/%make scode #f (constant/make #f (ucode-primitive not)) (list predicate))) + (else (conditional/%make scode predicate consequent alternative)))) ;;; Disjunction -(define sf:enable-disjunction-linearization? #t) (define sf:enable-disjunction-simplification? #t) (define (disjunction/make scode predicate alternative) @@ -762,14 +793,6 @@ USA. ;; (or (foo) #f) => (foo) predicate) - ;; Linearize complex disjunctions - ((and (disjunction? predicate) - (noisy-test sf:enable-disjunction-linearization? "Linearize disjunction")) - (disjunction/make scode - (disjunction/predicate predicate) - (disjunction/make (object/scode predicate) - (disjunction/alternative predicate) - alternative))) (else (disjunction/%make scode predicate alternative)))) diff --git a/src/sf/sf.pkg b/src/sf/sf.pkg index d5aab376e..e134e8fc7 100644 --- a/src/sf/sf.pkg +++ b/src/sf/sf.pkg @@ -40,10 +40,10 @@ USA. (export () sf:enable-argument-deletion? sf:enable-conditional->disjunction? + sf:enable-conditional-inversion? sf:enable-conjunction-linearization? sf:enable-constant-folding? sf:enable-disjunction-distribution? - sf:enable-disjunction-linearization? sf:enable-disjunction-simplification? sf:enable-distribute-primitives?)) @@ -88,9 +88,10 @@ USA. (export () sf:display-top-level-procedure-names? sf:enable-conditional-folding? - sf:enable-conditional-inversion? + sf:enable-conditional-propagation? sf:enable-disjunction-folding? sf:enable-disjunction-inversion? + sf:enable-disjunction-linearization? sf:enable-elide-conditional-canonicalization? sf:enable-elide-double-negatives?) (export (scode-optimizer) diff --git a/src/sf/subst.scm b/src/sf/subst.scm index 04fa108d2..0354e9709 100644 --- a/src/sf/subst.scm +++ b/src/sf/subst.scm @@ -148,9 +148,6 @@ USA. ;;;; CONDITIONAL -;; Expression such as (if (pair? x) #t #f) don't need the conditional. -(define sf:enable-elide-conditional-canonicalization? #t) - (define-method/integrate 'CONDITIONAL (lambda (operations environment expression) (integrate/conditional operations environment expression @@ -161,7 +158,12 @@ USA. (conditional/alternative expression)))) (define sf:enable-conditional-folding? #t) -(define sf:enable-conditional-inversion? #t) + +;; If true, then when a conditional depends on a variable, +;; and that variable is not side effected and has no declarations, +;; we declare the variable to be integrable to a constant #F +;; in the alternative branch. +(define sf:enable-conditional-propagation? #t) (define (integrate/conditional operations environment expression integrated-predicate @@ -185,24 +187,29 @@ USA. ((and (expression/call-to-not? integrated-predicate) (noisy-test sf:enable-conditional-inversion? "Invert conditional")) + ;; (if (not ) ) => (if ) (integrate/conditional operations environment expression (first (combination/operands integrated-predicate)) alternative consequent)) - (else (let ((icons (integrate/expression - operations environment - consequent)) - (ialt (integrate/expression - operations environment - alternative))) - (cond ((and (expression/constant-eq? icons #t) - (expression/constant-eq? ialt #f) - (expression/boolean? integrated-predicate) - (noisy-test sf:enable-elide-conditional-canonicalization? - "elide conditional canonicalization")) - integrated-predicate) - (else - (conditional/make (and expression (conditional/scode expression)) integrated-predicate icons ialt))))))) + ((and (reference? integrated-predicate) + (variable/safely-integrable? (reference/variable integrated-predicate) operations) + (noisy-test sf:enable-conditional-propagation? "Propagating conditional information")) + (let ((icons (integrate/expression operations environment consequent)) + (ialt (integrate/expression + (operations/bind operations + 'INTEGRATE + (reference/variable integrated-predicate) + (make-integration-info (constant/make #f #f))) + environment + alternative))) + (conditional/make (and expression (conditional/scode expression)) integrated-predicate icons ialt))) + + (else + (conditional/make (and expression (conditional/scode expression)) + integrated-predicate + (integrate/expression operations environment consequent) + (integrate/expression operations environment alternative))))) ;;; CONSTANT (define-method/integrate 'CONSTANT @@ -249,11 +256,21 @@ USA. ;; We can use information from the predicate to help in ;; integrating the alternative. (cond ((and (expression/never-false? integrated-predicate) - (noisy-test sf:enable-disjunction-folding? "Fold constant true disjunction")) + (noisy-test sf:enable-disjunction-folding? "Folding constant true disjunction")) + ;; (or ) => if is never false predicate) + ((and (expression/call-to-not? integrated-predicate) + (noisy-test sf:enable-disjunction-inversion? "Inverting disjunction")) + ;; (or (not e1) e2) => (if e1 e2 #t) + (integrate/conditional operations environment expression + (first (combination/operands integrated-predicate)) + alternative + (constant/make #f #t))) + ((and (expression/always-false? integrated-predicate) - (noisy-test sf:enable-disjunction-folding? "Fold constant false disjunction")) + (noisy-test sf:enable-disjunction-folding? "Folding constant false disjunction")) + ;; (or ) => (begin ) if is always false (let ((integrated-alternative (integrate/expression operations environment alternative))) (if (expression/effect-free? integrated-predicate) integrated-alternative @@ -261,19 +278,55 @@ USA. (list integrated-predicate integrated-alternative))))) - ;; (or (not e1) e2) => (if e1 e2 #t) - ((and (expression/call-to-not? integrated-predicate) - (noisy-test sf:enable-disjunction-inversion? "Invert disjunction")) - (integrate/conditional operations environment expression - (first (combination/operands integrated-predicate)) - alternative - (constant/make #f #t))) + ((and (disjunction? integrated-predicate) + (noisy-test sf:enable-disjunction-linearization? "Linearizing disjunction")) + ;; (or (or ) ) => (or (or )) + (disjunction/linearize operations environment expression + (disjunction/predicate integrated-predicate) + (disjunction/alternative integrated-predicate) + alternative)) + + ((and (reference? integrated-predicate) + (variable/safely-integrable? (reference/variable integrated-predicate) operations) + (noisy-test sf:enable-conditional-propagation? "Propagating conditional information")) + ;; If is a reference, then must be #f in the alternative. + (disjunction/make (and expression (object/scode expression)) + integrated-predicate + (integrate/expression + (operations/bind operations + 'INTEGRATE + (reference/variable integrated-predicate) + (make-integration-info (constant/make #f #f))) + environment + alternative))) (else (disjunction/make (and expression (object/scode expression)) integrated-predicate (integrate/expression operations environment alternative))))) +(define sf:enable-disjunction-linearization? #t) + +(define (disjunction/linearize operations environment expression e1 e2 alternative) + ;; (or (or ) ) => (or (or )) + ;; We don't make anoter pass through integrate/disjunction here + ;; because the inner disjunction has already been integrated and there + ;; is no further optimization to be done. + (disjunction/make + (and expression (object/scode expression)) + e1 + (integrate/disjunction + (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 e2 alternative))) + + ;;; OPEN-BLOCK (define-method/integrate 'OPEN-BLOCK (lambda (operations environment expression) @@ -549,7 +602,7 @@ USA. (length=? operands 1) (expression/call-to-not? (first operands)) (expression/boolean? (first (combination/operands (first operands)))) - (noisy-test sf:enable-elide-double-negatives? "elide double negative")) + (noisy-test sf:enable-elide-double-negatives? "Eliding double negative")) (first (combination/operands (first operands)))) ((primitive-procedure? (constant/value operator)) (let ((operands* -- 2.25.1