mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

Don't simplify 'equal?' to 'not' or 'null?'.

Browse source 
* module/language/tree-il/primitives.scm (*primitive-expand-table*):
  Don't simplify 'equal?' to 'not' or 'null?', but only to 'eq?'.

* test-suite/tests/tree-il.test ("primitives"): Adjust tests.
This commit is contained in:
Mark H Weaver 2012-10-08 00:37:09 -04:00
parent ebd363161e
commit bcf87e35e1
2 changed files with 12 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

25
module/language/tree-il/primitives.scm
View file

@ -498,23 +498,14 @@
(define (maybe-simplify a b) (define (maybe-simplify a b)
(and (const? a) (and (const? a)
(let ((v (const-exp a))) (let ((v (const-exp a)))
(cond (and (or (memq v '(#f #t () #nil))
((eq? #f v) (symbol? v)
(make-application src (make-primitive-ref #f 'not) (and (integer? v)
(list b))) (exact? v)
((eq? '() v) (<= v most-positive-fixnum)
(make-application src (make-primitive-ref #f 'null?) (>= v most-negative-fixnum)))
(list b))) (make-application src (make-primitive-ref #f 'eq?)
((or (eq? #t v) (list a b))))))
(eq? #nil v)
(symbol? v)
(and (integer? v)
(exact? 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))) (or (maybe-simplify a b) (maybe-simplify b a)))
(else #f))) (else #f)))

8
test-suite/tests/tree-il.test
View file

@ -87,12 +87,12 @@
(with-test-prefix "primitives" (with-test-prefix "primitives"
(pass-if-primitives-resolved (pass-if-primitives-resolved
(apply (primitive equal?) (toplevel x) (const #f)) (apply (primitive equal?) (const #f) (toplevel x))
(apply (primitive not) (toplevel x))) (apply (primitive eq?) (const #f) (toplevel x)))
(pass-if-primitives-resolved (pass-if-primitives-resolved
(apply (primitive equal?) (toplevel x) (const ())) (apply (primitive equal?) (const ()) (toplevel x))
(apply (primitive null?) (toplevel x))) (apply (primitive eq?) (const ()) (toplevel x)))
(pass-if-primitives-resolved (pass-if-primitives-resolved
(apply (primitive equal?) (const #t) (lexical x y)) (apply (primitive equal?) (const #t) (lexical x y))