Teach SF to pull LETs and BEGINs out of IF predicates.

LIAR doesn't do a very good job with disjunctions not immediately in
the predicate position of IFs.  It still doesn't do a very good job
with (OR X (LET ((Y ...)) (OR ...))), but this helps it a little to
reduce needless pushing and popping of #F on the stack.

diff --git a/src/sf/subst.scm b/src/sf/subst.scm
index 1ddbc1e86752f387853c80e63bfc4fc760255225..6a7089bb0a3e391ac91d56eb594fae326d6ff9f2 100644 (file)
--- a/src/sf/subst.scm
+++ b/src/sf/subst.scm
@@ -638,8 +638,10 @@ you ask for.
     operations
     environment
     (integrate/quotation expression)))
-
+\f
 ;; Optimize (if #f a b) => b; (if #t a b) => a
+;;   (if (let (...) t) a b) => (let (...) (if t a b))
+;;   (if (begin ... t) a b) => (begin ... (if t a b))
 
 (define-method/integrate 'CONDITIONAL
   (lambda (operations environment expression)
@@ -652,12 +654,28 @@ you ask for.
          (alternative (integrate/expression
                        operations environment
                        (conditional/alternative expression))))
-      (if (constant? predicate)
-         (if (constant/value predicate)
-             consequent
-             alternative)
-         (conditional/make (conditional/scode expression)
-                           predicate consequent alternative)))))
+      (let loop ((predicate predicate))
+       (cond ((constant? predicate)
+              (if (constant/value predicate)
+                  consequent
+                  alternative))
+             ((sequence? predicate)
+              (sequence-with-actions
+               predicate
+               (let ((actions (reverse (sequence/actions predicate))))
+                 (reverse
+                  (cons (loop (car actions))
+                        (cdr actions))))))
+             ((and (combination? predicate)
+                   (procedure? (combination/operator predicate)))
+              (combination-with-operator
+               predicate
+               (procedure-with-body
+                (combination/operator predicate)
+                (loop (procedure/body (combination/operator predicate))))))
+             (else
+              (conditional/make (conditional/scode expression)
+                                predicate consequent alternative)))))))
 
 ;; Optimize (or #f a) => a; (or #t a) => #t