diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-02-18 07:37:39 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-02-18 07:37:39 -0800 |
| commit | 39afd33944bec92f9e3bc89067ab7010de19d130 (patch) | |
| tree | ab71038c1d403ae5a9ff30b762488282fe7d12e2 | |
| parent | 824729d5105c38bed57311b6349e0690ec123435 (diff) | |
| download | txr-39afd33944bec92f9e3bc89067ab7010de19d130.tar.gz txr-39afd33944bec92f9e3bc89067ab7010de19d130.tar.bz2 txr-39afd33944bec92f9e3bc89067ab7010de19d130.zip | |
compiler: strength reduction of nequal.
* share/txr/stdlib/compiler.tl (compiler comp-if): Support
reduction of nequal in the same way as equal.
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 8652948f..4b3ee0df 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -526,12 +526,14 @@ (defmeth compiler comp-if (me oreg env form) (match-case (cdr form) - (@(require ((equal @a @b) . @rest) + (@(require ((@(and (or equal nequal) @op) @a @b) . @rest) (or (eql-comparable a) (eql-comparable b))) - (let ((cf (if (or (eq-comparable a) - (eq-comparable b)) - 'eq 'eql))) + (let* ((pos (eq op 'equal)) + (cf (if (or (eq-comparable a) + (eq-comparable b)) + (if pos 'eq 'neq) + (if pos'eql 'neql)))) me.(compile oreg env ^(if (,cf ,a ,b) ,*rest)))) ((@(constantp @test) @then @else) me.(compile oreg env (if (eval test) then else))) |