Menu
▾
▴
[Maxima-commits] [git] Maxima CAS branch, master, updated. branch-5_38-base-92-g050553b
|
From: Kris K. <kj...@us...> - 2016-06-12 22:46:46
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Maxima CAS".
The branch, master has been updated
via 050553b90809012e10da64112905a094a32320b5 (commit)
from 5b5e352282c16bb80e05da2501b067f37a1c3b2e (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 050553b90809012e10da64112905a094a32320b5
Author: Kris Katterjohn <kat...@gm...>
Date: Sun Jun 12 17:31:39 2016 -0500
No longer compare numbers with EQ [part 3]
The standard doesn't guarantee that numbers with the same value are
EQ, so compare with EQL instead. This time in the share files.
Unlike in parts 1 and 2, some of the numbers that were being compared
with EQ were negative. These comparisons would not work as intended
on implementations such as ABCL where things like (EQ -1 -1) yield NIL
(this happens on the current version of ABCL, 1.3.3). The share
packages that compared negative numbers with EQ were affine (polybas),
altsimp, format (coeflist), gentran (vaxlsp), hypergeometric and tensor
(itensor).
Like in parts 1 and 2, this handles cases where EQ was being used to
compare against explicit numbers. Some other cases (where explicit
numbers were not involved) that I noticed have been changed as well.
See also commits dac725 and 34f1f8 (parts 1 and 2).
diff --git a/share/affine/aquotient.lisp b/share/affine/aquotient.lisp
index 26b729b..3357291 100644
--- a/share/affine/aquotient.lisp
+++ b/share/affine/aquotient.lisp
@@ -1156,7 +1156,7 @@
with answer = 1
do
(cond ((oddp exponent)
- (cond ((eq answer 1)
+ (cond ((eql answer 1)
(setq answer 2^i-power-poly))
(t
(setq answer (afp-times answer 2^i-power-poly))))))
diff --git a/share/affine/dim-3.lisp b/share/affine/dim-3.lisp
index 63ab184..51bb6cf 100644
--- a/share/affine/dim-3.lisp
+++ b/share/affine/dim-3.lisp
@@ -20,7 +20,7 @@
(loop for vv in variable-names
for ww in variable-values
when (and (consp vv) (affine-polynomialp vv)
- (eq (length vv) 3))
+ (eql (length vv) 3))
collecting (cons (car vv) ww))))))
(defun gen-matrix-rows (mat )
diff --git a/share/affine/new-rat.lisp b/share/affine/new-rat.lisp
index cefe034..0e8ff9a 100644
--- a/share/affine/new-rat.lisp
+++ b/share/affine/new-rat.lisp
@@ -378,11 +378,11 @@ into genvar ordering and adds to genpairs"
;;the following works but is slow see projective
(defmfun $gcdlist (&rest fns)
- (cond ((and (eq (length fns) 1)
+ (cond ((and (eql (length fns) 1)
($listp (car fns))
(setq fns (cdr (car fns))))))
(let (varlist gcd-denom gcd-num rat-fns )
- (cond ((eq (length fns) 1) (car fns))
+ (cond ((eql (length fns) 1) (car fns))
(t
(loop for v in fns
do (newvar v))
diff --git a/share/affine/polya.lisp b/share/affine/polya.lisp
index 00f769d..80dfc25 100644
--- a/share/affine/polya.lisp
+++ b/share/affine/polya.lisp
@@ -87,7 +87,7 @@
(grind-top-level form))
(defun list-terms (poly &aux terms)
- (cond ((eq poly 0) nil)
+ (cond ((eql poly 0) nil)
((atom poly) (setq terms (list poly)))
(t
(setq terms
@@ -126,7 +126,7 @@
(mnctimes (setq monomial term))
(mncexpt (setq monomial term))
(otherwise (error "~A is not a term." term)))
- (cond ((eq 1 (length monomial)) (setq monomial (car monomial))))))
+ (cond ((eql 1 (length monomial)) (setq monomial (car monomial))))))
(values answer monomial)) ;;Note this a monomial less the '(mtimes simp)!!!
;;definition: A monomial is 1, or a symbol, or ((mexpt simp) var
@@ -922,7 +922,7 @@ dot_products, much the same as can be obtained by doing $dotsimp")
(setq monom (cdr monom))
(loop while tem
when (and $new_fast_dotsimp
- (or (eq 0 (second tem))
+ (or (eql 0 (second tem))
(eq (rzero) (cdr (second tem)))))
; ($zerop (second tem)))
do (setq tem (cddr tem))
@@ -1005,7 +1005,7 @@ dot_products, much the same as can be obtained by doing $dotsimp")
( $my_coeff y x)) (cdr f))) nil))))
(defun $ncoeff (f x &optional (exponent 1))
- (cond ((eq x 1) ($my_coeff f x))
+ (cond ((eql x 1) ($my_coeff f x))
((equal exponent 1)($coeff f x))
(t ($coeff f x exponent))))
@@ -1131,8 +1131,8 @@ dot_products, much the same as can be obtained by doing $dotsimp")
; "Returns the dot-monomials which will not be replaced by $dot_simplifications
; They are tail sorted if the optional third argument is given"
; (check-arg a-list $listp "a Macsyma list")
-; (cond ((eq n 0) (cons '(mlist simp) '(1)))
-; ((eq n 1) (setq answer (copy-list a-list))
+; (cond ((eql n 0) (cons '(mlist simp) '(1)))
+; ((eql n 1) (setq answer (copy-list a-list))
; (loop for v in (cdr answer)
; when (member-even v $dot_simplifications)
; do (setq answer (delete v answer)))
@@ -1172,7 +1172,7 @@ dot_products, much the same as can be obtained by doing $dotsimp")
(cond
((and (not (atom u)) (eq (caar u) 'mnctimes))
(setq nc-part u)
- (cond ((eq (length monomial) 3)
+ (cond ((eql (length monomial) 3)
(cond ((eq (second monomial) u)
(setq sc-part (third monomial)))
(t (setq sc-part
@@ -1182,7 +1182,7 @@ dot_products, much the same as can be obtained by doing $dotsimp")
(loop for u in (cdr monomial)
when (and (atom u) (not ($scalarp u)))
do (setq nc-part u )
- (cond ((eq (length monomial) 3)
+ (cond ((eql (length monomial) 3)
(cond ((eq (second monomial) u)
(setq sc-part (third monomial)))
(t (setq sc-part
@@ -1199,7 +1199,7 @@ dot_products, much the same as can be obtained by doing $dotsimp")
(cond ((null sc-part) (setq sc-part (loop for u in monomial
when (not(eq u nc-part))
collecting u))
- (cond ((eq (length sc-part) 2) (setq sc-part (cadr sc-part))))))
+ (cond ((eql (length sc-part) 2) (setq sc-part (cadr sc-part))))))
(values nc-part sc-part)))
@@ -1618,17 +1618,17 @@ dot_products, much the same as can be obtained by doing $dotsimp")
(defremember commutative-monomials (a-list n &optional (type-of-weight :weight) (reset nil))
(let ((atomic-terms))
(cond (reset (remprop 'commutative-monomials :memory-table)))
- (cond ((eq n 0) nil)
- ((eq n 1)
+ (cond ((eql n 0) nil)
+ ((eql n 1)
(loop for v in a-list
- when (eq n (degree v type-of-weight))
+ when (eql n (degree v type-of-weight))
collecting (list v) into tem
finally (setq atomic-terms tem))
atomic-terms)
(t
(loop for v in a-list
- when (eq n (degree v type-of-weight ))
+ when (eql n (degree v type-of-weight ))
collecting (list v) into tem
finally (setq atomic-terms tem))
(loop for v in a-list
@@ -2280,7 +2280,7 @@ dot_products, much the same as can be obtained by doing $dotsimp")
; do (setq variables (zl-delete v variables )))
; (cond
; ((setq answer (aref $current_monomials n)) answer)
-; ((eq n 0) (aset '((mlist simp) 1) $current_monomials 0)
+; ((eql n 0) (aset '((mlist simp) 1) $current_monomials 0)
; '((mlist simp) 1))
; (t
;
diff --git a/share/affine/polyb.lisp b/share/affine/polyb.lisp
index 8104926..cd30f51 100644
--- a/share/affine/polyb.lisp
+++ b/share/affine/polyb.lisp
@@ -130,10 +130,10 @@
(or (in-nth-power-radical form $radical_nilpotent_of_order)
(cond ((atom form)
(loop for v on (cdr $dot_simplifications) by #'cddr
- when (and (eq 0 (second v)) (eq (car v) form))
+ when (and (eql 0 (second v)) (eq (car v) form))
do (return t)))
(t (loop for v on (cdr $dot_simplifications) by #'cddr
- when (eq 0 (second v))
+ when (eql 0 (second v))
do (cond ((atom (setq u (car v)))
(cond ((member u form :test #'equal) (return t))))
(t (cond ((ordered-sublist (cdr u) form)(return t))))))))))
@@ -632,11 +632,11 @@
;(setq $new_fast_dotsimp t)
(defun vadd* (&rest a-list)
(cond ((null a-list) 0)
- ((eq (length a-list) 1) (car a-list))
+ ((eql (length a-list) 1) (car a-list))
(t (header-poly (n+ (car a-list) (apply 'vadd* (cdr a-list)))))))
(defun vmul* (&rest a-list)
(cond ((null a-list) 1)
- ((eq (length a-list) 1) (car a-list))
+ ((eql (length a-list) 1) (car a-list))
(t (header-poly (n* (car a-list) (apply 'vadd* (cdr a-list)))))))
(defun vsub* (a b) (header-poly (n- a b)))
(defun vdiv* (a b) (header-poly (nred a b)))
@@ -976,13 +976,13 @@ and modulo-p not prime gives false answer"
;
; (t (let ((rat-num rat-expr))
; ; (gshow rat-num)
-; (cond ((eq (car rat-num) gen-var)
+; (cond ((eql (car rat-num) gen-var)
; (setq rat-num (cdr rat-num))
; (loop while rat-num
-; when (eq (car rat-num) deg)
+; when (eql (car rat-num) deg)
; do
; (return (second rat-num) )
-; when (eq (car rat-num) 0)
+; when (eql (car rat-num) 0)
; do
; (return (my-ratcoeff2 (second rat-expr) gen-var))
; else
@@ -992,7 +992,7 @@ and modulo-p not prime gives false answer"
; (t (setq rat-num (cdr rat-num))
;; (break t)
; (loop while rat-num
-; when (eq (car rat-num) 0)
+; when (eql (car rat-num) 0)
; do
; (return (my-ratcoeff2 (second rat-num) gen-var))
; else
@@ -1010,10 +1010,10 @@ and modulo-p not prime gives false answer"
(cond ((eq (car rat-num) gen-var)
(setq rat-num (cdr rat-num))
(loop while rat-num
- when (eq (car rat-num) deg)
+ when (eql (car rat-num) deg)
do
(return (second rat-num) )
- when (eq (car rat-num) 0)
+ when (eql (car rat-num) 0)
do
(return (my-ratcoeff2 (second rat-expr) gen-var))
else
@@ -1023,7 +1023,7 @@ and modulo-p not prime gives false answer"
(t (setq rat-num (cdr rat-num))
; (break t)
(loop while rat-num
- when (eq (car rat-num) 0)
+ when (eql (car rat-num) 0)
do
(return (my-ratcoeff2 (second rat-num) gen-var))
else
diff --git a/share/affine/polybas.lisp b/share/affine/polybas.lisp
index e265d4b..e310ce4 100644
--- a/share/affine/polybas.lisp
+++ b/share/affine/polybas.lisp
@@ -132,9 +132,9 @@
((eq yy ':$rat)(setq ,y (cdr ,y) yy ':rational-function))
((eq yy ':rat ) (setq ,y (cons (second ,y) (third ,y))
yy ':rational-function)))
- (cond ((and (eq xx ':rational-function) (eq (denom ,x) 1))
+ (cond ((and (eq xx ':rational-function) (eql (denom ,x) 1))
(setq ,x (car ,x) xx :polynomial)))
- (cond ((and (eq yy ':rational-function) (eq (denom ,y) 1))
+ (cond ((and (eq yy ':rational-function) (eql (denom ,y) 1))
(setq ,y (car ,y) yy :polynomial)))
(setq answer
(case xx
@@ -181,7 +181,7 @@
(setq answer (polyop x y nil 1 ratreduce ratreduce ratquotient))
(setq answer (rationalize-denom-zeta3 answer))
(cond ((numberp answer) answer)
- ((eq (denom answer) 1) (car answer))
+ ((eql (denom answer) 1) (car answer))
(t answer)))
(defun new-disrep (expr)
@@ -244,13 +244,13 @@
,form))))
(defun splice-in (after-nth item a-list )
- (cond ((eq after-nth -1)(cons item a-list))
+ (cond ((eql after-nth -1)(cons item a-list))
(t (nconc (subseq a-list 0 (1+ after-nth))
(cons item (cdr (nthcdr after-nth a-list)))))))
(defun nsplice-in (after-nth item a-list &aux tem)
- (cond ((eq after-nth -1)(cons item a-list))
+ (cond ((eql after-nth -1)(cons item a-list))
(t
; (rplacd (setq tem (nthcdr after-nth a-list))
; (cons item (cdr tem)))
diff --git a/share/affine/polyc.lisp b/share/affine/polyc.lisp
index 7ba4693..3dc8e98 100644
--- a/share/affine/polyc.lisp
+++ b/share/affine/polyc.lisp
@@ -45,20 +45,20 @@
poly))
(t (setq new-monom (ncmul* mon monom mon1))
(cond ((contains-a-zero-replacement new-monom)
- (cond ((and (eq (second poly) 1)(eq (fourth poly) 0))
+ (cond ((and (eql (second poly) 1)(eql (fourth poly) 0))
(poly-ncmul1 mon (fifth poly) mon1))
- ((eq (second poly) 1) 0)
+ ((eql (second poly) 1) 0)
(t (merror "There is a bad order in nc polynomial ~A" poly))))
(t
(setq gen-sym (add-newvar new-monom))
- (cond ((and (eq (second poly) 1)(eq (fourth poly) 0))
+ (cond ((and (eql (second poly) 1)(eql (fourth poly) 0))
(setq tem (poly-ncmul1 mon (fifth poly) mon1))
(cond
- ((eq tem 0)(list gen-sym 1 (third poly)))
+ ((eql tem 0)(list gen-sym 1 (third poly)))
(t
(list gen-sym 1 (third poly) 0
tem))))
- ((eq (second poly) 1)
+ ((eql (second poly) 1)
(list gen-sym 1 (third poly)))
(t (merror "There is a bad order in nc polynomial ~A" poly))))))))
@@ -78,9 +78,9 @@
; (t (setq new-monom (ncmul* mon monom mon1))
;
; (setq gen-sym (add-newvar new-monom))
-; (cond ((and (eq (second poly) 1)(eq (fourth poly) 0))
+; (cond ((and (eql (second poly) 1)(eql (fourth poly) 0))
; (list gen-sym 1 (third poly) 0 (poly-ncmul1 mon (fifth poly) mon1)))
-; ((eq (second poly) 1)
+; ((eql (second poly) 1)
; (list gen-sym 1 (third poly)))
; (t (merror "There is a bad order in nc polynomial ~A" poly))))))
;(defun new-rat-ncmul (a nc-rat-expr c)
@@ -90,7 +90,7 @@
"broken"
(loop for v in ll when (not (affine-polynomialp v))do (break t))
(cond ((null ll) 1)
- ((eq (length ll) 1) (car ll))
+ ((eql (length ll) 1) (car ll))
((numberp (car ll))(n* (car ll) (apply 'poly-ncmul (cdr ll))))
((affine-polynomialp (car ll))
(apply
@@ -197,7 +197,7 @@
for i from 0
when (equal (car v) expr)
do
- (cond ((eq i 0)(setq *genpairs* (cdr *genpairs*)))
+ (cond ((eql i 0)(setq *genpairs* (cdr *genpairs*)))
(t (setq *genpairs* (delete v *genpairs* :test #'equal)))))
(setq *varlist* (delete expr *varlist* :test #'equal)))
diff --git a/share/affine/polyd.lisp b/share/affine/polyd.lisp
index c8de9cc..2f73446 100644
--- a/share/affine/polyd.lisp
+++ b/share/affine/polyd.lisp
@@ -17,7 +17,7 @@ modulo ones-to-add checked thru the highest degree of ones to add."
; (unwind-protect
(progn
(loop for v in (cdr $centrals_so_far)
- until (eq (length ones-to-add) 3)
+ until (eql (length ones-to-add) 3)
do
(cond (($zerop ($dotsimp v))(setq v 0))
(t (format t "~%Supposedly checking overlaps to deg ~a" ($nc_degree v))
@@ -104,7 +104,7 @@ far degree"
(setq answer
(catch 'check_a_case
(setq free-dot-simps $dot_simplifications)
- (loop for i from 3 until (or (eq i 6) (eq (length ones-to-add) 3))
+ (loop for i from 3 until (or (eql i 6) (eql (length ones-to-add) 3))
;; 6 ;;enough?
do
(setq $dot_simplifications full-dot-simps)
@@ -239,7 +239,7 @@ far degree"
(defun hilbert (n &rest l)
(cond ((< n 0) 0)
- ((eq n 0) 1)
+ ((eql n 0) 1)
((null l)($global_dimension_3 n))
(t (- (apply 'hilbert n (cdr l))
(apply 'hilbert (- n (car l)) (cdr l))))))
@@ -268,7 +268,7 @@ far degree"
(check-arg list-powers (eql (car list-powers) 1) "first should be one")
(cond ((< degree 0) 0)
((zerop degree) 1)
- ((eq 1 degree) number-variables)
+ ((eql 1 degree) number-variables)
;;(< degree degree-relations) (expt number-variables degree))
(t
(loop for deg-map in list-degree-maps
diff --git a/share/affine/polysmp.lisp b/share/affine/polysmp.lisp
index cd0c2be..db34dc4 100644
--- a/share/affine/polysmp.lisp
+++ b/share/affine/polysmp.lisp
@@ -28,7 +28,7 @@
(cond ((null monomial-degs)poly)
((numberp monomial-degs) poly)
((numberp poly)(cond ((loop for w in (cdr monomial-degs) by #'cddr
- when (not (eq w 0))
+ when (not (eql w 0))
do(return t)) nil)
(t poly)))
(t (let ((deg))
@@ -109,9 +109,9 @@
the exact power, and if it is in variables to exclude it may not appear unless it
was in monom to the exact power. (pcoeff pol 1 ..) will exclude variables like
substituting them to be zero."
- (cond ((eq monom 1) nil)
+ (cond ((eql monom 1) nil)
((atom monom) (setq monom (list monom 1 1))))
- (check-arg monom (or (listp monom)(eq monom 1)) "1 or a monomial")
+ (check-arg monom (or (listp monom)(eql monom 1)) "1 or a monomial")
(cond ((pcoeff1 poly monom variables-to-exclude-from-cof ))
(t 0)))
(defun pcoeff1 (poly monom &optional
@@ -181,13 +181,13 @@ substituting them to be zero."
(cond ((null sequ) nil)
((numberp sequ) sequ)
(t (setq tem (convert-deg-sequence-to-monomial (cddr sequ)))
- (cond (tem (cond ((not (eq 0 (second sequ))) (list (car sequ) (second sequ) tem))
+ (cond (tem (cond ((not (eql 0 (second sequ))) (list (car sequ) (second sequ) tem))
(t tem)))
(t (list (car sequ) (second sequ) 1))))))
(defun constant-deg-sequencep (seq)
(loop for w in seq by #'cddr
- when (not (eq w 0))
+ when (not (eql w 0))
do (return nil)
finally (return t)))
@@ -254,7 +254,7 @@ substituting them to be zero."
(defun deg-sequence (variables degrees)
(loop for v in variables
for w in degrees
- unless (eq w 0)
+ unless (eql w 0)
collecting v
and
collecting w))
@@ -331,7 +331,7 @@ substituting them to be zero."
(num replacement)
(factor-out-monomial to-replace monomial-degs t))) ;copy?
(setq answer (pplus answer tem))
- (cond ((eq 1 (denom poly))
+ (cond ((eql 1 (denom poly))
(setq answer (maybe-ratreduce answer denom-replacement)))
(t (setq answer (maybe-ratreduce answer
(ptimes (denom poly )
@@ -362,7 +362,7 @@ substituting them to be zero."
(not ($zerop orig))) (setq *poly-simplifications*
(list 1 (rzero))))
(t *poly-simplifications*)))
- ((eq 0 (num rat-monom)) (princ ".")(setq simplify nil) *poly-simplifications*)
+ ((eql 0 (num rat-monom)) (princ ".")(setq simplify nil) *poly-simplifications*)
((or (numberp rat-monom) (and (listp rat-monom)
(constant-functionp (num rat-monom))))
(setq *poly-simplifications* (list 1 (rzero)))
@@ -474,8 +474,8 @@ substituting them to be zero."
(t (format t "no good yet"))))))
(defun new-zerop (x)
- (or (eq x 0)
- (and (listp x) (eq (car x) 0))))
+ (or (eql x 0)
+ (and (listp x) (eql (car x) 0))))
(defvar *simplify-rhs* t)
@@ -843,7 +843,7 @@ substituting them to be zero."
; (setq replaced-th i)
;
; (setq repl (replace-monomial-rat poly (second v) (car v) tem ))
-; (cond ((eq (num repl) 0)(setq changes nil)))
+; (cond ((eql (num repl) 0)(setq changes nil)))
; (setq poly repl)
; (return 'changed))
; finally (return 'done))
@@ -867,7 +867,7 @@ substituting them to be zero."
when (setq tem (part-above-degree (num poly) (car v)))
do (setq changes t changed t)
(setq repl (replace-monomial-rat poly (second v) (car v) tem ))
- (cond ((eq (num repl) 0)(setq changes nil)))
+ (cond ((eql (num repl) 0)(setq changes nil)))
(setq poly (cons (num repl) 1))
(return 'changed))
finally (return 'done))))
@@ -887,7 +887,7 @@ substituting them to be zero."
when (setq tem (part-above-degree (num poly) (car v)))
do (setq changes t changed t)
(setq repl (replace-monomial-rat poly (second v) (car v) tem ))
- (cond ((eq (num repl) 0)(setq changes nil)))
+ (cond ((eql (num repl) 0)(setq changes nil)))
(setq poly repl)
(return 'changed))
finally (return 'done))
@@ -904,7 +904,7 @@ substituting them to be zero."
; when (setq tem (part-above-degree (num poly) (car v)))
; do (setq changes t changed t)
; (setq repl (replace-monomial (num poly) (second v) (car v) tem ))
-; (cond ((eq (num repl) 0)(setq changes nil)))
+; (cond ((eql (num repl) 0)(setq changes nil)))
; (setq poly (ratreduce (num repl) (ptimes (denom poly) (denom repl))))
; (return 'changed))
; finally (return 'done))
@@ -1021,7 +1021,7 @@ substituting them to be zero."
(cond ((null a-list)
(setq a-list (loop for v in *genvar* collecting
(intern (string-trim "$" (get v 'disrep)))))))
- (check-arg a-list (eq (length a-list) (length *genvar*)) "not right length")
+ (check-arg a-list (eql (length a-list) (length *genvar*)) "not right length")
(loop for v in *genvar*
for w in a-list
do
@@ -1045,7 +1045,7 @@ substituting them to be zero."
(setq mee (new-rat me))
(add-to-poly-simplifications mee)
(check-overlaps 10 :add-to-simps t :reset t)
- (cond ((eq 0 ($polysimp '$ggggg)) t)
+ (cond ((eql 0 ($polysimp '$ggggg)) t)
(t nil)))
(setq *poly-simplifications* old-simps)))
@@ -1078,7 +1078,7 @@ substituting them to be zero."
; below is similar but just uses occurs-in instead of must-replacep"
; (let (rat-vars tem vv)
; (check-arg variables $listp "macsyma list")
-; (cond ((= n 0)(cond ((member 1 replacements :test #'eq) nil)
+; (cond ((= n 0)(cond ((member 1 replacements) nil)
; (t (list 1))))
; ((= n 1)
; (setq rat-vars (loop for v in (cdr variables)
@@ -1131,7 +1131,7 @@ substituting them to be zero."
(cond (reset (clear-memory-function 'grobner-monomials)))
(let (rat-vars tem vv)
(check-arg variables $listp "macsyma list")
- (cond ((= n 0)(cond ((member 1 replacements :test #'eq) nil)
+ (cond ((= n 0)(cond ((member 1 replacements) nil)
(t (list 1))))
((= n 1)
(setq rat-vars (loop for v in (cdr variables)
@@ -1226,13 +1226,13 @@ substituting them to be zero."
; (:$rat (member (caadr x) *genvar* :test #'eq)(setq x (cdr x)))
; (t nil))
; (cond ((numberp x) x)
-; ((and (rational-functionp x)(eq (denom x) 1))(num x))
+; ((and (rational-functionp x)(eql (denom x) 1))(num x))
; (t x)))
; (t (cond ((member (poly-type x) '(:rational-function :polynomial :number) :test #'eq)
; (merror "not in standard rat form ~A " x))
; (t (setq answer (new-rat x))(show (denom answer))
; (cond ((and (rational-functionp answer)
-; (eq (denom answer) 1)) (num answer))
+; (eql (denom answer) 1)) (num answer))
; (t answer)))))))
(defun st-rat (x)
@@ -1242,7 +1242,7 @@ substituting them to be zero."
(defun st-rat1 (x)
(cond ((affine-polynomialp x) x)
- ((rational-functionp x) (cond ((eq (denom x) 1)(num x))
+ ((rational-functionp x) (cond ((eql (denom x) 1)(num x))
(t x)))
(($ratp x) (cond ((numberp (num (cdr x))) (st-rat (cdr x)))
((member (caadr x) *genvar* :test #'eq)(st-rat (cdr x)))
diff --git a/share/affine/sheafa.lisp b/share/affine/sheafa.lisp
index 584c221..1754573 100644
--- a/share/affine/sheafa.lisp
+++ b/share/affine/sheafa.lisp
@@ -264,7 +264,7 @@
(defun remove-common-factors (from-poly divisor &aux answ)
(setq answ (pgcdcofacts from-poly divisor))
- (if (eq 1 (car answ))
+ (if (eql 1 (car answ))
(second answ)
(remove-common-factors (second answ) (first answ))))
@@ -429,7 +429,7 @@
(cond ((atom poly) poly)
(t (constant-term
(let ((leng (length poly)))
- (cond ((eq (nth (- leng 2) poly) 0)
+ (cond ((eql (nth (- leng 2) poly) 0)
(constant-term (nth (1- leng) poly) ))
(t 0)))))))
@@ -442,14 +442,14 @@
(t
(cond ((atom poly) nil)
(t (loop for v in linear-variables
- when (eq (pdegree poly v) 1)
+ when (eql (pdegree poly v) 1)
do (setq tem (zero-sublis poly v))
(cond ((may-invertp tem inequal)
(return v)))))))))
(defun degree-one-variables (poly)
(loop for v in (list-variables poly)
- when (eq (pdegree poly v) 1)
+ when (eql (pdegree poly v) 1)
collecting v ))
(defun one-prepared (poly &key linear-variables &aux tem)
@@ -458,7 +458,7 @@
(cond ((atom poly) nil)
((zerop (constant-term poly)) nil)
(t (loop for v in linear-variables
- when (eq (pdegree poly v) 1)
+ when (eql (pdegree poly v) 1)
do (setq tem (zero-sublis poly v))
(cond ((numberp tem) (return v)))))))
@@ -468,16 +468,16 @@
;(defun gm-prepared (poly &key m (inequal 1) linear-variables &aux lins tem answ)
; (cond (m
; (cond ((atom poly ) nil)
-; ((eq 1 m)(cond ((setq tem (gone-prepared poly inequal :linear-variables linear-variables)))
+; ((eql 1 m)(cond ((setq tem (gone-prepared poly inequal :linear-variables linear-variables)))
; (list tem))))
; (t (loop for v in (list-variables poly)
; when
-; (eq (pdegree poly v) 1)
+; (eql (pdegree poly v) 1)
; do (setq tem (zero-sublis poly v))
; (cond ((setq answ (gm-prepared tem :m (1- m) :inequal inequal))
; (return (cons v answ))))))))
; (t (setq lins (loop for v in (list-variables poly)
-; when (eq (pdegree poly v) 1)
+; when (eql (pdegree poly v) 1)
; count 1))
; (loop for i from 1 to lins
; when (setq answ (gm-prepared poly :m i :inequal inequal))
@@ -496,7 +496,7 @@
(cond ((null linear-variables) (setq linear-variables
(degree-one-variables poly))))
(cond (m
- (cond ((eq m 0)(cond ((may-invertp poly inequal)(list 'ok))
+ (cond ((eql m 0)(cond ((may-invertp poly inequal)(list 'ok))
(t nil)))
(t
(loop for v in (list-variables poly)
@@ -535,7 +535,7 @@
(return (cons v answ))))))))
(t (setq lins (loop for v in linear-variables
- when (eq (pdegree poly v) 1)
+ when (eql (pdegree poly v) 1)
count 1))
(loop for i from 1 to (min lins *maximum-size-for-m-prepared* )
when (setq answ (gm-prepared poly :m i :inequal inequal :linear-variables
@@ -549,7 +549,7 @@
(cond (m
(cond ((atom poly ) nil)
((zerop (constant-term poly)) nil)
- ((eq 1 m)(cond ((setq tem (one-prepared poly))
+ ((eql 1 m)(cond ((setq tem (one-prepared poly))
(list tem))))
(t (loop for v in linear-variables
do (setq tem (zero-sublis poly v))
@@ -574,7 +574,7 @@
(defun gen-ptimes (&rest l)
(cond ((null l) 1)
- ((eq (length l) 1) (car l))
+ ((eql (length l) 1) (car l))
(t (ptimes (car l) (apply 'gen-ptimes (cdr l))))))
@@ -912,13 +912,13 @@
(check-containments orig-ldata answ)
(cond ((and (null *stop-simplify*)
;;this makes the divide dichotomy only apply after no more prod. dichot.
- (eq (length answ ) 1))
+ (eql (length answ) 1))
(setq answ
(divide-dichotomy (car answ) :open-g open-g))))
(check-containments orig-ldata answ)
; (cond ((not (equal (length answ) 1)) (mshow answ)))
(cond ((and (null *stop-simplify*)
- (eq (length answ ) 1))
+ (eql (length answ) 1))
(setq answ (try-factor-irreducible-ldata (car answ) open-g))))
(cond ((and (null *stop-simplify*) (not recursive-p)
@@ -928,7 +928,7 @@
appending (linear-dichotomy ld :open-g open-g )))))))
; (cond ((and (null *stop-simplify*)(not (variable-boundp *in-linear-dich*))
; (not recursive-p)
-; (eq (length answ ) 1))
+; (eql (length answ) 1))
; (let ((*in-linear-dich* t))
; (setq answ (linear-dichotomy (car answ) :open-g open-g )))))
; (format t "~%Verifying the ~A component contain the original" (length answ))
@@ -1764,7 +1764,7 @@
(defun poly-linearp (poly var may-invert &aux cof)
(cond ((numberp poly ) nil)
- ((eq (pdegree poly var) 1)
+ ((eql (pdegree poly var) 1)
(setq cof (pcoeff poly (list var 1 1)))
(cond ((atom cof) cof)
((may-invertp cof may-invert) cof)
@@ -1903,7 +1903,7 @@
(defun add-to-chain (poly chain)
(setq poly (square-free poly))
- (cond ((eq poly 0) chain)
+ (cond ((eql poly 0) chain)
(t (loop for v in chain
when (eq (p-var poly)(p-var v))
do (cond ((< (p-le poly) (p-le v))(show 'deleting)
@@ -1956,7 +1956,7 @@
;(defun add-to-chain (poly chain)
-; (cond ((eq poly 0) chain)
+; (cond ((eql poly 0) chain)
; (t
; (loop for v on chain
; collecting (car v) into tem
@@ -2363,11 +2363,11 @@ would restore the list"
; make-dichotomy
; (setq answ (new-make-dichotomy ldata :open-g open-g))
; ;;if no dichotomy continue
-; (cond ((eq (length answ) 1) (setq ldata (car answ)))
+; (cond ((eql (length answ) 1) (setq ldata (car answ)))
; (t (return (delete-redundant-ldata answ))))
; divide-dichotomy
; (setq answ (new-divide-dichotomy ldata :open-g open-g))
-; (cond ((eq (length answ) 1) (setq ldata (car answ)))
+; (cond ((eql (length answ) 1) (setq ldata (car answ)))
; (t (return (delete-redundant-ldata answ))))
; (return answ)))
;
diff --git a/share/affine/sheafb.lisp b/share/affine/sheafb.lisp
index 5ad9260..7a263a1 100644
--- a/share/affine/sheafb.lisp
+++ b/share/affine/sheafb.lisp
@@ -960,7 +960,7 @@
(loop for v in variables
collecting
(loop for w in simpl-eqns
- when (eq (pdegree w v ) 1)
+ when (eql (pdegree w v) 1)
;;(poly-linearp w v invertible) the variables get replaced
do (return (linear-poly-solve w v)))))
@@ -1037,7 +1037,7 @@
(t (setq prep-fns (loop for v in list-fns
when (setq tem (gm-prepared v :inequal open-g))
collecting v ))
- (cond ((eq (length prep-fns) 1)
+ (cond ((eql (length prep-fns) 1)
(best-open-cover1 prep-fns open-g))
(t (loop for v in prep-fns
do
@@ -1057,7 +1057,7 @@
finally
(return
(loop for v in possible
- when (eq (length v ) min)
+ when (eql (length v) min)
do (return v)))))))))
(defun eliminate-multiples (list-fns &key (square-free t) &aux tem facts)
@@ -1107,7 +1107,7 @@
collecting (nplcm open-g w)))
(defun all-perms (list-lists)
- (cond ((eq (length list-lists) 1) (car list-lists))
+ (cond ((eql (length list-lists) 1) (car list-lists))
(t (loop for v in (car list-lists)
appending
(loop for w in (all-perms (cdr list-lists))
@@ -1671,7 +1671,7 @@
collecting v into some-ld
finally (cond ((> (length some-ld) 1)
(fsignal "Too many components"))
- ((eq (length some-ld) 1)
+ ((eql (length some-ld) 1)
(car some-ld))
(t nil))))
(t (setq simp-contract (car simp-contract)))))))
@@ -1830,7 +1830,7 @@
(nreverse result))
(defun intersection-equal1 (&rest l)
- (cond ((eq (length l) 1) (car l))
+ (cond ((eql (length l) 1) (car l))
(t (apply #'intersection-equal (loop for v in (car l)
when (member v (second l) :test #'equal)
collecting v)
@@ -1944,8 +1944,8 @@
when unit
do (return 'unit)
when
- cont do (cond ((eq (length (ldata-eqns v))
- (length (ldata-eqns image)))
+ cont do (cond ((eql (length (ldata-eqns v))
+ (length (ldata-eqns image)))
(return-from sue (cons current-open i)))
(t (format t "image properly contains zl-SOME part"))))
@@ -2270,7 +2270,7 @@
(iassert (member in-or-on '(in on) :test #'eq))
(cond ((equal (car body) 'when)
(setq when-clause (subseq body 0 2) body (cddr body)))
- (t (iassert (eq (length body) 2))))
+ (t (iassert (eql (length body) 2))))
(setq operation (first body) quantity (second body))
(cond ((member operation '(minimize maximize) :test #'equal)
(cond ((eq operation 'minimize)
@@ -2532,12 +2532,12 @@
(cond ((arrayp mat)
(let* ((dimensions (array-dimensions mat))
(number-dims (length dimensions)))
- (cond ((eq number-dims 2)
+ (cond ((eql number-dims 2)
(loop for i below (car dimensions)
do (format t "~%")
(loop for j below (second dimensions)
do (format t "~3D" (aref mat i j)))))
- ((eq number-dims 3)
+ ((eql number-dims 3)
(loop for i below (car dimensions)
do (format t "~%~%Block ~D " i)
(loop for j below (second dimensions)
diff --git a/share/affine/sheafc.lisp b/share/affine/sheafc.lisp
index 2929deb..165c57a 100644
--- a/share/affine/sheafc.lisp
+++ b/share/affine/sheafc.lisp
@@ -374,7 +374,7 @@
(defun monomialp (pol)
(cond((atom pol) t)
- (t (and (eq (length pol) 3) (monomialp (third pol))))))
+ (t (and (eql (length pol) 3) (monomialp (third pol))))))
(defun one-variablep (f)
(and (eql (length f) 3) (numberp (third f))))
@@ -634,7 +634,7 @@
collecting (cons op lis-dat) into all-data
and collecting i into opens-not-to-blowup
finally
- (cond ((eq (length opens-not-to-blowup) (length all-data))
+ (cond ((eql (length opens-not-to-blowup) (length all-data))
(merror "Not going to blowup anything")))
(return(values (construct-pre-ldata-sheaves :opens (mapcar 'car all-data)
:data (mapcar 'cdr all-data))
@@ -967,7 +967,7 @@
when (and
(not (member va variables-solved-for :test #'eq))
(not (member va variables-in-prev-eqns :test #'eq))
- (eq (pdegree f va) 1)
+ (eql (pdegree f va) 1)
(setq tem (linear-triangularp
(delete-nth i fns)
:varlist-of-fns
@@ -1000,7 +1000,7 @@
when (and (not (eql i j))
(member va lis :test #'eq))
do (return t)))
- (eq (pdegree f va) 1)
+ (eql (pdegree f va) 1)
(setq tem
(linear-solvedp
(delete-nth i fns)
@@ -1031,7 +1031,7 @@
when (and (not (eql i j))
(member va lis :test #'eq))
do (return t)))
- (eq (pdegree f va) 1)
+ (eql (pdegree f va) 1)
(progn (multiple-value-setq
(tem ord-fns)
(linear-solvedp
@@ -1095,7 +1095,7 @@
do
(setq one-pls (open-sub-scheme pls i))
(setq simp-one-pls (simplify-svar-ldata one-pls))
- (cond ((eq (length (pls-opens simp-one-pls)) 1)
+ (cond ((eql (length (pls-opens simp-one-pls)) 1)
(setq list-of-dat (car (pls-data simp-one-pls))))
(t (loop for ope in (pls-opens simp-one-pls)
for lis-dat in (pls-data simp-one-pls)
diff --git a/share/affine/sub-proj.lisp b/share/affine/sub-proj.lisp
index 9136cc1..5128627 100644
--- a/share/affine/sub-proj.lisp
+++ b/share/affine/sub-proj.lisp
@@ -123,7 +123,7 @@ denominator of denom^(pdegree poly var)"
(setf (cadr tail)
(poly-subst (cadr tail) var repl))))
(t (cond
- ((eq 0 (pdegree poly var)) nil)
+ ((eql 0 (pdegree poly var)) nil)
(t
(do ((tail (cdr poly)(cddr tail))
(answer 0))
@@ -228,7 +228,7 @@ poly)
when (not (pzerop tem))
collecting deg into lis
collecting tem into lis
- finally (return (cond ((eq (car lis) 0) (second lis))
+ finally (return (cond ((eql (car lis) 0) (second lis))
(t (cons (p-var b) lis))))))))
;;incorrect doesn't take into account the
@@ -249,7 +249,7 @@ poly)
when (not (pzerop tem))
collecting deg into lis
collecting tem into lis
- finally (return (cond ( (eq (car lis) 0)
+ finally (return (cond ((eql (car lis) 0)
(second lis))
(t (cons (p-var b) lis))))))))
@@ -383,10 +383,10 @@ poly)
((get (car poly) 'constant)
(loop for (deg cof) on (cdr poly) by #'cddr
do (coll-linear1 cof)))
- (t (cond ((and (eq (p-le poly) 1)
+ (t (cond ((and (eql (p-le poly) 1)
(constant-functionp (p-lc poly)))
(pushnew (p-var poly) *linear*)))
- (cond ((eq 0 (nth (- (length poly) 2) poly))
+ (cond ((eql 0 (nth (- (length poly) 2) poly))
(coll-linear1 (car (last poly)))))))
;;now must check these are really linear to remove the u collected above.
(cond ((consp poly)
diff --git a/share/algebra/grob1.lisp b/share/algebra/grob1.lisp
index ff010dd..9bdd2b6 100644
--- a/share/algebra/grob1.lisp
+++ b/share/algebra/grob1.lisp
@@ -430,9 +430,9 @@
(defun primpart (p)
(let ((d (do ((p (cdr p) (cdr p)) ;calcul du contenu
(g (caar p) (gcd g (caar p))))
- ((or (eq (abs g) 1) (null p))
+ ((or (eql (abs g) 1) (null p))
g) )))
- (or (eq (abs d) 1)
+ (or (eql (abs d) 1)
(mapc #'(lambda (u) ;diviser par le contenu
(rplaca u (quotient (car u) d)))
p))
diff --git a/share/contrib/altsimp/altsimp.lisp b/share/contrib/altsimp/altsimp.lisp
index 5330f06..58227a0 100644
--- a/share/contrib/altsimp/altsimp.lisp
+++ b/share/contrib/altsimp/altsimp.lisp
@@ -96,7 +96,7 @@ Unfixed:
;; (f) (* cf e) (default)
(defun number-times-expr (cf e)
- (cond ((eq cf 1) e)
+ (cond ((eql cf 1) e)
((mzerop cf) cf)
((mnump e) (timesk cf e)) ; didn't think this should happen
((and (onep1 (neg cf)) (mplusp e))
@@ -245,7 +245,7 @@ Unfixed:
(setq x (car x))
(while (and l (like x (caar l)))
(mincf cf (cdr (pop l))))
- (if (and (or (eq cf 1) (eq cf -1)) (mplusp x)) (setq do-over t))
+ (if (and (or (eql cf 1) (eql cf -1)) (mplusp x)) (setq do-over t))
(setq x (number-times-expr cf x))
(cond ((mnump x) (mincf num-sum x))
((not (mzerop x)) (push x acc))))
diff --git a/share/contrib/format/coeflist.lisp b/share/contrib/format/coeflist.lisp
index d14ac6c..ff86cdf 100644
--- a/share/contrib/format/coeflist.lisp
+++ b/share/contrib/format/coeflist.lisp
@@ -233,7 +233,7 @@
(defun list-negp (l1)
(dolist (i1 l1)
(unless (zerop1 i1)
- (return-from list-negp (eq -1 (signum1 i1))))))
+ (return-from list-negp (eql -1 (signum1 i1))))))
(defun tlist-add (l1 l2) (mapcar #'clist-add l1 l2))
diff --git a/share/contrib/gentran/vaxlsp.lisp b/share/contrib/gentran/vaxlsp.lisp
index dbe26b1..702c042 100755
--- a/share/contrib/gentran/vaxlsp.lisp
+++ b/share/contrib/gentran/vaxlsp.lisp
@@ -99,7 +99,7 @@
; ((mexpt) x -1) --> (quotient 1.0 x) ;
; ((mexpt) x ((mminus) i)) --> (quotient 1.0 (expt x i)) ;
(let ((var (cadr exp)) (pow (caddr exp)))
- (cond ((or (eq pow -1)
+ (cond ((or (eql pow -1)
(and (listp pow)
(eq (caar pow) 'mminus)
(onep (cadr pow))))
diff --git a/share/contrib/maxima-server.lisp b/share/contrib/maxima-server.lisp
index 6d9e1d7..68fd07c 100644
--- a/share/contrib/maxima-server.lisp
+++ b/share/contrib/maxima-server.lisp
@@ -63,9 +63,9 @@
; thus grandchild doesn't become a zombie.
(let ((child-pid (sb-posix:fork)))
- (if (eq child-pid 0)
+ (if (eql child-pid 0)
(let ((grandchild-pid (sb-posix:fork)))
- (if (eq grandchild-pid 0)
+ (if (eql grandchild-pid 0)
(progn
; Grandchild process: I execute the Maxima session here.
(let*
diff --git a/share/fourier_elim/fourier_elim.lisp b/share/fourier_elim/fourier_elim.lisp
index f0298ff..41bebb7 100644
--- a/share/fourier_elim/fourier_elim.lisp
+++ b/share/fourier_elim/fourier_elim.lisp
@@ -562,7 +562,7 @@
(list
;;(list (opcons 'mlessp lb x) (opcons 'mlessp x ub))
bounds
- (if (some #'(lambda (s) (or (eq 0 s) (eq nil s))) acc) '$emptyset acc))))
+ (if (some #'(lambda (s) (or (eql 0 s) (eq nil s))) acc) '$emptyset acc))))
;; Apply max and min without looking at the current context; if something goes wrong,
;; cleanup the mess.
diff --git a/share/graphs/graph_core.lisp b/share/graphs/graph_core.lisp
index 557a30a..a246cd9 100644
--- a/share/graphs/graph_core.lisp
+++ b/share/graphs/graph_core.lisp
@@ -409,7 +409,7 @@
(defun require-medge (m ar e)
(cond
- ((not (and ($listp e) (eq 2 ($length e))))
+ ((not (and ($listp e) (eql 2 ($length e))))
($error "Argument" ar "to" m "is not an edge (0)."))
(t (let ((u ($first e)) (v ($second e)))
(unless (and (integerp u) (integerp v))
@@ -1391,7 +1391,7 @@
(defmfun $is_biconnected (gr)
(require-graph 'is_biconnected 1 gr)
- (eq ($length ($biconnected_components gr)) 1))
+ (eql ($length ($biconnected_components gr)) 1))
(defmfun $biconnected_components (gr)
(require-graph 'biconnected_components 1 gr)
@@ -1472,7 +1472,7 @@
(defmfun $is_sconnected (gr)
(require-digraph 'strong_components 1 gr)
- (eq ($length ($strong_components gr)) 1))
+ (eql ($length ($strong_components gr)) 1))
(defmfun $strong_components (gr)
(require-digraph 'strong_components 1 gr)
diff --git a/share/hypergeometric/hypergeometric.lisp b/share/hypergeometric/hypergeometric.lisp
index 2397016..ef86005 100644
--- a/share/hypergeometric/hypergeometric.lisp
+++ b/share/hypergeometric/hypergeometric.lisp
@@ -83,7 +83,7 @@
(or (and (not ah) bh) (and ah bh (>= bh ah)))) 'undefined)
((or ah (zerop1 ($ratdisrep x))
- (and ($taylorp x) (eq 0 ($second ($first ($taylorinfo x))))
+ (and ($taylorp x) (eql 0 ($second ($first ($taylorinfo x))))
(integerp ($third ($first ($taylorinfo x))))))
'polynomial)
@@ -493,13 +493,13 @@ ff(a,b,c,x,n) := block([f, f0 : 1, f1 : 1- 2 * b / c,s : 1,k : 1, cf : a / (1-2/
;; In the general case, sum the hypergeometric series using a running error, recursing
;; on local-fpprec; bailout when local-fpprec exceeds 1000.
- (cond ((and (eq a-len 0) (eq b-len 0)) ;; special case 0f0
+ (cond ((and (eql a-len 0) (eql b-len 0)) ;; special case 0f0
(values (0f0-numeric x) digits))
- ((and (eq a-len 1) (eq b-len 0)) ;; special case 1f0
+ ((and (eql a-len 1) (eql b-len 0)) ;; special case 1f0
(values (1f0-numeric (first a) x) digits))
- ((and (eq a-len 1) (integerp (first a)) (< (first a) 0) (eq b-len 1)) ;; special case 1f1
+ ((and (eql a-len 1) (integerp (first a)) (< (first a) 0) (eql b-len 1)) ;; special case 1f1
(maxima::bind-fpprec local-fpprec
(multiple-value-setq (f d) (1f1-downward-recursion (first a) (first b) x)))
(values f d))
@@ -513,8 +513,8 @@ ff(a,b,c,x,n) := block([f, f0 : 1, f1 : 1- 2 * b / c,s : 1,k : 1, cf : a / (1-2/
((and adjust-params
- (eq a-len 1)
- (eq b-len 1)
+ (eql a-len 1)
+ (eql b-len 1)
(< (realpart x) 0))
(let ((f) (d))
(multiple-value-setq (f d) (hypergeometric-float-eval
@@ -523,7 +523,7 @@ ff(a,b,c,x,n) := block([f, f0 : 1, f1 : 1- 2 * b / c,s : 1,k : 1, cf : a / (1-2/
(values (* (exp x) f) d)))
;; analytic continuation for 2f1;
- ((and (eq a-len 2) (eq b-len 1) adjust-params)
+ ((and (eql a-len 2) (eql b-len 1) adjust-params)
(2f1-numeric (car ma) (cadr ma) (car mb) mx digits))
((or (< a-len (+ b-len 1)) (in-unit-circle-p x) (eq 'maxima::polynomial
@@ -563,8 +563,8 @@ ff(a,b,c,x,n) := block([f, f0 : 1, f1 : 1- 2 * b / c,s : 1,k : 1, cf : a / (1-2/
(let ((fo 1) (fm1 (- 1 (/ x b))) (f) (k -1) (efo 0) (efm1 0) (ef 0))
(declare (type fixnum k))
(setq k -1)
- (cond ((eq a 0) (values fo 0))
- ((eq a -1) (values fm1 0))
+ (cond ((eql a 0) (values fo 0))
+ ((eql a -1) (values fm1 0))
(t
(setq x (- x b))
(while (>= k a)
@@ -680,7 +680,7 @@ ff(a,b,c,x,n) := block([f, f0 : 1, f1 : 1- 2 * b / c,s : 1,k : 1, cf : a / (1-2/
(let ((n nil) (z 1) (s 1) (p) (q) (cf 1))
;; Determine how many terms to sum
- (cond ((and ($taylorp x) (eq 0 ($second ($first ($taylorinfo x))))
+ (cond ((and ($taylorp x) (eql 0 ($second ($first ($taylorinfo x))))
(integerp ($third ($first ($taylorinfo x)))))
(setq n ($third ($first ($taylorinfo x)))))
@@ -766,7 +766,7 @@ ff(a,b,c,x,n) := block([f, f0 : 1, f1 : 1- 2 * b / c,s : 1,k : 1, cf : a / (1-2/
(b-1 (add b -1))
(prod_b-1 (reduce #'mul (margs b-1)))
(prod_a-1 (reduce #'mul (margs a-1))))
- (if (eq prod_a-1 0)
+ (if (eql prod_a-1 0)
(mul z (take '($hypergeometric) (append a '(1)) (append b '(2)) z))
(mul prod_b-1 (inv prod_a-1) (take '($hypergeometric) a-1 b-1 z)))))
diff --git a/share/integer_sequence/integer_sequence.lisp b/share/integer_sequence/integer_sequence.lisp
index 427ebab..6f36c5c 100644
--- a/share/integer_sequence/integer_sequence.lisp
+++ b/share/integer_sequence/integer_sequence.lisp
@@ -53,7 +53,7 @@ declared integer) or sign(b - a) is negative or zero and h is nonzero.
(simplify `((mlist))))
((not k) `(($.. simp) ,i ,j))
- ((eq 1 j) `(($.. simp) ,i ,k)) ; a .. 1 .. b == a .. b
+ ((eql 1 j) `(($.. simp) ,i ,k)) ; a .. 1 .. b == a .. b
(t `(($.. simp) ,i ,j ,k)))))
-
\ No newline at end of file
+
diff --git a/share/lbfgs/maxima-lbfgs.lisp b/share/lbfgs/maxima-lbfgs.lisp
index 6268f0a..580215a 100644
--- a/share/lbfgs/maxima-lbfgs.lisp
+++ b/share/lbfgs/maxima-lbfgs.lisp
@@ -145,7 +145,7 @@ estimates : lbfgs ('[F(a, b, c), [F1(a, b, c), F2(a, b, c), F3(a, b, c)]],
; That's what's returned if algorithm doesn't converge; better than nothing, I hope.
(setq return-value (append '((mlist)) (mapcar #'(lambda (a b) `((mequal) ,a ,b)) (cdr x-list) (coerce scache 'list))))
(cond
- ((eq iflag 0)
+ ((eql iflag 0)
(return)))))
return-value))
diff --git a/share/logic/logic.lisp b/share/logic/logic.lisp
index 641094f..850d24b 100644
--- a/share/logic/logic.lisp
+++ b/share/logic/logic.lisp
@@ -195,7 +195,7 @@
(setf args (remove-duplicates (remove nil args) :test 'equal))
(cond
((null args) t)
- ((eq (length args) 1) (simp-not (car args)))
+ ((eql (length args) 1) (simp-not (car args)))
(t (cons (list *nor-op* 'simp) (sort-symbols args)))))
; Sheffer stroke (alternative denial, NAND)
@@ -206,7 +206,7 @@
(setf args (remove-duplicates (remove t args) :test 'equal))
(cond
((null args) nil)
- ((eq (length args) 1) (simp-not (car args)))
+ ((eql (length args) 1) (simp-not (car args)))
(t (cons (list *nand-op* 'simp) (sort-symbols args)))))
; Equivalence
@@ -214,7 +214,7 @@
(setf args (cancel-pairs (remove t (flatten-nested args *eq-op*))))
(cond
((null args) t)
- ((eq (length args) 1) (car args))
+ ((eql (length args) 1) (car args))
(t (cons (list *eq-op* 'simp) (sort-symbols args)))))
; Sum modulo 2 (exclusive or)
@@ -222,7 +222,7 @@
(setf args (cancel-pairs (remove nil (flatten-nested args *xor-op*))))
(cond
((null args) nil)
- ((eq (length args) 1) (car args))
+ ((eql (length args) 1) (car args))
(t (cons (list *xor-op* 'simp) (sort-symbols args)))))
; returns t if args = (... x ... not x ...)
@@ -246,7 +246,7 @@
(setf args (remove-duplicates (remove t args) :test 'equal))
(cond
((null args) t)
- ((eq (length args) 1) (car args))
+ ((eql (length args) 1) (car args))
(t
(if (x-not-x args)
nil
@@ -261,7 +261,7 @@
(setf args (remove-duplicates (remove nil args) :test 'equal))
(cond
((null args) nil)
- ((eq (length args) 1) (car args))
+ ((eql (length args) 1) (car args))
(t
(if (x-not-x args)
t
diff --git a/share/numeric/decfp-core.lisp b/share/numeric/decfp-core.lisp
index b3db702..98cb62d 100644
--- a/share/numeric/decfp-core.lisp
+++ b/share/numeric/decfp-core.lisp
@@ -52,7 +52,7 @@ is (sum+1/10^50=1.0L0) ; should be true
(defun decimalfptrim(f &optional (flag $rounddecimalfloats)) ;; f is (significand exponent)
(let ((s (car f))
(e (cadr f)))
- (cond((eq s 0)(list 0 0))
+ (cond((eql s 0)(list 0 0))
(t
;; first remove trailing zeros
(while (= (mod s 10) 0)(setf s (truncate s 10))(incf e))
diff --git a/share/numericalio/encode-decode-float.lisp b/share/numericalio/encode-decode-float.lisp
index 07a3303..60a67df 100644
--- a/share/numericalio/encode-decode-float.lisp
+++ b/share/numericalio/encode-decode-float.lisp
@@ -65,12 +65,12 @@
(* sign (scale-float (float significand 1d0) exponent))))
(defun extract-smashed-float-64-from-integer (x)
- (if (eq x 0)
+ (if (eql x 0)
(values 0 0 0)
(let
((significand (dpb x (byte 52 0) #x10000000000000))
(exponent (- (ldb (byte 11 52) x) 1023 52))
- (sign (if (eq (ldb (byte 1 63) x) 0) 1 -1)))
+ (sign (if (eql (ldb (byte 1 63) x) 0) 1 -1)))
(values significand exponent sign))))
;; Stream input and output
diff --git a/share/numericalio/numericalio.lisp b/share/numericalio/numericalio.lisp
index 14286eb..e933193 100644
--- a/share/numericalio/numericalio.lisp
+++ b/share/numericalio/numericalio.lisp
@@ -274,7 +274,7 @@
(loop
(if
(or
- (and n (eq n 0))
+ (and n (eql n 0))
(eq (setq x (if (eq mode 'text) (parse-next-element in sep-ch) (read-float-64 in)))
'eof))
(return (cons '(mlist simp) (nreverse A))))
@@ -361,7 +361,7 @@
(return nil)
(return 'eof)))
((and (eq token sep-ch) (not (eq sep-ch #\space)))
- (if (or found-sep-ch (eq initial-pos 0))
+ (if (or found-sep-ch (eql initial-pos 0))
(progn
(setq pushback-sep-ch token)
(return nil))
diff --git a/share/orthopoly/orthopoly.lisp b/share/orthopoly/orthopoly.lisp
index 2886377..d0805e4 100644
--- a/share/orthopoly/orthopoly.lisp
+++ b/share/orthopoly/orthopoly.lisp
@@ -299,10 +299,10 @@ Maxima code for evaluating orthogonal polynomials listed in Chapter 22 of Abramo
(setq n (simplifya (third e) z))
($taylor (div (take '(%gamma) (add x n)) (take '(%gamma) x))))
- ((eq n 0) 1)
+ ((eql n 0) 1)
;; pochhammer(1,n) = n! (factorial is faster than bigfloat::pochhammer.)
- ((eq x 1) (take '(mfactorial) n))
+ ((eql x 1) (take '(mfactorial) n))
;; pure numeric evaluation--use numeric package.
((and (integerp n) (complex-number-p x '$numberp))
@@ -743,7 +743,7 @@ Maxima code for evaluating orthogonal polynomials listed in Chapter 22 of Abramo
(div (factorial (+ n m)) (factorial (- n m)))))
(setq dx 1))
(t
- (cond ((eq m 0)
+ (cond ((eql m 0)
(setq d 1))
(t
(setq d (simplify
diff --git a/share/pdiff/pdiff.lisp b/share/pdiff/pdiff.lisp
index 7ff0fec..352a837 100644
--- a/share/pdiff/pdiff.lisp
+++ b/share/pdiff/pdiff.lisp
@@ -240,7 +240,7 @@
(defun tex-pderivop (x l r)
;(print `(lop = ,lop rop = ,rop x = ,x r = ,r l = ,l))
- (cond ((and $tex_uses_prime_for_derivatives (eq 3 (length x)))
+ (cond ((and $tex_uses_prime_for_derivatives (eql 3 (length x)))
(let* ((n (car (last x)))
(p))
diff --git a/share/sym/schur.lisp b/share/sym/schur.lisp
index 3a093f9..2dc36e2 100644
--- a/share/sym/schur.lisp
+++ b/share/sym/schur.lisp
@@ -116,7 +116,7 @@
(cons (car l)
(mapcan #'(lambda (nb)
(setq i (1- i))
- (and (not (eq nb 0)) (list i nb)))
+ (and (not (eql nb 0)) (list i nb)))
(nreverse (cdr l)))))
(lect $pol
(cons 'aa (lvar_lettre (cdr varetdegre) nil
diff --git a/share/tensor/itensor.lisp b/share/tensor/itensor.lisp
index 29c8605..7590475 100644
--- a/share/tensor/itensor.lisp
+++ b/share/tensor/itensor.lisp
@@ -97,7 +97,7 @@
((null l) l)
((and (numberp (car l)) (< (car l) 0)) (plusi (cdr l)))
((atom (car l)) (cons (car l) (plusi (cdr l))))
- ((and (isprod (caar l)) (eq (cadar l) -1)) (plusi (cdr l)))
+ ((and (isprod (caar l)) (eql (cadar l) -1)) (plusi (cdr l)))
(t (cons (car l) (plusi (cdr l))))
)
)
@@ -108,7 +108,7 @@
((and (numberp (car l)) (< (car l) 0)) (cons (neg (car l)) (plusi (cdr l))))
((atom (car l)) (minusi (cdr l)))
(
- (and (isprod (caar l)) (eq (cadar l) -1))
+ (and (isprod (caar l)) (eql (cadar l) -1))
(cons (caddar l) (minusi (cdr l)))
)
(t (minusi (cdr l)))
@@ -262,7 +262,7 @@
)
(
(> nargs 1)
- (and (eq 1 (length (arg 2))) (return ($ichr1 (arg 1))))
+ (and (eql 1 (length (arg 2))) (return ($ichr1 (arg 1))))
(merror "ichr1 cannot have contravariant indices")
)
(t ; G_abc = 1/2*(g_ba,c+g_ca,b-g_bc,a)
@@ -821,7 +821,7 @@
(cond
((or (atom o) (atom (car o))) (setq l1 (cons o l1)))
(
- (and (eq (caar o) 'mexpt) (eq (caddr o) -1))
+ (and (eq (caar o) 'mexpt) (eql (caddr o) -1))
(setq l2 (cons (cadr o) l2))
)
(t (setq l1 (cons o l1)))
@@ -886,7 +886,7 @@
(cdddr e)
)
)
- (return (cond ((and f (eq sgn -1)) (list '(mtimes) sgn c)) (t c)))
+ (return (cond ((and f (eql sgn -1)) (list '(mtimes) sgn c)) (t c)))
)
)
)
@@ -953,7 +953,7 @@
;;*** contract5 may return a negative result
(setq f (contract5 f))
(cond (
- (and (or (eq (car f) '(mtimes)) (eq (car f) '(mtimes simp))) (eq (cadr f) -1))
+ (and (or (eq (car f) '(mtimes)) (eq (car f) '(mtimes simp))) (eql (cadr f) -1))
(setq l1 (cons -1 l1) f (caddr f)) ))
(cond ((getcon (caar f))
(setq l2 (cons f l2)))
@@ -981,7 +981,7 @@
;;*** contract3 may also return a negative result
(setq sf (mapcar #'(lambda (x)
(cond ((atom x) x) (
- (and (or (equal (car x) '(mtimes)) (equal (car x) '(mtimes simp))) (eq (cadr x) -1))
+ (and (or (equal (car x) '(mtimes)) (equal (car x) '(mtimes simp))) (eql (cadr x) -1))
(setq l1 (cons -1 l1)) (caddr x)) (t x))
) sf ) )
@@ -1023,7 +1023,7 @@
;;*** contract3 may also return a negative result
(setq sf (mapcar #'(lambda (x)
(cond ((atom x) x) (
- (and (or (equal (car x) '(mtimes)) (equal (car x) '(mtimes simp))) (eq (cadr x) -1))
+ (and (or (equal (car x) '(mtimes)) (equal (car x) '(mtimes simp))) (eql (cadr x) -1))
(setq l1 (cons -1 l1)) (caddr x)) (t x))
) sf ) )
@@ -1093,7 +1093,7 @@
(defun removenotinm (i l)
(cond ((null l) l)
((atom (car l)) (cons (car l) (removenotinm i (cdr l))))
- ((and (isprod (caar l)) (eq (cadar l) -1)
+ ((and (isprod (caar l)) (eql (cadar l) -1)
(not (member (caddar l) i :test #'eq))) (removenotinm i (cdr l)))
(t (cons (car l) (removenotinm i (cdr l))))
)
@@ -1208,7 +1208,7 @@
; properties. We use CANFORM to sort indices in the canonical order
; and then extract the resulting expression's sign.
(setq sgn
- (cond ((eq -1 (cadr ($canform (list '(mtimes simp) f g)))) -1) (t 1))
+ (cond ((eql -1 (cadr ($canform (list '(mtimes simp) f g)))) -1) (t 1))
)
;If g matches an a then use the b for name of result. If an a is a space
@@ -1320,8 +1320,8 @@
(member (car cf) christoffels1)
(cond
(
- ;;(and (eq (length a) 2) (eq (length b) 1))
- (and (eq (+ (length (plusi a)) (length (minusi b))) 2) (eq (+ (length (plusi b)) (length (minusi a))) 1))
+ ;;(and (eql (length a) 2) (eql (length b) 1))
+ (and (eql (+ (length (plusi a)) (length (minusi b))) 2) (eql (+ (length (plusi b)) (length (minusi a))) 1))
(setq cf
(cons
(elt christoffels2 (position (car cf) christoffels1))
@@ -1330,8 +1330,8 @@
)
)
(
- ;; (not (and (eq (length a) 3) (eq (length b) 0)))
- (not (and (eq (+ (length (plusi a)) (length (minusi b))) 3) (eq (+ (length (plusi b)) (length (minusi a))) 0)))
+ ;; (not (and (eql (length a) 3) (eql (length b) 0)))
+ (not (and (eql (+ (length (plusi a)) (length (minusi b))) 3) (eql (+ (length (plusi b)) (length (minusi a))) 0)))
(return nil)
)
)
@@ -1340,8 +1340,8 @@
(member (car cf) christoffels2)
(cond
(
- ;;(and (eq (length a) 3) (eq (length b) 0))
- (and (eq (+ (length (plusi a)) (length (minusi b))) 3) (eq (+ (length (plusi b)) (length (minusi a))) 0))
+ ;;(and (eql (length a) 3) (eql (length b) 0))
+ (and (eql (+ (length (plusi a)) (length (minusi b))) 3) (eql (+ (length (plusi b)) (length (minusi a))) 0))
(setq cf
(cons
(elt christoffels1 (position (car cf) christoffels2))
@@ -1350,8 +1350,8 @@
)
)
(
- ;;(not (and (eq (length a) 2) (eq (length b) 1)))
- (not (and (eq (+ (length (plusi a)) (length (minusi b))) 2) (eq (+ (length (plusi b)) (length (minusi a))) 1)))
+ ;;(not (and (eql (length a) 2) (eql (length b) 1)))
+ (not (and (eql (+ (length (plusi a)) (length (minusi b))) 2) (eql (+ (length (plusi b)) (length (minusi a))) 1)))
(return nil)
)
)
@@ -1367,7 +1367,7 @@
(setq f (idiff f (car e)))
)
)
- (return (cond ((eq sgn -1) (list '(mtimes) sgn f)) (t f)))
+ (return (cond ((eql sgn -1) (list '(mtimes) sgn f)) (t f)))
)
)
@@ -1602,9 +1602,9 @@
(cond
((and
(eq (caar x) $imetric)
- (eq (length (cdadr x)) 0)
- (eq (length (cdaddr x)) 2)
- (eq (length (cdddr x)) 0)
+ (eql (length (cdadr x)) 0)
+ (eql (length (cdaddr x)) 2)
+ (eql (length (cdddr x)) 0)
)
(list '(mtimes simp)
-1
@@ -1617,9 +1617,9 @@
)
((and
(eq (caar x) $imetric)
- (eq (length (cdadr x)) 2)
- (eq (length (cdaddr x)) 0)
- (eq (length (cdddr x)) 0)
+ (eql (length (cdadr x)) 2)
+ (eql (length (cdaddr x)) 0)
+ (eql (length (cdddr x)) 0)
)
(list '(mtimes simp)
(list '(%determinant simp) $imetric)
@@ -1646,12 +1646,12 @@
(boundp '$imetric)
(eq (caar e) $imetric)
(eq (caar x) $imetric)
- (eq (length (cdadr e)) 2)
- (eq (length (cdaddr e)) 0)
- (eq (length (cdddr e)) 0)
- (eq (length (cdadr x)) 0)
- (eq (length (cdaddr x)) 2)
- (eq (length (cdddr x)) 0)
+ (eql (length (cdadr e)) 2)
+ (eql (length (cdaddr e)) 0)
+ (eql (length (cdddr e)) 0)
+ (eql (length (cdadr x)) 0)
+ (eql (length (cdaddr x)) 2)
+ (eql (length (cdddr x)) 0)
)
(list '(mtimes simp)
-1
@@ -1673,12 +1673,12 @@
(boundp '$imetric)
(eq (caar e) $imetric)
(eq (caar x) $imetric)
- (eq (length (cdadr e)) 0)
- (eq (length (cdaddr e)) 2)
- (eq (length (cdddr e)) 0)
- (eq (length (cdadr x)) 2)
- (eq (length (cdaddr x)) 0)
- (eq (length (cdddr x)) 0)
+ (eql (length (cdadr e)) 0)
+ (eql (length (cdaddr e)) 2)
+ (eql (length (cdddr e)) 0)
+ (eql (length (cdadr x)) 2)
+ (eql (length (cdaddr x)) 0)
+ (eql (length (cdddr x)) 0)
)
(list '(mtimes simp)
-1
@@ -1700,12 +1700,12 @@
(boundp '$imetric)
(eq (caar e) $imetric)
(eq (caar x) $imetric)
- (eq (length (cdadr e)) 2)
- (eq (length (cdaddr e)) 0)
- (eq (length (cdddr e)) 1)
- (eq (length (cdadr x)) 0)
- (eq (length (cdaddr x)) 2)
- (eq (length (cdddr x)) 0)
+ (eql (length (cdadr e)) 2)
+ (eql (length (cdaddr e)) 0)
+ (eql (length (cdddr e)) 1)
+ (eql (length (cdadr x)) 0)
+ (eql (length (cdaddr x)) 2)
+ (eql (length (cdddr x)) 0)
)
(prog (d1 d2)
(setq d1 ($idummy) d2 ($idummy))
@@ -1774,12 +1774,12 @@
(boundp '$imetric)
(eq (caar e) $imetric)
(eq (caar x) $imetric)
- (eq (length (cdadr e)) 2)
- (eq (length (cdaddr e)) 0)
- (eq (length (cdddr e)) 1)
- (eq (length (cdadr x)) 0)
- (eq (length (cdaddr x)) 2)
- (eq (length (cdddr x)) 1)
+ (eql (length (cdadr e)) 2)
+ (eql (length (cdaddr e)) 0)
+ (eql (length (cdddr e)) 1)
+ (eql (length (cdadr x)) 0)
+ (eql (length (cdaddr x)) 2)
+ (eql (length (cdddr x)) 1)
)
(list '(mtimes simp)
-1
@@ -1806,12 +1806,12 @@
(boundp '$imetric)
(eq (caar e) $imetric)
(eq (caar x) $imetric)
- (eq (length (cdadr e)) 2)
- (eq (length (cdaddr e)) 0)
- (eq (length (cdddr e)) 2)
- (eq (length (cdadr x)) 0)
- (eq (length (cdaddr x)) 2)
- (eq (length (cdddr x)) 0)
+ ...
[truncated message content] |
