Slightly smarter expansion for EQ? #F.

diff --git a/src/sf/usiexp.scm b/src/sf/usiexp.scm
index c817de4f185f24c207ac8eb9102944854ada078d..516203b3a8872c496c7fcbc2bbbd72a9b43ef0e6 100644 (file)
--- 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))