From 229d062f83d7c79fa08729330406d25755b25080 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Fri, 24 Jun 2016 17:35:55 +0200
Subject: [PATCH] Constant-folding eq? and eqv? uses deduplication

* test-suite/tests/peval.test ("partial evaluation"): Add tests.
* module/language/tree-il/peval.scm (peval): Constant-fold eq? and eqv?
  using equal?, anticipating deduplication.
---
 module/language/tree-il/peval.scm | 10 +++++++++-
 test-suite/tests/peval.test       |  8 ++++++++
 2 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index 8e1069d38..7d1945873 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -511,7 +511,15 @@ top-level bindings from ENV and return the resulting expression."
         (lambda ()
           (call-with-values
               (lambda ()
-                (apply (module-ref the-scm-module name) args))
+                (case name
+                  ((eq? eqv?)
+                   ;; Constants will be deduplicated later, but eq?
+                   ;; folding can happen now.  Anticipate the
+                   ;; deduplication by using equal? instead of eq?.
+                   ;; Same for eqv?.
+                   (apply equal? args))
+                  (else
+                   (apply (module-ref the-scm-module name) args))))
             (lambda results
               (values #t results))))
         (lambda _
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index 340780873..4e2ccf9c6 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -1359,6 +1359,14 @@
        (((x) #f #f #f () (_))
         (call (toplevel bar) (lexical x _))))))
 
+  (pass-if-peval
+      (eq? '(a b) '(a b))
+    (const #t))
+
+  (pass-if-peval
+      (eqv? '(a b) '(a b))
+    (const #t))
+
   (pass-if-peval
       ((lambda (foo)
          (define* (bar a #:optional (b (1+ a)))