Don't simplify 'equal?' to 'not' or 'null?'.
authorMark H Weaver <mhw@netris.org>
Mon, 8 Oct 2012 04:37:09 +0000 (00:37 -0400)
committerMark H Weaver <mhw@netris.org>
Mon, 8 Oct 2012 04:37:09 +0000 (00:37 -0400)
* 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.

module/language/tree-il/primitives.scm
test-suite/tests/tree-il.test

index 0c5b085..c3cd8c6 100644 (file)
                (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)))
 
index 0a53037..008eb83 100644 (file)
 (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))