guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 08/11: Constant-folding eq? and eqv? uses deduplication


From: Andy Wingo
Subject: [Guile-commits] 08/11: Constant-folding eq? and eqv? uses deduplication
Date: Sun, 26 Jun 2016 20:58:18 +0000 (UTC)

wingo pushed a commit to branch stable-2.0
in repository guile.

commit 45b80a1fa8caf38656c7d602ded3c7eb67cb405b
Author: Andy Wingo <address@hidden>
Date:   Fri Jun 24 17:35:55 2016 +0200

    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       |   10 +++++++++-
 2 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/module/language/tree-il/peval.scm 
b/module/language/tree-il/peval.scm
index 062d2ee..7dd572f 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -479,7 +479,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 2183429..7421323 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -1321,4 +1321,12 @@
           (if (apply (primitive pair?) (toplevel arg))
               (set! (lexical l _) (toplevel arg))
               (void))
-          (apply (primitive @apply) (toplevel f) (lexical l _))))))
+          (apply (primitive @apply) (toplevel f) (lexical l _)))))
+
+  (pass-if-peval
+      (eq? '(a b) '(a b))
+    (const #t))
+
+  (pass-if-peval
+      (eqv? '(a b) '(a b))
+    (const #t)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]