summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-02-18 07:46:11 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-02-18 07:46:11 -0800
commite164d0cfe329ddc8aceea393f10279bcb7c95b49 (patch)
tree0221e4a08d3e281cedb51d2fbb42be706c5171db
parent39afd33944bec92f9e3bc89067ab7010de19d130 (diff)
downloadtxr-e164d0cfe329ddc8aceea393f10279bcb7c95b49.tar.gz
txr-e164d0cfe329ddc8aceea393f10279bcb7c95b49.tar.bz2
txr-e164d0cfe329ddc8aceea393f10279bcb7c95b49.zip
compiler: reduce (not (eq ...)) and related exprs.
* share/txr/stdlib/compiler.tl (compiler comp-fun-form): Reduce negated eq, eql, equal to neq, neql, nequal.
-rw-r--r--share/txr/stdlib/compiler.tl3
1 files changed, 3 insertions, 0 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 4b3ee0df..ebc2bda3 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -1161,6 +1161,9 @@
((or (eql-comparable a)
(eql-comparable b))
(set form ^(eql ,a ,b)))))
+ ((not (@(and @(or eq eql equal) @op) @a @b))
+ (let ((nop (caseq op (eq 'neq) (eql 'neql) (equal 'nequal))))
+ (return-from comp-fun-form me.(compile oreg env ^(,nop ,a ,b)))))
((@(or append cons list list*) . @args)
(set form (reduce-lisp form)))
((@(@bin [%bin-op% @sym]) @a @b)