[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-48-g3c65e3f
From: |
Noah Lavine |
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-48-g3c65e3f |
Date: |
Mon, 20 Feb 2012 20:24:32 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=3c65e3fda512cda13de244e853afd0fa0e7b5962
The branch, master has been updated
via 3c65e3fda512cda13de244e853afd0fa0e7b5962 (commit)
from 6978c673393a960d7caf604b8c72ff2b5fe0f4ec (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 3c65e3fda512cda13de244e853afd0fa0e7b5962
Author: Noah Lavine <address@hidden>
Date: Sat Feb 18 10:55:49 2012 -0500
Optimize Equality Primitives
* module/language/tree-il/primitives.scm: add equality-primitive?,
which is true for eq?, eqv?, and equal?
* module/language/tree-il/peval.scm: if an equality primitive is
applied to the same variable twice, fold it to #t
* test-suite/tests/tree-il.test: add tests for pevaling equality
primitives
-----------------------------------------------------------------------
Summary of changes:
module/language/tree-il/peval.scm | 11 +++++++++++
module/language/tree-il/primitives.scm | 11 ++++++++++-
test-suite/tests/tree-il.test | 10 ++++++++++
3 files changed, 31 insertions(+), 1 deletions(-)
diff --git a/module/language/tree-il/peval.scm
b/module/language/tree-il/peval.scm
index 9aac24c..a588b68 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1103,6 +1103,17 @@ top-level bindings from ENV and return the resulting
expression."
((name . args)
(fold-constants src name args ctx))))
+ (($ <primcall> src (? equality-primitive? name) (a b))
+ (let ((val-a (for-value a))
+ (val-b (for-value b)))
+ (log 'equality-primitive name val-a val-b)
+ (cond ((and (lexical-ref? val-a) (lexical-ref? val-b)
+ (eq? (lexical-ref-gensym val-a)
+ (lexical-ref-gensym val-b)))
+ (for-tail (make-const #f #t)))
+ (else
+ (fold-constants src name (list val-a val-b) ctx)))))
+
(($ <primcall> src (? effect-free-primitive? name) args)
(fold-constants src name (map for-value args) ctx))
diff --git a/module/language/tree-il/primitives.scm
b/module/language/tree-il/primitives.scm
index f192c4f..157aaa1 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -29,7 +29,7 @@
expand-primitives!
effect-free-primitive? effect+exception-free-primitive?
constructor-primitive? accessor-primitive?
- singly-valued-primitive?))
+ singly-valued-primitive? equality-primitive?))
(define *interesting-primitive-names*
'(apply @apply
@@ -206,9 +206,13 @@
bytevector-ieee-double-native-ref bytevector-ieee-double-native-set!
f32vector-ref f32vector-set! f64vector-ref f64vector-set!))
+(define *equality-primitives*
+ '(eq? eqv? equal?))
+
(define *effect-free-primitive-table* (make-hash-table))
(define *effect+exceptions-free-primitive-table* (make-hash-table))
(define *singly-valued-primitive-table* (make-hash-table))
+(define *equality-primitive-table* (make-hash-table))
(for-each (lambda (x)
(hashq-set! *effect-free-primitive-table* x #t))
@@ -219,6 +223,9 @@
(for-each (lambda (x)
(hashq-set! *singly-valued-primitive-table* x #t))
*singly-valued-primitives*)
+(for-each (lambda (x)
+ (hashq-set! *equality-primitive-table* x #t))
+ *equality-primitives*)
(define (constructor-primitive? prim)
(memq prim *primitive-constructors*))
@@ -230,6 +237,8 @@
(hashq-ref *effect+exceptions-free-primitive-table* prim))
(define (singly-valued-primitive? prim)
(hashq-ref *singly-valued-primitive-table* prim))
+(define (equality-primitive? prim)
+ (hashq-ref *equality-primitive-table* prim))
(define (resolve-primitives! x mod)
(define local-definitions
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 1f3d4e9..78068ff 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -1498,6 +1498,16 @@
;; Constant folding: cdr+list, impure
(cdr (list (bar) 0))
(seq (call (toplevel bar)) (primcall list (const 0))))
+
+ (pass-if-peval
+ ;; Equality primitive: same lexical
+ (let ((x (random))) (eq? x x))
+ (seq (call (toplevel random)) (const #t)))
+
+ (pass-if-peval
+ ;; Equality primitive: merge lexical identities
+ (let* ((x (random)) (y x)) (eq? x y))
+ (seq (call (toplevel random)) (const #t)))
(pass-if-peval
;; Non-constant guards get lexical bindings.
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-48-g3c65e3f,
Noah Lavine <=