[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.6-31-g2446f8
From: |
Ludovic Courtès |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.6-31-g2446f8e |
Date: |
Sat, 06 Oct 2012 21:42:23 +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=2446f8e126d9a7c145c4868f2a918d2dfb226d4e
The branch, stable-2.0 has been updated
via 2446f8e126d9a7c145c4868f2a918d2dfb226d4e (commit)
from 226a56a3d454b18b2b57c4489fdb8efbf4cd8332 (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 2446f8e126d9a7c145c4868f2a918d2dfb226d4e
Author: Ludovic Courtès <address@hidden>
Date: Sat Oct 6 01:24:46 2012 +0200
Simplify calls to `equal?' when one argument is a constant.
* module/language/tree-il/primitives.scm (*primitive-expand-table*): Add
expansion rules for `equal?', when called with one constant and
another argument.
* test-suite/tests/tree-il.test (pass-if-primitives-resolved): New
macro.
("primitives"): New test prefix.
-----------------------------------------------------------------------
Summary of changes:
module/language/tree-il/primitives.scm | 27 ++++++++++++++++++
test-suite/tests/tree-il.test | 46 ++++++++++++++++++++++++++++++++
2 files changed, 73 insertions(+), 0 deletions(-)
diff --git a/module/language/tree-il/primitives.scm
b/module/language/tree-il/primitives.scm
index a1c5adc..dc0a145 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -491,6 +491,33 @@
(bytevector-ieee-double-native-set! vec (* i 8) x))
(hashq-set! *primitive-expand-table*
+ 'equal?
+ (case-lambda
+ ((src a b)
+ ;; Simplify cases where either A or B is constant.
+ (define (maybe-simplify a b)
+ (and (const? a)
+ (let ((v (const-exp a)))
+ (cond
+ ((eq? #f v)
+ (make-application src (make-primitive-ref #f 'not)
+ (list b)))
+ ((eq? '() v)
+ (make-application src (make-primitive-ref #f 'null?)
+ (list b)))
+ ((or (eq? #t v)
+ (eq? #nil v)
+ (symbol? v)
+ (and (integer? v)
+ (<= v most-positive-fixnum)
+ (>= v most-negative-fixnum)))
+ (make-application src (make-primitive-ref #f 'eq?)
+ (list a b)))
+ (else #f)))))
+ (or (maybe-simplify a b) (maybe-simplify b a)))
+ (else #f)))
+
+(hashq-set! *primitive-expand-table*
'dynamic-wind
(case-lambda
((src pre thunk post)
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 4ffdce0..bb7f908 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -58,6 +58,20 @@
(assert-tree-il->glil with-partial-evaluation
in pat test ...))))
+(define-syntax-rule (pass-if-primitives-resolved in expected)
+ (pass-if (format #f "primitives-resolved in ~s" 'in)
+ (let* ((module (let ((m (make-module)))
+ (beautify-user-module! m)
+ m))
+ (orig (parse-tree-il 'in))
+ (resolved (expand-primitives! (resolve-primitives! orig module))))
+ (or (equal? (unparse-tree-il resolved) 'expected)
+ (begin
+ (format (current-error-port)
+ "primitive test failed: got ~s, expected ~s"
+ resolved 'expected)
+ #f)))))
+
(define-syntax pass-if-tree-il->scheme
(syntax-rules ()
((_ in pat)
@@ -70,6 +84,33 @@
(_ #f))))))
+(with-test-prefix "primitives"
+
+ (pass-if-primitives-resolved
+ (apply (primitive equal?) (toplevel x) (const #f))
+ (apply (primitive not) (toplevel x)))
+
+ (pass-if-primitives-resolved
+ (apply (primitive equal?) (toplevel x) (const ()))
+ (apply (primitive null?) (toplevel x)))
+
+ (pass-if-primitives-resolved
+ (apply (primitive equal?) (const #t) (lexical x y))
+ (apply (primitive eq?) (const #t) (lexical x y)))
+
+ (pass-if-primitives-resolved
+ (apply (primitive equal?) (const this-is-a-symbol) (toplevel x))
+ (apply (primitive eq?) (const this-is-a-symbol) (toplevel x)))
+
+ (pass-if-primitives-resolved
+ (apply (primitive equal?) (const 42) (toplevel x))
+ (apply (primitive eq?) (const 42) (toplevel x)))
+
+ (pass-if-primitives-resolved
+ (apply (primitive equal?) (const #nil) (toplevel x))
+ (apply (primitive eq?) (const #nil) (toplevel x))))
+
+
(with-test-prefix "tree-il->scheme"
(pass-if-tree-il->scheme
(case-lambda ((a) a) ((b c) (list b c)))
@@ -1704,3 +1745,8 @@
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w) "unsupported format
option"))))))))
+
+;; Local Variables:
+;; eval: (put 'pass-if-primitives-resolved 'scheme-indent-function 1)
+;; eval: (put 'pass-if-tree-il->scheme 'scheme-indent-function 1)
+;; End:
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.6-31-g2446f8e,
Ludovic Courtès <=