Elide conditional canonicalization.

diff --git a/src/sf/sf.pkg b/src/sf/sf.pkg
index 87d055580918425a97bb89264db6d0e696679328..faee1fea698e7026dde3fb3729ef7c37645217db 100644 (file)
--- a/src/sf/sf.pkg
+++ b/src/sf/sf.pkg
@@ -92,6 +92,7 @@ USA.
   (parent (scode-optimizer))
   (export ()
          sf:display-top-level-procedure-names?
+         sf:enable-elide-conditional-canonicalization?
          sf:enable-elide-double-negatives?)
   (export (scode-optimizer)
          integrate/top-level

diff --git a/src/sf/subst.scm b/src/sf/subst.scm
index 65838068ddbdbae6c61ea84ba763dba1570c26fe..1ecf124eed66862b21c9c073197d280de9cff9a6 100644 (file)
--- a/src/sf/subst.scm
+++ b/src/sf/subst.scm
@@ -147,19 +147,29 @@ USA.
                            (combination/operands combination)))))
 
 ;;;; 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)
-    (conditional/make
-     (conditional/scode expression)
-     (integrate/expression
-      operations environment
-      (conditional/predicate expression))
-     (integrate/expression
-      operations environment
-      (conditional/consequent expression))
-     (integrate/expression
-      operations environment
-      (conditional/alternative expression)))))
+    (let ((ipred (integrate/expression
+                 operations environment
+                 (conditional/predicate expression)))
+         (icons (integrate/expression
+                 operations environment
+                 (conditional/consequent expression)))
+         (ialt (integrate/expression
+                operations environment
+                (conditional/alternative expression))))
+      (cond ((and (expression/constant-eq? icons #t)
+                 (expression/constant-eq? ialt #f)
+                 (expression/boolean? ipred)
+                 (noisy-test sf:enable-elide-conditional-canonicalization?
+                             "elide conditional canonicalization"))
+            ipred)
+           (else
+            (conditional/make (conditional/scode expression) ipred icons ialt))))))
 
 ;;; CONSTANT
 (define-method/integrate 'CONSTANT