From 37d8628c1e53da5e67a5d30f9e349803ad85fbdb Mon Sep 17 00:00:00 2001
From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 23 Sep 2009 12:36:31 -0400
Subject: [PATCH] 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.
---
 src/sf/subst.scm | 32 +++++++++++++++++++++++++-------
 1 file changed, 25 insertions(+), 7 deletions(-)

diff --git a/src/sf/subst.scm b/src/sf/subst.scm
index 1ddbc1e86..6a7089bb0 100644
--- a/src/sf/subst.scm
+++ b/src/sf/subst.scm
@@ -638,8 +638,10 @@ you ask for.
     operations
     environment
     (integrate/quotation expression)))
-
+
 ;; 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
 
-- 
2.25.1