From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Tue, 2 Mar 2010 18:43:48 +0000 (-0800)
Subject: Slightly smarter expansion for EQ? #F.
X-Git-Tag: 20100708-Gtk~136
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=0b5bf0e912c3e9552578e8c6bafb99d3b266bff6;p=mit-scheme.git

Slightly smarter expansion for EQ? #F.
---

diff --git a/src/sf/usiexp.scm b/src/sf/usiexp.scm
index c817de4f1..516203b3a 100644
--- a/src/sf/usiexp.scm
+++ b/src/sf/usiexp.scm
@@ -465,13 +465,21 @@ USA.
 (define (eq?-expansion expr operands block)
   (if (and (pair? operands)
 	   (pair? (cdr operands))
-	   (not (pair? (cddr operands))))
+	   (null? (cddr operands)))
       ;; Convert (eq? <expr> #f) and (eq? #f <expr>) to (not <expr>)
       ;; Conditional inversion will remove the call to not.
-      (cond ((constant-eq? (first operands) #f)
-	     (make-combination expr block (ucode-primitive not) (cdr operands)))
-	    ((constant-eq? (second operands) #f)
-	     (make-combination expr block (ucode-primitive not) (list (car operands))))
+      (cond ((expression/always-false? (first operands))
+	     (if (expression/effect-free? (first operands))
+		 (make-combination expr block (ucode-primitive not) (cdr operands))
+		 (sequence/make (and expr (object/scode expr))
+				(list (first operands)
+				      (make-combination #f block (ucode-primitive not) (cdr operands))))))
+	    ((expression/always-false? (second operands))
+	     (if (expression/effect-free? (second operands))
+		 (make-combination expr block (ucode-primitive not) (list (car operands)))
+		 (sequence/make (and expr (object/scode expr))
+				(list (second operands)
+				      (make-combination #f block (ucode-primitive not) (list (car operands)))))))
 	    (else
 	     (make-combination expr block (ucode-primitive eq?) operands)))
       #f))