mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +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)
(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)
(exact? v)
(<= v most-positive-fixnum)
(>= v most-negative-fixnum)))
(make-application src (make-primitive-ref #f 'eq?)
(list a b)))
(else #f)))))
(and (or (memq v '(#f #t () #nil))
(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))))))
(or (maybe-simplify a b) (maybe-simplify b a)))
(else #f)))

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

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