Menu
▾
▴
[Maxima-commits] [git] Maxima CAS branch rtoy-convert-cons-exp-to-ftake updated. branch-5_45-base-156-gcc2a4e7c5
|
From: Raymond T. <rt...@us...> - 2021-08-13 23:22:16
|
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, rtoy-convert-cons-exp-to-ftake has been updated
via cc2a4e7c58c6cf1b6ffcf96bc6ab2f79b0515704 (commit)
via 7c45bab557413b5cb3d84a65cce293dae0ddf015 (commit)
via c0a24ea89706cff5b6f8f737712ba2db5d9c87e8 (commit)
via c6ee18925dee922d8f8128bf3e11f6f2b9629fc5 (commit)
via 0bb4882e91e553f6058396c85b43019b63d1ba3b (commit)
from f53a339b1a55531c37849357970acdceeb361140 (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 cc2a4e7c58c6cf1b6ffcf96bc6ab2f79b0515704
Author: Raymond Toy <toy...@gm...>
Date: Fri Aug 13 16:22:06 2021 -0700
Comment out definitions of cons-exp
Comment out cons-exp but leave it for a bit until we're sure all uses
are gone. `git grep '(cons-exp'` shows that there are no longer any
occurrences.
diff --git a/src/mrgmac.lisp b/src/mrgmac.lisp
index 57ccab64e..d40bc1f7d 100644
--- a/src/mrgmac.lisp
+++ b/src/mrgmac.lisp
@@ -207,10 +207,13 @@
(push (list (third (zl-get (first s) 'mode)) x (second s) (second l)) nl))
(t (merror "STO: ~a" (car l))))))
+;;; Remove both of these once we're sure all uses of cons-exp have
+;;; been replaced by ftake*.
#+nil
(defmacro cons-exp (op &rest args)
`(simplify (list (list ,op) ,@args)))
+#+nil
(defmacro cons-exp (op &rest args)
`(ftake* ,op ,@args))
commit 7c45bab557413b5cb3d84a65cce293dae0ddf015
Author: Raymond Toy <toy...@gm...>
Date: Fri Aug 13 16:09:49 2021 -0700
Replace cons-exp with ftake* in contrib/format/coeflist.lisp
Replace all occurrences of cons-exp with ftake*.
diff --git a/share/contrib/format/coeflist.lisp b/share/contrib/format/coeflist.lisp
index ff86cdf84..a7296e15b 100644
--- a/share/contrib/format/coeflist.lisp
+++ b/share/contrib/format/coeflist.lisp
@@ -346,7 +346,7 @@
(defun untlist (tlist vars)
(flet ((un1 (list trig)
- (flet ((un2 (e)(mul (cadr e)(cons-exp trig (multl (cddr e) vars)))))
+ (flet ((un2 (e)(mul (cadr e)(ftake* trig (multl (cddr e) vars)))))
(addn (mapcar #'un2 list) t))))
(addn (mapcar #'un1 tlist '(%sin %cos)) t)))
@@ -373,7 +373,7 @@
(if (eq (second r) 'ps)
(mapcar #'(lambda (p)
(list (specdisrep (cons hdr (cdr p)))
- (cons-exp 'rat (caar p)(cdar p))))
+ (ftake* 'rat (caar p)(cdar p))))
(cddddr r))
(list (list (specdisrep (cons hdr (cdr r))) 0))))))))
(mlist* (mlist* '$%taylor var order nil)(map-mlist (make1 expr))))))
commit c0a24ea89706cff5b6f8f737712ba2db5d9c87e8
Author: Raymond Toy <toy...@gm...>
Date: Fri Aug 13 15:51:47 2021 -0700
Replace cons-exp with ftake* in trigo.lisp
Replace all occurrences of cons-exp with ftake*.
diff --git a/src/trigo.lisp b/src/trigo.lisp
index 7c1363d0c..3a7d62181 100644
--- a/src/trigo.lisp
+++ b/src/trigo.lisp
@@ -21,7 +21,7 @@
((big-float-eval (mop form) y))
((taylorize (mop form) (second form)))
((and $%piargs (if (zerop1 y) 0)))
- ((and $%iargs (multiplep y '$%i)) (mul '$%i (cons-exp '%sin (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul '$%i (ftake* '%sin (coeff y '$%i 1))))
((and $triginverses (not (atom y))
(let ((fcn (caar y))
(arg (cadr y)))
@@ -42,7 +42,7 @@
($exponentialize (exponentialize '%sinh y))
((and $halfangles (halfangle '%sinh y)))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%sinh (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%sinh (neg y))))
(t (eqtest (list '(%sinh) y) form))))
(defun simp-%cosh (form y z)
@@ -52,7 +52,7 @@
((and (not (member 'simp (car form))) (big-float-eval (mop form) y)))
((taylorize (mop form) (second form)))
((and $%piargs (if (zerop1 y) 1)))
- ((and $%iargs (multiplep y '$%i)) (cons-exp '%cos (coeff y '$%i 1)))
+ ((and $%iargs (multiplep y '$%i)) (ftake* '%cos (coeff y '$%i 1)))
((and $triginverses (not (atom y))
(let ((fcn (caar y))
(arg (cadr y)))
@@ -76,7 +76,7 @@
($exponentialize (exponentialize '%cosh y))
((and $halfangles (halfangle '%cosh y)))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (cons-exp '%cosh (neg y)))
+ ;((and $trigsign (mminusp* y)) (ftake* '%cosh (neg y)))
(t (eqtest (list '(%cosh) y) form))))
(defun simp-%tanh (form y z)
@@ -86,7 +86,7 @@
((and (not (member 'simp (car form))) (big-float-eval (mop form) y)))
((taylorize (mop form) (second form)))
((and $%piargs (if (zerop1 y) 0)))
- ((and $%iargs (multiplep y '$%i)) (mul '$%i (cons-exp '%tan (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul '$%i (ftake* '%tan (coeff y '$%i 1))))
((and $triginverses (not (atom y))
(let ((fcn (caar y))
(arg (cadr y)))
@@ -106,7 +106,7 @@
($exponentialize (exponentialize '%tanh y))
((and $halfangles (halfangle '%tanh y)))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%tanh (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%tanh (neg y))))
(t (eqtest (list '(%tanh) y) form))))
(defun simp-%coth (form y z)
@@ -116,13 +116,13 @@
((and (not (member 'simp (car form))) (big-float-eval (mop form) y)))
((taylorize (mop form) (second form)))
((and $%piargs (if (zerop1 y) (domain-error y 'coth))))
- ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (cons-exp '%cot (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (ftake* '%cot (coeff y '$%i 1))))
((and $triginverses (not (atom y)) (if (eq '%acoth (caar y)) (cadr y))))
((and $trigexpand (trigexpand '%coth y)))
($exponentialize (exponentialize '%coth y))
((and $halfangles (halfangle '%coth y)))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%coth (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%coth (neg y))))
(t (eqtest (list '(%coth) y) form))))
(defun simp-%csch (form y z)
@@ -132,13 +132,13 @@
((and (not (member 'simp (car form))) (big-float-eval (mop form) y)))
((taylorize (mop form) (second form)))
((and $%piargs (cond ((zerop1 y) (domain-error y 'csch)))))
- ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (cons-exp '%csc (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (ftake* '%csc (coeff y '$%i 1))))
((and $triginverses (not (atom y)) (if (eq '%acsch (caar y)) (cadr y))))
((and $trigexpand (trigexpand '%csch y)))
($exponentialize (exponentialize '%csch y))
((and $halfangles (halfangle '%csch y)))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%csch (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%csch (neg y))))
(t (eqtest (list '(%csch) y) form))))
(defun simp-%sech (form y z)
@@ -148,13 +148,13 @@
((and (not (member 'simp (car form))) (big-float-eval (mop form) y)))
((taylorize (mop form) (second form)))
((and $%piargs (zerop1 y)) 1)
- ((and $%iargs (multiplep y '$%i)) (cons-exp '%sec (coeff y '$%i 1)))
+ ((and $%iargs (multiplep y '$%i)) (ftake* '%sec (coeff y '$%i 1)))
((and $triginverses (not (atom y)) (if (eq '%asech (caar y)) (cadr y))))
((and $trigexpand (trigexpand '%sech y)))
($exponentialize (exponentialize '%sech y))
((and $halfangles (halfangle '%sech y)))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (cons-exp '%sech (neg y)))
+ ;((and $trigsign (mminusp* y)) (ftake* '%sech (neg y)))
(t (eqtest (list '(%sech) y) form))))
(defun simp-%asin (form y z)
@@ -184,7 +184,7 @@
;; -sqrt(3)/2
((alike1 y (div (power* 3 1//2) -2))
(div '$%pi -3)))))
- ((and $%iargs (multiplep y '$%i)) (mul '$%i (cons-exp '%asinh (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul '$%i (ftake* '%asinh (coeff y '$%i 1))))
((and (not (atom y)) (member (caar y) '(%cos %sin))
(if ($constantp (cadr y))
(let ((y-val (mfuncall '$mod
@@ -201,7 +201,7 @@
(if (eq '%sin (caar y)) (cadr y))))
($logarc (logarc '%asin y))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%asin (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%asin (neg y))))
(t (eqtest (list '(%asin) y) form))))
(defun simp-%acos (form y z)
@@ -246,7 +246,7 @@
(cadr y))))
($logarc (logarc '%acos y))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (sub '$%pi (cons-exp '%acos (neg y))))
+ ;((and $trigsign (mminusp* y)) (sub '$%pi (ftake* '%acos (neg y))))
(t (eqtest (list '(%acos) y) form))))
(defun simp-%acot (form y z)
@@ -263,7 +263,7 @@
((alike1 y '((mexpt) 3 ((rat) -1 2))) (div '$%pi 3))
;; sqrt(3)
((alike1 y '((mexpt) 3 ((rat) 1 2))) (div '$%pi 6)))))
- ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (cons-exp '%acoth (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (ftake* '%acoth (coeff y '$%i 1))))
((and (not (atom y)) (member (caar y) '(%cot %tan))
(if ($constantp (cadr y))
(let ((y-val (mfuncall '$mod
@@ -279,7 +279,7 @@
(cadr y))))
($logarc (logarc '%acot y))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%acot (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%acot (neg y))))
(t (eqtest (list '(%acot) y) form))))
(defun simp-%acsc (form y z)
@@ -297,7 +297,7 @@
;; 2*sqrt(3)/3
((alike1 y '((mtimes) 2 ((mexpt) 3 ((rat) -1 2))))
(div '$%pi 3)))))
- ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (cons-exp '%acsch (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (ftake* '%acsch (coeff y '$%i 1))))
((and (not (atom y)) (eq '%csc (caar y))
(if ($constantp (cadr y))
(let ((y-val (mfuncall '$mod (cadr y) (m* 2 '$%pi))))
@@ -308,7 +308,7 @@
(if (eq '%csc (caar y)) (cadr y))))
($logarc (logarc '%acsc y))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%acsc (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%acsc (neg y))))
(t (eqtest (list '(%acsc) y) form))))
(defun simp-%asec (form y z)
@@ -335,7 +335,7 @@
(if (eq '%sec (caar y)) (cadr y))))
($logarc (logarc '%asec y))
((apply-reflection-simp (mop form) y $trigsign))
- ;;((and $trigsign (mminusp* y)) (sub '$%pi (cons-exp '%asec (neg y))))
+ ;;((and $trigsign (mminusp* y)) (sub '$%pi (ftake* '%asec (neg y))))
(t (eqtest (list '(%asec) y) form))))
(defun simp-%asinh (form y z)
@@ -345,12 +345,12 @@
((and (not (member 'simp (car form))) (big-float-eval (mop form) y)))
((taylorize (mop form) (second form)))
((and $%piargs (if (zerop1 y) y)))
- ((and $%iargs (multiplep y '$%i)) (mul '$%i (cons-exp '%asin (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul '$%i (ftake* '%asin (coeff y '$%i 1))))
((and (eq $triginverses '$all) (not (atom y))
(if (eq '%sinh (caar y)) (cadr y))))
($logarc (logarc '%asinh y))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%asinh (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%asinh (neg y))))
(t (eqtest (list '(%asinh) y) form))))
(defun simp-%acosh (form y z)
@@ -373,12 +373,12 @@
((taylorize (mop form) (second form)))
((and $%piargs (cond ((zerop1 y) 0)
((or (equal y 1) (equal y -1)) (domain-error y 'atanh)))))
- ((and $%iargs (multiplep y '$%i)) (mul '$%i (cons-exp '%atan (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul '$%i (ftake* '%atan (coeff y '$%i 1))))
((and (eq $triginverses '$all) (not (atom y))
(if (eq '%tanh (caar y)) (cadr y))))
($logarc (logarc '%atanh y))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%atanh (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%atanh (neg y))))
(t (eqtest (list '(%atanh) y) form))))
(defun simp-%acoth (form y z)
@@ -388,12 +388,12 @@
((and (not (member 'simp (car form))) (big-float-eval (mop form) y)))
((taylorize (mop form) (second form)))
((and $%piargs (if (or (equal y 1) (equal y -1)) (domain-error y 'acoth))))
- ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (cons-exp '%acot (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (ftake* '%acot (coeff y '$%i 1))))
((and (eq $triginverses '$all) (not (atom y))
(if (eq '%coth (caar y)) (cadr y))))
($logarc (logarc '%acoth y))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%acoth (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%acoth (neg y))))
(t (eqtest (list '(%acoth) y) form))))
(defun simp-%acsch (form y z)
@@ -403,12 +403,12 @@
((and (not (member 'simp (car form))) (big-float-eval (mop form) y)))
((taylorize (mop form) (second form)))
((and $%piargs (if (zerop1 y) (domain-error y 'acsch))))
- ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (cons-exp '%acsc (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (ftake* '%acsc (coeff y '$%i 1))))
((and (eq $triginverses '$all) (not (atom y))
(if (eq '%csch (caar y)) (cadr y))))
($logarc (logarc '%acsch y))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%acsch (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%acsch (neg y))))
(t (eqtest (list '(%acsch) y) form))))
(defun simp-%asech (form y z)
@@ -423,7 +423,7 @@
(if (eq '%sech (caar y)) (cadr y))))
($logarc (logarc '%asech y))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (cons-exp '%asech (neg y)))
+ ;((and $trigsign (mminusp* y)) (ftake* '%asech (neg y)))
(t (eqtest (list '(%asech) y) form))))
(declare-top (special $trigexpandplus $trigexpandtimes))
@@ -494,13 +494,13 @@
(div* (do ((l l (cdr l))
(result))
((null l) (cons '(mtimes) result))
- (setq result (cons (cons-exp f1 (car l)) (cons (cons-exp f2 (car l)) result))))
+ (setq result (cons (ftake* f1 (car l)) (cons (ftake* f2 (car l)) result))))
(sin/cos-plus l n f2 f1 flag)))
(defun sin/cos-times (l m n f1 f2 flag)
;; Assume m,n < 2^17, but Binom may become big
;; Flag is 1 or -1
- (setq f1 (cons-exp f1 (cons '(mtimes) l)) f2 (cons-exp f2 (cons '(mtimes) l)))
+ (setq f1 (ftake* f1 (cons '(mtimes) l)) f2 (ftake* f2 (cons '(mtimes) l)))
(do ((i m (+ 2 i))
(end (abs n))
(result)
@@ -512,7 +512,7 @@
(setq result (cons (mul binom (power f1 i) (power f2 (- end i))) result))))
(defun tan-times (l n f flag)
- (setq f (cons-exp f (cons '(mtimes) l)))
+ (setq f (ftake* f (cons '(mtimes) l)))
(do ((i 1 (+ 2 i))
(end (abs n))
(num)
@@ -528,7 +528,7 @@
den))))))
(defun cot-times (l n f flag)
- (setq f (cons-exp f (cons '(mtimes) l)))
+ (setq f (ftake* f (cons '(mtimes) l)))
(do ((i (abs n) (- i 2))
(end (abs n))
(num)
@@ -542,25 +542,25 @@
(cons (mul (setq binom (truncate (* i binom) (- end i -1))) (power f (1- i))) den)))))
(defun csc/sec-times (l m n f1 f2 flag)
- (div* (mul (power (cons-exp f1 (cons '(mtimes) l)) (abs n))
- (power (cons-exp f2 (cons '(mtimes) l)) (abs n)))
+ (div* (mul (power (ftake* f1 (cons '(mtimes) l)) (abs n))
+ (power (ftake* f2 (cons '(mtimes) l)) (abs n)))
(sin/cos-times l m n f2 f1 flag)))
(defun mpc (dl ul result f1 f2 di ui)
(cond ((= 0 ui)
- (cons (revappend dl (mapcar #'(lambda (l) (cons-exp f2 l)) ul)) result))
+ (cons (revappend dl (mapcar #'(lambda (l) (ftake* f2 l)) ul)) result))
((= di ui)
- (cons (revappend dl (mapcar #'(lambda (l) (cons-exp f1 l)) ul)) result))
- (t (mpc (cons (cons-exp f1 (car ul)) dl) (cdr ul)
- (mpc (cons (cons-exp f2 (car ul)) dl)
+ (cons (revappend dl (mapcar #'(lambda (l) (ftake* f1 l)) ul)) result))
+ (t (mpc (cons (ftake* f1 (car ul)) dl) (cdr ul)
+ (mpc (cons (ftake* f2 (car ul)) dl)
(cdr ul) result f1 f2 (1- di) ui) f1 f2
(1- di) (1- ui)))))
(defun mpc1 (dl ul result f di ui)
(cond ((= 0 ui) (cons (reverse dl) result))
((= di ui)
- (cons (revappend dl (mapcar #'(lambda (l) (cons-exp f l)) ul)) result))
- (t (mpc1 (cons (cons-exp f (car ul)) dl) (cdr ul)
+ (cons (revappend dl (mapcar #'(lambda (l) (ftake* f l)) ul)) result))
+ (t (mpc1 (cons (ftake* f (car ul)) dl) (cdr ul)
(mpc1 dl (cdr ul) result f (1- di) ui) f
(1- di) (1- ui)))))
commit c6ee18925dee922d8f8128bf3e11f6f2b9629fc5
Author: Raymond Toy <toy...@gm...>
Date: Fri Aug 13 15:48:32 2021 -0700
Replace cons-exp with ftake* in trigi.lisp
Replace all occurrences of cons-exp with ftake*.
diff --git a/src/trigi.lisp b/src/trigi.lisp
index 8ff0fa81f..48b290bc0 100644
--- a/src/trigi.lisp
+++ b/src/trigi.lisp
@@ -431,7 +431,7 @@
((taylorize (mop form) (second form)))
((and $%piargs (cond ((zerop1 y) 0)
((has-const-or-int-term y '$%pi) (%piargs-sin/cos y)))))
- ((and $%iargs (multiplep y '$%i)) (mul '$%i (cons-exp '%sinh (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul '$%i (ftake* '%sinh (coeff y '$%i 1))))
((and $triginverses (not (atom y))
(cond ((eq '%asin (setq z (caar y))) (cadr y))
((eq '%acos z) (sqrt1-x^2 (cadr y)))
@@ -444,7 +444,7 @@
($exponentialize (exponentialize '%sin y))
((and $halfangles (halfangle '%sin y)))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%sin (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%sin (neg y))))
(t (eqtest (list '(%sin) y) form))))
(defun simp-%cos (form y z)
@@ -456,7 +456,7 @@
((and $%piargs (cond ((zerop1 y) 1)
((has-const-or-int-term y '$%pi)
(%piargs-sin/cos (add %pi//2 y))))))
- ((and $%iargs (multiplep y '$%i)) (cons-exp '%cosh (coeff y '$%i 1)))
+ ((and $%iargs (multiplep y '$%i)) (ftake* '%cosh (coeff y '$%i 1)))
((and $triginverses (not (atom y))
(cond ((eq '%acos (setq z (caar y))) (cadr y))
((eq '%asin z) (sqrt1-x^2 (cadr y)))
@@ -469,7 +469,7 @@
($exponentialize (exponentialize '%cos y))
((and $halfangles (halfangle '%cos y)))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (cons-exp '%cos (neg y)))
+ ;((and $trigsign (mminusp* y)) (ftake* '%cos (neg y)))
(t (eqtest (list '(%cos) y) form))))
(defun %piargs-sin/cos (x)
@@ -479,10 +479,10 @@
zl-rem (get-not-const-or-int-terms x '$%pi))
(cond ((zerop1 zl-rem) (%piargs coeff ratcoeff))
((not (mevenp (car coeff))) nil)
- ((equal 0 (setq x (mmod (cdr coeff) 2))) (cons-exp '%sin zl-rem))
- ((equal 1 x) (neg (cons-exp '%sin zl-rem)))
- ((alike1 1//2 x) (cons-exp '%cos zl-rem))
- ((alike1 '((rat) 3 2) x) (neg (cons-exp '%cos zl-rem))))))
+ ((equal 0 (setq x (mmod (cdr coeff) 2))) (ftake* '%sin zl-rem))
+ ((equal 1 x) (neg (ftake* '%sin zl-rem)))
+ ((alike1 1//2 x) (ftake* '%cos zl-rem))
+ ((alike1 '((rat) 3 2) x) (neg (ftake* '%cos zl-rem))))))
(defun filter-sum (pred form simp-flag)
@@ -537,7 +537,7 @@
((taylorize (mop form) (second form)))
((and $%piargs (cond ((zerop1 y) 0)
((has-const-or-int-term y '$%pi) (%piargs-tan/cot y)))))
- ((and $%iargs (multiplep y '$%i)) (mul '$%i (cons-exp '%tanh (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul '$%i (ftake* '%tanh (coeff y '$%i 1))))
((and $triginverses (not (atom y))
(cond ((eq '%atan (setq z (caar y))) (cadr y))
((eq '%asin z) (div (cadr y) (sqrt1-x^2 (cadr y))))
@@ -550,7 +550,7 @@
($exponentialize (exponentialize '%tan y))
((and $halfangles (halfangle '%tan y)))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%tan (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%tan (neg y))))
(t (eqtest (list '(%tan) y) form))))
(defun simp-%cot (form y z)
@@ -564,7 +564,7 @@
((and (has-const-or-int-term y '$%pi)
(setq z (%piargs-tan/cot (add %pi//2 y))))
(neg z)))))
- ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (cons-exp '%coth (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (ftake* '%coth (coeff y '$%i 1))))
((and $triginverses (not (atom y))
(cond ((eq '%acot (setq z (caar y))) (cadr y))
((eq '%asin z) (div (sqrt1-x^2 (cadr y)) (cadr y)))
@@ -577,7 +577,7 @@
($exponentialize (exponentialize '%cot y))
((and $halfangles (halfangle '%cot y)))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%cot (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%cot (neg y))))
(t (eqtest (list '(%cot) y) form))))
(defun %piargs-tan/cot (x)
@@ -614,11 +614,11 @@
;; effect and then, if this is zero, returns tan of the
;; rest, because tan has periodicity %pi.
((zerop1 (setq x (mmod (cdr coeff) 1)))
- (cons-exp '%tan zl-rem))
+ (ftake* '%tan zl-rem))
;; Similarly, if x = 1/2 then return -cot(x).
((alike1 1//2 x)
- (neg (cons-exp '%cot zl-rem))))))
+ (neg (ftake* '%cot zl-rem))))))
(defun simp-%csc (form y z)
(oneargcheck form)
@@ -628,7 +628,7 @@
((taylorize (mop form) (second form)))
((and $%piargs (cond ((zerop1 y) (domain-error y 'csc))
((has-const-or-int-term y '$%pi) (%piargs-csc/sec y)))))
- ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (cons-exp '%csch (coeff y '$%i 1))))
+ ((and $%iargs (multiplep y '$%i)) (mul -1 '$%i (ftake* '%csch (coeff y '$%i 1))))
((and $triginverses (not (atom y))
(cond ((eq '%acsc (setq z (caar y))) (cadr y))
((eq '%asin z) (div 1 (cadr y)))
@@ -641,7 +641,7 @@
($exponentialize (exponentialize '%csc y))
((and $halfangles (halfangle '%csc y)))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (neg (cons-exp '%csc (neg y))))
+ ;((and $trigsign (mminusp* y)) (neg (ftake* '%csc (neg y))))
(t (eqtest (list '(%csc) y) form))))
@@ -653,7 +653,7 @@
((taylorize (mop form) (second form)))
((and $%piargs (cond ((zerop1 y) 1)
((has-const-or-int-term y '$%pi) (%piargs-csc/sec (add %pi//2 y))))))
- ((and $%iargs (multiplep y '$%i)) (cons-exp '%sech (coeff y '$%i 1)))
+ ((and $%iargs (multiplep y '$%i)) (ftake* '%sech (coeff y '$%i 1)))
((and $triginverses (not (atom y))
(cond ((eq '%asec (setq z (caar y))) (cadr y))
((eq '%asin z) (div 1 (sqrt1-x^2 (cadr y))))
@@ -666,7 +666,7 @@
($exponentialize (exponentialize '%sec y))
((and $halfangles (halfangle '%sec y)))
((apply-reflection-simp (mop form) y $trigsign))
- ;((and $trigsign (mminusp* y)) (cons-exp '%sec (neg y)))
+ ;((and $trigsign (mminusp* y)) (ftake* '%sec (neg y)))
(t (eqtest (list '(%sec) y) form))))
@@ -677,10 +677,10 @@
zl-rem (get-not-const-or-int-terms x '$%pi))
(return (cond ((and (zerop1 zl-rem) (setq zl-rem (%piargs coeff nil))) (div 1 zl-rem))
((not (mevenp (car coeff))) nil)
- ((equal 0 (setq x (mmod (cdr coeff) 2))) (cons-exp '%csc zl-rem))
- ((equal 1 x) (neg (cons-exp '%csc zl-rem)))
- ((alike1 1//2 x) (cons-exp '%sec zl-rem))
- ((alike1 '((rat) 3 2) x) (neg (cons-exp '%sec zl-rem)))))))
+ ((equal 0 (setq x (mmod (cdr coeff) 2))) (ftake* '%csc zl-rem))
+ ((equal 1 x) (neg (ftake* '%csc zl-rem)))
+ ((alike1 1//2 x) (ftake* '%sec zl-rem))
+ ((alike1 '((rat) 3 2) x) (neg (ftake* '%sec zl-rem)))))))
(defun simp-%atan (form y z)
(oneargcheck form)
commit 0bb4882e91e553f6058396c85b43019b63d1ba3b
Author: Raymond Toy <toy...@gm...>
Date: Fri Aug 13 15:43:08 2021 -0700
Replace cons-exp with ftake* in ellipt.lisp
Replace all occurrences of cons-exp with ftake*.
diff --git a/src/ellipt.lisp b/src/ellipt.lisp
index a252b971b..09258fc74 100644
--- a/src/ellipt.lisp
+++ b/src/ellipt.lisp
@@ -600,7 +600,7 @@
;; A&S 16.6.1
(ftake '%tanh u))
((and $trigsign (mminusp* u))
- (neg (cons-exp '%jacobi_sn (neg u) m)))
+ (neg (ftake* '%jacobi_sn (neg u) m)))
((and $triginverses
(listp u)
(member (caar u) '(%inverse_jacobi_sn
@@ -663,7 +663,7 @@
;; A&S 16.20.1 (Jacobi's Imaginary transformation)
((and $%iargs (multiplep u '$%i))
(mul '$%i
- (cons-exp '%jacobi_sc (coeff u '$%i 1) (add 1 (neg m)))))
+ (ftake* '%jacobi_sc (coeff u '$%i 1) (add 1 (neg m)))))
((setq coef (kc-arg2 u m))
;; sn(m*K+u)
;;
@@ -742,7 +742,7 @@
;; A&S 16.6.2
(ftake '%sech u))
((and $trigsign (mminusp* u))
- (cons-exp '%jacobi_cn (neg u) m))
+ (ftake* '%jacobi_cn (neg u) m))
((and $triginverses
(listp u)
(member (caar u) '(%inverse_jacobi_sn
@@ -767,7 +767,7 @@
1//2))))
;; A&S 16.20.2 (Jacobi's Imaginary transformation)
((and $%iargs (multiplep u '$%i))
- (cons-exp '%jacobi_nc (coeff u '$%i 1) (add 1 (neg m))))
+ (ftake* '%jacobi_nc (coeff u '$%i 1) (add 1 (neg m))))
((setq coef (kc-arg2 u m))
;; cn(m*K+u)
;;
@@ -843,7 +843,7 @@
;; A&S 16.6.3
(ftake '%sech u))
((and $trigsign (mminusp* u))
- (cons-exp '%jacobi_dn (neg u) m))
+ (ftake* '%jacobi_dn (neg u) m))
((and $triginverses
(listp u)
(member (caar u) '(%inverse_jacobi_sn
@@ -874,7 +874,7 @@
(ftake '%elliptic_kc m))
;; A&S 16.20.2 (Jacobi's Imaginary transformation)
((and $%iargs (multiplep u '$%i))
- (cons-exp '%jacobi_dc (coeff u '$%i 1)
+ (ftake* '%jacobi_dc (coeff u '$%i 1)
(add 1 (neg m))))
((setq coef (kc-arg2 u m))
;; A&S 16.8.3
@@ -2695,7 +2695,7 @@ first kind:
(dbz-err1 'jacobi_ns))
((and $trigsign (mminusp* u))
;; ns is odd
- (neg (cons-exp '%jacobi_ns (neg u) m)))
+ (neg (ftake* '%jacobi_ns (neg u) m)))
((and $triginverses
(listp u)
(member (caar u) '(%inverse_jacobi_sn
@@ -2721,7 +2721,7 @@ first kind:
((and $%iargs (multiplep u '$%i))
;; ns(i*u) = 1/sn(i*u) = -i/sc(u,m1) = -i*cs(u,m1)
(neg (mul '$%i
- (cons-exp '%jacobi_cs (coeff u '$%i 1) (add 1 (neg m))))))
+ (ftake* '%jacobi_cs (coeff u '$%i 1) (add 1 (neg m))))))
((setq coef (kc-arg2 u m))
;; A&S 16.8.10
;;
@@ -2814,7 +2814,7 @@ first kind:
(ftake '%cosh u))
((and $trigsign (mminusp* u))
;; nc is even
- (cons-exp '%jacobi_nc (neg u) m))
+ (ftake* '%jacobi_nc (neg u) m))
((and $triginverses
(listp u)
(member (caar u) '(%inverse_jacobi_sn
@@ -2839,7 +2839,7 @@ first kind:
;; A&S 16.20 (Jacobi's Imaginary transformation)
((and $%iargs (multiplep u '$%i))
;; nc(i*u) = 1/cn(i*u) = 1/nc(u,1-m) = cn(u,1-m)
- (cons-exp '%jacobi_cn (coeff u '$%i 1) (add 1 (neg m))))
+ (ftake* '%jacobi_cn (coeff u '$%i 1) (add 1 (neg m))))
((setq coef (kc-arg2 u m))
;; A&S 16.8.8
;;
@@ -2939,7 +2939,7 @@ first kind:
(ftake '%cosh u))
((and $trigsign (mminusp* u))
;; nd is even
- (cons-exp '%jacobi_nd (neg u) m))
+ (ftake* '%jacobi_nd (neg u) m))
((and $triginverses
(listp u)
(member (caar u) '(%inverse_jacobi_sn
@@ -2964,7 +2964,7 @@ first kind:
;; A&S 16.20 (Jacobi's Imaginary transformation)
((and $%iargs (multiplep u '$%i))
;; nd(i*u) = 1/dn(i*u) = 1/dc(u,1-m) = cd(u,1-m)
- (cons-exp '%jacobi_cd (coeff u '$%i 1) (add 1 (neg m))))
+ (ftake* '%jacobi_cd (coeff u '$%i 1) (add 1 (neg m))))
((setq coef (kc-arg2 u m))
;; A&S 16.8.6
;;
@@ -3064,7 +3064,7 @@ first kind:
(ftake '%sinh u))
((and $trigsign (mminusp* u))
;; sc is odd
- (neg (cons-exp '%jacobi_sc (neg u) m)))
+ (neg (ftake* '%jacobi_sc (neg u) m)))
((and $triginverses
(listp u)
(member (caar u) '(%inverse_jacobi_sn
@@ -3091,7 +3091,7 @@ first kind:
((and $%iargs (multiplep u '$%i))
;; sc(i*u) = sn(i*u)/cn(i*u) = i*sc(u,m1)/nc(u,m1) = i*sn(u,m1)
(mul '$%i
- (cons-exp '%jacobi_sn (coeff u '$%i 1) (add 1 (neg m)))))
+ (ftake* '%jacobi_sn (coeff u '$%i 1) (add 1 (neg m)))))
((setq coef (kc-arg2 u m))
;; A&S 16.8.9
;; sc(2*m*K+u) = sc(u)
@@ -3111,7 +3111,7 @@ first kind:
(if (zerop1 const)
(dbz-err1 'jacobi_sc)
(mul -1
- (div (cons-exp '%jacobi_cs const m)
+ (div (ftake* '%jacobi_cs const m)
(power (sub 1 m) 1//2)))))))
((and (alike1 lin 1//2)
(zerop1 const))
@@ -3196,7 +3196,7 @@ first kind:
(ftake '%sinh u))
((and $trigsign (mminusp* u))
;; sd is odd
- (neg (cons-exp '%jacobi_sd (neg u) m)))
+ (neg (ftake* '%jacobi_sd (neg u) m)))
((and $triginverses
(listp u)
(member (caar u) '(%inverse_jacobi_sn
@@ -3222,7 +3222,7 @@ first kind:
((and $%iargs (multiplep u '$%i))
;; sd(i*u) = sn(i*u)/dn(i*u) = i*sc(u,m1)/dc(u,m1) = i*sd(u,m1)
(mul '$%i
- (cons-exp '%jacobi_sd (coeff u '$%i 1) (add 1 (neg m)))))
+ (ftake* '%jacobi_sd (coeff u '$%i 1) (add 1 (neg m)))))
((setq coef (kc-arg2 u m))
;; A&S 16.8.5
;; sd(4*m*K+u) = sd(u)
@@ -3346,7 +3346,7 @@ first kind:
(dbz-err1 'jacobi_cs))
((and $trigsign (mminusp* u))
;; cs is odd
- (neg (cons-exp '%jacobi_cs (neg u) m)))
+ (neg (ftake* '%jacobi_cs (neg u) m)))
((and $triginverses
(listp u)
(member (caar u) '(%inverse_jacobi_sn
@@ -3372,7 +3372,7 @@ first kind:
((and $%iargs (multiplep u '$%i))
;; cs(i*u) = cn(i*u)/sn(i*u) = -i*nc(u,m1)/sc(u,m1) = -i*ns(u,m1)
(neg (mul '$%i
- (cons-exp '%jacobi_ns (coeff u '$%i 1) (add 1 (neg m))))))
+ (ftake* '%jacobi_ns (coeff u '$%i 1) (add 1 (neg m))))))
((setq coef (kc-arg2 u m))
;; A&S 16.8.12
;;
@@ -3478,7 +3478,7 @@ first kind:
1)
((and $trigsign (mminusp* u))
;; cd is even
- (cons-exp '%jacobi_cd (neg u) m))
+ (ftake* '%jacobi_cd (neg u) m))
((and $triginverses
(listp u)
(member (caar u) '(%inverse_jacobi_sn
@@ -3503,7 +3503,7 @@ first kind:
;; A&S 16.20 (Jacobi's Imaginary transformation)
((and $%iargs (multiplep u '$%i))
;; cd(i*u) = cn(i*u)/dn(i*u) = nc(u,m1)/dc(u,m1) = nd(u,m1)
- (cons-exp '%jacobi_nd (coeff u '$%i 1) (add 1 (neg m))))
+ (ftake* '%jacobi_nd (coeff u '$%i 1) (add 1 (neg m))))
((setf coef (kc-arg2 u m))
;; A&S 16.8.4
;;
@@ -3625,7 +3625,7 @@ first kind:
((zerop1 u)
(dbz-err1 'jacobi_ds))
((and $trigsign (mminusp* u))
- (neg (cons-exp '%jacobi_ds (neg u) m)))
+ (neg (ftake* '%jacobi_ds (neg u) m)))
((and $triginverses
(listp u)
(member (caar u) '(%inverse_jacobi_sn
@@ -3651,7 +3651,7 @@ first kind:
((and $%iargs (multiplep u '$%i))
;; ds(i*u) = dn(i*u)/sn(i*u) = -i*dc(u,m1)/sc(u,m1) = -i*ds(u,m1)
(neg (mul '$%i
- (cons-exp '%jacobi_ds (coeff u '$%i 1) (add 1 (neg m))))))
+ (ftake* '%jacobi_ds (coeff u '$%i 1) (add 1 (neg m))))))
((setf coef (kc-arg2 u m))
;; A&S 16.8.11
(destructuring-bind (lin const)
@@ -3774,7 +3774,7 @@ first kind:
;; A&S 16.6.7
1)
((and $trigsign (mminusp* u))
- (cons-exp '%jacobi_dc (neg u) m))
+ (ftake* '%jacobi_dc (neg u) m))
((and $triginverses
(listp u)
(member (caar u) '(%inverse_jacobi_sn
@@ -3799,7 +3799,7 @@ first kind:
;; A&S 16.20 (Jacobi's Imaginary transformation)
((and $%iargs (multiplep u '$%i))
;; dc(i*u) = dn(i*u)/cn(i*u) = dc(u,m1)/nc(u,m1) = dn(u,m1)
- (cons-exp '%jacobi_dn (coeff u '$%i 1) (add 1 (neg m))))
+ (ftake* '%jacobi_dn (coeff u '$%i 1) (add 1 (neg m))))
((setf coef (kc-arg2 u m))
;; See A&S 16.8.7
(destructuring-bind (lin const)
@@ -4239,7 +4239,7 @@ first kind:
(complex-bigfloat-numerical-eval-p u m))
(ftake '%inverse_jacobi_sd ($rectform (div 1 u)) m))
((and $trigsign (mminusp* u))
- (neg (cons-exp '%inverse_jacobi_ds (neg u) m)))
+ (neg (ftake* '%inverse_jacobi_ds (neg u) m)))
((eql 0 ($ratsimp (sub u (power (sub 1 m) 1//2))))
;; inverse_jacobi_ds(sqrt(1-m),m) = elliptic_kc(m)
;;
-----------------------------------------------------------------------
Summary of changes:
share/contrib/format/coeflist.lisp | 4 +-
src/ellipt.lisp | 52 ++++++++++++------------
src/mrgmac.lisp | 3 ++
src/trigi.lisp | 44 ++++++++++----------
src/trigo.lisp | 82 +++++++++++++++++++-------------------
5 files changed, 94 insertions(+), 91 deletions(-)
hooks/post-receive
--
Maxima CAS
|
