(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)))
(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))