Menu
▾
▴
[Maxima-commits] [git] Maxima CAS branch, master, updated. branch-5_29-base-180-g264b870
|
From: Robert D. <rob...@us...> - 2013-03-23 04:00:51
|
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 264b8705f42bf4480b064934aefac92c23843940 (commit)
via 4e77b12552ce3f5b4f6f4b1bd58ca687ff6f09e6 (commit)
via 4b8a98648d4da26805ea3238eee216611245e14a (commit)
via 3137b946bed77dc4311e4266ed338cd2d46d299f (commit)
via 4260be9841a6b7b226fe3acf785b8b0250c9264b (commit)
via 6a1309c1f14db8bd8660b6a3f0768f7258078647 (commit)
via 2ba3aec423c097f6896ff5579b6b47c63f28a0ea (commit)
via 63785f0e721a3ee6cde11526f02a5b94c4e1bcf9 (commit)
via 41a26d3fa1d1fedc3de826d1af2b8b4020dca6dd (commit)
from d759f9a65489116aa786f1d114b63b5be2c9a147 (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 264b8705f42bf4480b064934aefac92c23843940
Merge: 4e77b12 d759f9a
Author: robert_dodier <rob...@us...>
Date: Fri Mar 22 12:00:15 2013 -0700
Merge branch 'master' of ssh://git.code.sf.net/p/maxima/code
commit 4e77b12552ce3f5b4f6f4b1bd58ca687ff6f09e6
Author: robert_dodier <rob...@us...>
Date: Fri Mar 22 11:57:32 2013 -0700
Revert commit 2ba3aec4 in an attempt to avoid problems
merging with origin/master.
diff --git a/src/numth.lisp b/src/numth.lisp
index ea45594..1551495 100644
--- a/src/numth.lisp
+++ b/src/numth.lisp
@@ -1209,7 +1209,7 @@
;; c * x
(defun gf-xctimes (x c)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-ctimes))
(maybe-fixnum-let ((c c))
(if (or (= 0 c) (null x)) nil
@@ -1220,7 +1220,7 @@
(rplacd r (list (the fixnum (car rx)) (gf-ctimes c (cadr rx)))) ))))
(defun gf-nxctimes (x c) ;; modifies x
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-ctimes))
(maybe-fixnum-let ((c c))
(if (or (= 0 c) (null x)) nil
@@ -1231,7 +1231,7 @@
;; c*v^e * x
(defun gf-xectimes (x e c)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (fixnum e) (inline gf-ctimes))
(maybe-fixnum-let ((c c))
(if (or (= 0 c) (null x)) nil
@@ -1244,7 +1244,7 @@
;; - x
(defun gf-minus (x)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-cminus-b))
(if (or (null x) (= 2 *gf-char*)) x
(do* ((res (list (the fixnum (car x)) (gf-cminus-b (cadr x))))
@@ -1254,7 +1254,7 @@
(rplacd r (list (the fixnum (car rx)) (gf-cminus-b (cadr rx)))) )))
(defun gf-nminus (x) ;; modifies x
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-cminus-b))
(if (or (null x) (= 2 *gf-char*)) x
(do ((r (cdr x) (cddr r))) (())
@@ -1264,7 +1264,7 @@
;; x + c, 0 < c < *gf-char*
(defun gf-nxcplus (x c) ;; modifies x
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-cplus-b))
(maybe-fixnum-let ((c c))
(cond
@@ -1290,7 +1290,7 @@
;; merge y into x
(defun gf-nplus (x y) ;; modifies x
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-cplus-b))
(cond
((null x) y)
@@ -1341,7 +1341,7 @@
;; merge c*v^e*y into x
(defun gf-nxyecplus (x y e c) ;; modifies x
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (fixnum e)(inline gf-ctimes gf-cplus-b))
(cond
((null y) x)
@@ -1402,7 +1402,7 @@
;; where e.g. xi = ci*v^ei
;;
(defun gf-times (x y)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-ctimes gf-cplus-b))
(if (or (null x) (null y)) nil
(maybe-fixnum-let ((c 0)(cx 0))
@@ -1448,7 +1448,7 @@
;; The reverse needs some additional consing but is slightly faster.
;;
(defun gf-sq (x)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-ctimes gf-cplus-b))
(cond
((null x) x)
@@ -1497,7 +1497,7 @@
;; x^n mod y
(defun gf-pow (x n) ;; assume 0 <= n
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(cond
((= 0 n) (list 0 1))
(*gf-tables?* (gf-pow-by-table x n) )
@@ -1522,7 +1522,7 @@
(gf-nrem (copy-list x) y) ))
(defun gf-nrem (x y) ;; modifies x
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-ctimes gf-cminus-b))
(when (null y) (errrjf "Quotient by zero"))
(if (null x) x
@@ -1541,7 +1541,7 @@
;; assume lc(y) = 1, reduction poly is monic
(defun gf-nred (x) ;; modifies x
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-cminus-b))
(if (null x) x
(let* ((y *gf-red*) (e 0) (ley (car y)))
@@ -1555,7 +1555,7 @@
;; (monic) gcd
(defun gf-gcd (x y)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(cond
((null x) y)
((null y) x)
@@ -1569,7 +1569,7 @@
;; (monic) extended gcd
(defun gf-gcdex (x y)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(let ((x1 (list 0 1)) x2 y1 (y2 (list 0 1)) q r)
(do ()((null y)
(let ((inv (gf-cinv (cadr x))))
@@ -1590,7 +1590,7 @@
;; (might happen when reduction poly isn't irreducible)
(defun gf-inv (y)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(when (null y) (errrjf "Quotient by zero"))
(let ((x *gf-red*)
(y1 (list 0 1)) x1 q r)
@@ -1605,7 +1605,7 @@
y1 (gf-nplus (gf-nminus (gf-times q y1)) x1) )) ))
(defun gf-divide (x y)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-cminus-b))
(cond
((null y) (errrjf "Quotient by zero"))
@@ -1631,7 +1631,7 @@
(gf-minset?) (gf-x2n (gf-p2x p)) )
(defun gf-x2n (x)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(if (null x) 0
(maybe-fixnum-let ((m *gf-char*))
(do ((n 0))(())
@@ -1664,7 +1664,7 @@
(cons '(mlist simp) (gf-x2l x len)) ))
(defun gf-x2l (x len)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (fixnum len))
(do* ((e (the fixnum (car x))) (k (if (= 0 len) e (1- len)) (1- k)) l)
((< k 0) (nreverse l))
@@ -1684,7 +1684,7 @@
(gf-x2p (gf-l2x (cdr l))) )
(defun gf-l2x (l)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(setq l (reverse l))
(maybe-fixnum-let ((c 0))
(do ((e 0) x)
@@ -1703,7 +1703,7 @@
(gf-l2n (cdr l)) )
(defun gf-l2n (l)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(maybe-fixnum-let ((m *gf-char*)(c1 (car l))(c 0))
(setq l (reverse (cdr l)))
(do ((n 0)(b 1))
@@ -1719,14 +1719,14 @@
(cons '(mlist simp) (if (= 0 len) (gf-n2l n) (gf-n2l-twoargs n len))) )
(defun gf-n2l (n) ;; this version is frequently called by gf-precomp, keep it simple
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(maybe-fixnum-let ((d *gf-char*)(r 0))
(do (l) ((= 0 n) l)
(multiple-value-setq (n r) (truncate n d))
(setq l (cons r l)) )))
(defun gf-n2l-twoargs (n len)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (fixnum len) )
(maybe-fixnum-let ((d *gf-char*)(r 0))
(do (l) ((= 0 len) l)
@@ -1738,7 +1738,7 @@
;; leading coefficient retrieved from number representation
(defun gf-n2lc (n)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(maybe-fixnum-let ((d *gf-char*)(r 0))
(do () ((= 0 n) r)
(multiple-value-setq (n r) (truncate n d)) )))
@@ -1765,7 +1765,7 @@
;; p,n > 1 !
(defun gf-irr-p (y p n) ;; gf-irr-p is independent from any settings
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(let ((*gf-char* p)
#-gcl (*fixnump-2gf-char* (< (* 2 p) most-positive-fixnum)) ;; see above
(*gf-red* y)
@@ -1780,7 +1780,7 @@
;; find an irreducible element
(defun gf-irr (gf-char gf-exp)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(when (= 1 gf-exp)
(return-from gf-irr (list 1 1)) )
(let ((*gf-char* gf-char))
@@ -1839,7 +1839,7 @@
(t (gf-prim-p (gf-n2x n))) )))
(defun gf-prim-p (x)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(let ((fbp *gf-fs-base-p*) (mp *gf-x^p-powers*) tmp prod)
(do ((i 0 (1+ i)) (j 0 0) (lf (array-dimension *gf-fs-base-p* 0)))
((= i lf) t)
@@ -1908,7 +1908,7 @@
;; find a primitive element
(defun gf-prim ()
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(let* ((p *gf-char*)
(two-p (* 2 p))
(even-exp (evenp *gf-exp*))
@@ -1949,7 +1949,7 @@
;; returns an array of polynomials x^p^j, j = 0, 1, .. , (n-1), where n = *gf-exp*
(defun gf-x^p-powers (n)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(let ((p *gf-char*)(a (make-array n :element-type 'list :initial-element nil)) )
(setf (svref a 0) (list 1 1)) ;; x
(do ((j 1 (1+ j)))
@@ -1961,7 +1961,7 @@
;; y(x) mod *gf-red*
(defun gf-compose (x y)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(if (integerp x) (gf-at y x)
(do (res) (())
(setq res (gf-nxcplus res (cadr y)))
@@ -1973,7 +1973,7 @@
;; x(a)
(defun gf-at (x a) ;; Horner and square and multiply
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(if (integerp x) x
(maybe-fixnum-let ((a a))
(do ((n 0)) (())
@@ -2084,7 +2084,7 @@
;; find the lowest value k for which a^k = 1
(defun gf-ord (x)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(if *gf-tables?*
(gf-ord-by-table x)
(let ((k *gf-ord*) p (e 0)) (declare (fixnum e))
@@ -2112,7 +2112,7 @@
;; and ord((Fp^n)*) with help of the Chinese Remainder Theorem.
;;
(defun gf-group-order ()
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(maybe-fixnum-let ((modulus *gf-char*) (p *gf-char*))
(prog (e-list p^n (e 0) (ord 1)) (declare (fixnum e))
(do ((x (pfactor (cons *gf-rat-sym* *gf-red*)))) ;; a monic *gf-red* is assumed
@@ -2242,7 +2242,7 @@
mat )))
(defun gf-maybe-normal-basis (x)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(let ((powers *gf-x^p-powers*) ;; use again that f(x)^p = f(x^p)
(gf-exp *gf-exp*) (e (1- *gf-exp*)) )
(declare (fixnum gf-exp e))
@@ -2257,7 +2257,7 @@
;; The elements of the list are values in the range 0, 1, 2, ..., characteristic - 1.
(defun gf-coeffs-array (x n)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (fixnum n))
(let ((cs (make-array (1+ n) :initial-element 0)))
(do ((k n)) ((null x) cs) (declare (fixnum k))
@@ -2272,7 +2272,7 @@
(setq x (cddr x)) ) ))))
(defun gf-coeffs-list (x k)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (fixnum k))
(do () ((or (null x) (>= k (the fixnum (car x)))))
(setq x (cddr x)) )
@@ -2437,7 +2437,7 @@
;; Pohlig and Hellman reduction
(defun gf-dlog (a)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(if *gf-tables?*
(svref $gf_logs (gf-x2n a))
(let (p (e 0) odivp (g *gf-prim*) gg x dlog dlogs tmp)
@@ -2468,7 +2468,7 @@
(declaim (inline gf-dlog-f))
(defun gf-dlog-f (b y z a g q)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(let ((c (mod (cadr b) 3))) (declare (fixnum c))
(cond
((= 0 c)
@@ -2481,7 +2481,7 @@
;; Pollard rho for dlog computation (Brents variant of collision detection)
(defun gf-dlog-rho-brent (a g q)
- #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-dlog-f))
(cond
((equal '(0 1) a) 0)
commit 4b8a98648d4da26805ea3238eee216611245e14a
Author: robert_dodier <rob...@us...>
Date: Thu Mar 21 16:16:24 2013 -0700
Reimplement macro WITH-NEW-CONTEXT via $SUPCONTEXT and $KILLCONTEXT.
This fixes SF bug #2557: "abs_integrate leaks assumptions into enclosing context"
Previous implementation called some functions which are called nowhere else
and therefore have now been nuked.
diff --git a/share/contrib/integration/rtest_abs_integrate.mac b/share/contrib/integration/rtest_abs_integrate.mac
index ef1eac1..62023d9 100644
--- a/share/contrib/integration/rtest_abs_integrate.mac
+++ b/share/contrib/integration/rtest_abs_integrate.mac
@@ -252,7 +252,7 @@ log(16)/2+log(5)/2-log(2)/2+1/2$
(i : integrate(1/(1 + abs(x) + abs(x-1)),x,-7,5));
log(16)/2+log(5)/2-log(2)/2+1/2$
-integrate(exp(-abs(x)),x,-1,inf);
+expand (integrate(exp(-abs(x)),x,-1,inf));
2-%e^-1$
(convolution(f,g,x) := block([t : gensym()],
@@ -518,6 +518,20 @@ x*log(sin(x))-(x*log(sin(x)^2+cos(x)^2+2*cos(x)+1)
-2*%i*li[2](-%e^(%i*x))-%i*x^2)
/2$
+/* SF bug #2557: "abs_integrate leaks assumptions into enclosing context" */
+
+(kill (foo), foo : copy (facts ()), 0);
+0;
+
+defint(exp(-abs(x))/cosh(x),x,minf,inf);
+2*log(2);
+
+is (foo = facts ());
+true;
+
+defint(exp(-abs(x))/cosh(x),x,minf,inf);
+2*log(2);
+
(print("time = ", elapsed_real_time () - start), is(elapsed_real_time () - start < 70));
true$
diff --git a/src/db.lisp b/src/db.lisp
index 3b9793e..632a811 100644
--- a/src/db.lisp
+++ b/src/db.lisp
@@ -615,26 +615,6 @@
(cunmrk e)
(setq contexts (delete e contexts :test #'eq))))))
-(defmfun context (&rest l)
- (newcon l))
-
-(defun newcon (c)
- (when (> *conindex* *connumber*)
- (gccon))
- (setq c (if (null c)
- (list '*gc nil)
- (list '*gc nil 'subc c)))
- (setf (aref conunmrk *conindex*) c)
- (setf (aref conmark *conindex*) (cdr c))
- (incf *conindex*)
- c)
-
-;; To be used with the WITH-NEW-CONTEXT macro.
-(defun context-unwinder ()
- (killc (aref conmark *conindex*))
- (decf *conindex*)
- (setf (aref conunmrk *conindex*) nil))
-
(defun gccon ()
(gccon1)
(when (> *conindex* *connumber*)
diff --git a/src/maxmac.lisp b/src/maxmac.lisp
index b7b187f..4409f30 100644
--- a/src/maxmac.lisp
+++ b/src/maxmac.lisp
@@ -49,17 +49,12 @@
(apply #'load-macsyma-macros-at-runtime macro-files)
(values))
-;; Used to temporarily bind contexts in such a way as to not cause
-;; the context garbage collector to run. Used when you don't want to
-;; stash away contexts for later use, but simply want to run a piece
-;; of code in a new context which will be destroyed when the code finishes.
-;; Note that this code COULD use an unwind-protect to be safe but since
-;; it will not cause out and out errors we leave it out.
-
(defmacro with-new-context (sub-context &rest forms)
- `(let ((context (context ,@sub-context)))
- (prog1 ,@forms
- (context-unwinder))))
+ `(let ((my-context (gensym "$CTXT")))
+ (mfuncall '$supcontext my-context ,@sub-context)
+ (unwind-protect
+ (prog1 ,@forms)
+ ($killcontext my-context))))
;; For creating a macsyma evaluator variable binding context.
;; (MBINDING (VARIABLES &OPTIONAL VALUES FUNCTION-NAME)
commit 3137b946bed77dc4311e4266ed338cd2d46d299f
Author: robert_dodier <rob...@us...>
Date: Thu Mar 21 16:03:43 2013 -0700
Call CLEARSIGN from $SIGN to clean up facts introduced by sign functions.
diff --git a/src/compar.lisp b/src/compar.lisp
index 0ddf279..0f3d5ce 100644
--- a/src/compar.lisp
+++ b/src/compar.lisp
@@ -760,20 +760,22 @@ relational knowledge is contained in the default context GLOBAL.")
($sign z)))
(defmfun $sign (x)
- (let ((x (specrepcheck x))
- sign minus odds evens factored)
- (sign01 (cond (limitp (restorelim x))
- (*complexsign*
- ;; No rectform in Complex mode. Rectform ask unnecessary
- ;; questions about complex expressions and can not handle
- ;; imaginary expressions completely. Thus $csign can not
- ;; handle something like (1+%i)*(1-%i) which is real.
- ;; After improving rectform, we can change this. (12/2008)
- (when *debug-compar*
- (format t "~&$SIGN with ~A~%" x))
- x)
- ((not (free x '$%i)) ($rectform x))
- (t x)))))
+ (unwind-protect
+ (let ((x (specrepcheck x))
+ sign minus odds evens factored)
+ (sign01 (cond (limitp (restorelim x))
+ (*complexsign*
+ ;; No rectform in Complex mode. Rectform ask unnecessary
+ ;; questions about complex expressions and can not handle
+ ;; imaginary expressions completely. Thus $csign can not
+ ;; handle something like (1+%i)*(1-%i) which is real.
+ ;; After improving rectform, we can change this. (12/2008)
+ (when *debug-compar*
+ (format t "~&$SIGN with ~A~%" x))
+ x)
+ ((not (free x '$%i)) ($rectform x))
+ (t x))))
+ (clearsign)))
(defun sign01 (a)
(let ((e (sign-prep a)))
diff --git a/tests/rtest_sign.mac b/tests/rtest_sign.mac
index f447a29..0a6bd73 100644
--- a/tests/rtest_sign.mac
+++ b/tests/rtest_sign.mac
@@ -1007,3 +1007,22 @@ true$
kill(all);
done$
+
+/* facts in assume database not cleaned up by 'sign' */
+
+(kill (foo), foo : %e^(abs(uu)+uu)*(uu/abs(uu)+1)+%e^(abs(uu)-uu)*(uu/abs(uu)-1), 0);
+0;
+
+block ([bar, baz], bar : copy (facts (initial)), is (equal (foo, 0)), baz : facts (initial), is (bar = baz));
+true;
+
+/* tnx to Barton Willis for the next couple of tests */
+
+map('sign,[sqrt(x),x]);
+[pz, pnz];
+
+(kill(buddy),
+ buddy(p,q) := expand(if p >= 0 then q else q,0,0),
+ buddy(sqrt(x),abs(x)));
+abs(x);
+
commit 4260be9841a6b7b226fe3acf785b8b0250c9264b
Author: robert_dodier <rob...@us...>
Date: Thu Mar 21 00:31:01 2013 -0700
Commit modifications to NFORMAT by Richard J. Fateman,
as sent via email to Robert Dodier 2013-03-15.
diff --git a/src/nforma.lisp b/src/nforma.lisp
index 946c1c9..02e56e5 100644
--- a/src/nforma.lisp
+++ b/src/nforma.lisp
@@ -23,33 +23,41 @@
(setq in-p nil)
-(defmfun nformat (form)
+(defmfun nformat (form &aux (p nil))
(cond ((atom form)
(cond ((and (realp form) (minusp form)) (list '(mminus) (- form)))
((eq t form) (if in-p t '$true))
((eq nil form) (if in-p nil '$false))
- ;; (($EXTENDP FORM)
- ;; (NFORMAT (transform-extends form)))
+ ;; revision, extension by Richard Fateman 3/2013.
+ ;; Perhaps some object is an atom, maybe a CLOS object or structure.
+ ;; Either its type is a symbolp..
+ ;; e.g. a structure like (defstruct (ri ...)) is type ri.
+ ;; so we look for a formatter on the type or car of the type.
+ ;; OR
+ ;; if car of the type is also not a symbol, we look for formatter on nil
+ ;; where it isn't.
+ ;; depending on the lisp, type-of may be more or less sophisticated.
+ ;; a "good" lisp
+ ;; may return a list, e.g. (type-of "abc") is (simple-array character (3))
+ ;; in some lisps, e.g. GCL the type is just string.
+
+ ((and (setf p(type-of form))
+ (if (not (symbolp p)) (setf p (car p)) p)
+ (setf p (get (and (symbolp p) p) 'formatter))
+ ;; form is an atom of a type with a formatter property
+ (funcall p form)))
+ ;; just display as a lisp symbol, number, or other atom.
(t form)))
- ((atom (car form))
- form)
- ((eq 'rat (caar form))
- (cond ((minusp (cadr form))
- (list '(mminus) (list '(rat) (- (cadr form)) (caddr form))))
- (t (cons '(rat) (cdr form)))))
- ((eq 'mmacroexpanded (caar form)) (nformat (caddr form)))
- ((null (cdar form)) form)
- ((eq 'mplus (caar form)) (form-mplus form))
- ((eq 'mtimes (caar form)) (form-mtimes form))
- ((eq 'mexpt (caar form)) (form-mexpt form))
- ((eq 'mrat (caar form)) (form-mrat form))
- ((eq 'mpois (caar form)) (nformat ($outofpois form)))
- ((eq 'bigfloat (caar form))
- (if (minusp (cadr form))
- (list '(mminus) (list (car form) (- (cadr form)) (caddr form)))
- (cons (car form) (cdr form))))
- (t form)))
+ ((atom (car form)) form) ;; probably an illegal form; just return it.
+ ((null (cdar form)) form) ;; probably an illegal or unsimplified form; just return it.
+
+ ;; this next section is for the ordinary maxima objects that are tagged by
+ ;; their main operator or CAAR, e.g. ((mplus) a b) has CAAR mplus ...
+ ((setf p (get (caar form) 'formatter)) ;; find the formatter. If there is one, call it.
+ (funcall p form))
+ (t form))) ; if there is no formatter. Just return form unchanged.
+
(defun form-mplus (form &aux args trunc)
(setq args (mapcar #'nformat (cdr form)))
(setq trunc (member 'trunc (cdar form) :test #'eq))
@@ -125,6 +133,7 @@
;; FORM
;; (CONS (DELSIMP (CAR FORM)) (MAPCAR #'NFORMAT-ALL (CDR FORM)))))
;;Update from F302
+;; used only in comm.lisp substitute, mpart.
(defmfun nformat-all (form)
(setq form (nformat form))
(if (or (atom form) (eq (caar form) 'bigfloat))
@@ -133,3 +142,55 @@
(if (member (caar form) '(mdo mdoin) :test #'eq)
(mapcar #'(lambda (u) (if u (nformat-all u))) (cdr form))
(mapcar #'nformat-all (cdr form))))))
+
+
+;;; we should define all the formatters in the file after the helper functions like form-mplus
+
+(setf (get 'rat 'formatter)
+ #'(lambda(form)(cond ((minusp (cadr form))
+ (list '(mminus) (list '(rat) (- (cadr form)) (caddr form))))
+ (t (cons '(rat) (cdr form))))))
+
+(setf (get 'mmacroexpanded 'formatter)
+ #'(lambda(form)(nformat (caddr form))))
+
+(setf (get 'mplus 'formatter) #'form-mplus)
+(setf (get 'mtimes 'formatter) #'form-mtimes)
+(setf (get 'mexpt 'formatter) #'form-mexpt)
+(setf (get 'mrat 'formatter) #'form-mrat)
+(setf (get 'mpois 'formatter) #'(lambda(form)(nformat ($outofpois form))))
+
+(setf (get 'bigfloat 'formatter)
+ #'(lambda(form)
+ (if (minusp (cadr form))
+ (list '(mminus) (list (car form) (- (cadr form)) (caddr form)))
+ (cons (car form) (cdr form)))))
+
+(setf (get 'ratio 'formatter) ;; in case a common lisp ratio is returned somehow.
+ #'(lambda (form)
+ (cond ((minusp form)
+ (list '(mminus) (list '(rat) (- (numerator form)) (denominator form))))
+ (t (list '(rat) (numerator form)(denominator form))))))
+
+(setf (get 'complex 'formatter) ;; in case a common lisp complex number is returned somehow.
+ #'(lambda(form)
+ (if (complexp form)
+ (nformat `((mplus) ,(realpart form)
+ ((mtimes) ,(imagpart form) $%i)))
+ ;; some random form with caar COMPLEX
+ ;;not really a CL complex
+ form)))
+
+;; something I added for fun
+(defstruct (ri (:constructor $interval (lo hi) ))lo hi)
+(setf (get 'ri 'formatter) ;; in case a structure of type ri [real interval] is computed
+ #'(lambda(r) (list '($interval simp) (ri-lo r)(ri-hi r)))) ;; this prints it.
+
+;; so in maxima, we can construct ri structures by typing interval(1,2)
+;; and if we display it, it appear as interval(1,2).
+;; but ?print(interval(1,2)) shows the lisp value which is the structure,
+;; #s(ri :lo 1 :hi 2).
+
+;; we could set up formatters for , say, (simple-array single-float <dimensions>)
+;; or share the burden with display program .
+
diff --git a/tests/rtest6.mac b/tests/rtest6.mac
index 3a6c0ce..adfadce 100644
--- a/tests/rtest6.mac
+++ b/tests/rtest6.mac
@@ -17,3 +17,13 @@ diff(log(q(r(x))),x);
integrate(%,x);
log(q(r(x)));
+?nformat(?complex(1,2));
+2*%i + 1;
+?nformat(?/(1,2)); /* ?/(1,2) equivalent to (/ 1 2) in Lisp */
+1/2$
+
+?typep(interval(1,2),?ri);
+true$
+is(part(?complex(1,2),0)="+");
+true$
+
commit 6a1309c1f14db8bd8660b6a3f0768f7258078647
Author: robert_dodier <rob...@us...>
Date: Thu Mar 14 13:54:35 2013 -0700
Put share-subdirs.lisp on list of files for distribution.
Incidentally list such files one per line instead of all on one line.
diff --git a/src/Makefile.am b/src/Makefile.am
index 28379e5..f7d1c4b 100755
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -390,4 +390,22 @@ real_lisp_sources = $(shell echo *.lisp numerical/*.lisp numerical/slatec/*.lisp
genericdirDATA = $(real_lisp_sources)
-EXTRA_DIST = $(real_lisp_sources) maxima.asd maxima.system clisp-depends.mk cmucl-depends.mk scl-depends.mk gcl-depends.mk acl-depends.mk openmcl-depends.mk ecl-depends.mk sbcl-depends.mk numerical/slatec/fortran maxima-build.lisp maxima-command.ico set_lang.vbs lisp sharefiles.mk
+EXTRA_DIST =\
+ $(real_lisp_sources)\
+ maxima.asd\
+ maxima.system\
+ clisp-depends.mk\
+ cmucl-depends.mk\
+ scl-depends.mk\
+ gcl-depends.mk\
+ acl-depends.mk\
+ openmcl-depends.mk\
+ ecl-depends.mk\
+ sbcl-depends.mk\
+ numerical/slatec/fortran\
+ maxima-build.lisp\
+ maxima-command.ico\
+ set_lang.vbs\
+ lisp\
+ sharefiles.mk\
+ share-subdirs.lisp
commit 2ba3aec423c097f6896ff5579b6b47c63f28a0ea
Author: robert_dodier <rob...@us...>
Date: Thu Mar 14 13:48:25 2013 -0700
Remove optimization declarations for ECL in src/numth.lisp, which generates
incorrect code. An example which tickles the bug:
gf_set(8796519617, 2, x^2+3); gf_log(gf_exp(x+9, 1234567890));
which goes into an endless loop somewhere (ECL 12.2.1 + Xubuntu 8.04).
diff --git a/src/numth.lisp b/src/numth.lisp
index 1551495..ea45594 100644
--- a/src/numth.lisp
+++ b/src/numth.lisp
@@ -1209,7 +1209,7 @@
;; c * x
(defun gf-xctimes (x c)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-ctimes))
(maybe-fixnum-let ((c c))
(if (or (= 0 c) (null x)) nil
@@ -1220,7 +1220,7 @@
(rplacd r (list (the fixnum (car rx)) (gf-ctimes c (cadr rx)))) ))))
(defun gf-nxctimes (x c) ;; modifies x
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-ctimes))
(maybe-fixnum-let ((c c))
(if (or (= 0 c) (null x)) nil
@@ -1231,7 +1231,7 @@
;; c*v^e * x
(defun gf-xectimes (x e c)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (fixnum e) (inline gf-ctimes))
(maybe-fixnum-let ((c c))
(if (or (= 0 c) (null x)) nil
@@ -1244,7 +1244,7 @@
;; - x
(defun gf-minus (x)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-cminus-b))
(if (or (null x) (= 2 *gf-char*)) x
(do* ((res (list (the fixnum (car x)) (gf-cminus-b (cadr x))))
@@ -1254,7 +1254,7 @@
(rplacd r (list (the fixnum (car rx)) (gf-cminus-b (cadr rx)))) )))
(defun gf-nminus (x) ;; modifies x
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-cminus-b))
(if (or (null x) (= 2 *gf-char*)) x
(do ((r (cdr x) (cddr r))) (())
@@ -1264,7 +1264,7 @@
;; x + c, 0 < c < *gf-char*
(defun gf-nxcplus (x c) ;; modifies x
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-cplus-b))
(maybe-fixnum-let ((c c))
(cond
@@ -1290,7 +1290,7 @@
;; merge y into x
(defun gf-nplus (x y) ;; modifies x
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-cplus-b))
(cond
((null x) y)
@@ -1341,7 +1341,7 @@
;; merge c*v^e*y into x
(defun gf-nxyecplus (x y e c) ;; modifies x
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (fixnum e)(inline gf-ctimes gf-cplus-b))
(cond
((null y) x)
@@ -1402,7 +1402,7 @@
;; where e.g. xi = ci*v^ei
;;
(defun gf-times (x y)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-ctimes gf-cplus-b))
(if (or (null x) (null y)) nil
(maybe-fixnum-let ((c 0)(cx 0))
@@ -1448,7 +1448,7 @@
;; The reverse needs some additional consing but is slightly faster.
;;
(defun gf-sq (x)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-ctimes gf-cplus-b))
(cond
((null x) x)
@@ -1497,7 +1497,7 @@
;; x^n mod y
(defun gf-pow (x n) ;; assume 0 <= n
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(cond
((= 0 n) (list 0 1))
(*gf-tables?* (gf-pow-by-table x n) )
@@ -1522,7 +1522,7 @@
(gf-nrem (copy-list x) y) ))
(defun gf-nrem (x y) ;; modifies x
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-ctimes gf-cminus-b))
(when (null y) (errrjf "Quotient by zero"))
(if (null x) x
@@ -1541,7 +1541,7 @@
;; assume lc(y) = 1, reduction poly is monic
(defun gf-nred (x) ;; modifies x
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-cminus-b))
(if (null x) x
(let* ((y *gf-red*) (e 0) (ley (car y)))
@@ -1555,7 +1555,7 @@
;; (monic) gcd
(defun gf-gcd (x y)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(cond
((null x) y)
((null y) x)
@@ -1569,7 +1569,7 @@
;; (monic) extended gcd
(defun gf-gcdex (x y)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(let ((x1 (list 0 1)) x2 y1 (y2 (list 0 1)) q r)
(do ()((null y)
(let ((inv (gf-cinv (cadr x))))
@@ -1590,7 +1590,7 @@
;; (might happen when reduction poly isn't irreducible)
(defun gf-inv (y)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(when (null y) (errrjf "Quotient by zero"))
(let ((x *gf-red*)
(y1 (list 0 1)) x1 q r)
@@ -1605,7 +1605,7 @@
y1 (gf-nplus (gf-nminus (gf-times q y1)) x1) )) ))
(defun gf-divide (x y)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-cminus-b))
(cond
((null y) (errrjf "Quotient by zero"))
@@ -1631,7 +1631,7 @@
(gf-minset?) (gf-x2n (gf-p2x p)) )
(defun gf-x2n (x)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(if (null x) 0
(maybe-fixnum-let ((m *gf-char*))
(do ((n 0))(())
@@ -1664,7 +1664,7 @@
(cons '(mlist simp) (gf-x2l x len)) ))
(defun gf-x2l (x len)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (fixnum len))
(do* ((e (the fixnum (car x))) (k (if (= 0 len) e (1- len)) (1- k)) l)
((< k 0) (nreverse l))
@@ -1684,7 +1684,7 @@
(gf-x2p (gf-l2x (cdr l))) )
(defun gf-l2x (l)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(setq l (reverse l))
(maybe-fixnum-let ((c 0))
(do ((e 0) x)
@@ -1703,7 +1703,7 @@
(gf-l2n (cdr l)) )
(defun gf-l2n (l)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(maybe-fixnum-let ((m *gf-char*)(c1 (car l))(c 0))
(setq l (reverse (cdr l)))
(do ((n 0)(b 1))
@@ -1719,14 +1719,14 @@
(cons '(mlist simp) (if (= 0 len) (gf-n2l n) (gf-n2l-twoargs n len))) )
(defun gf-n2l (n) ;; this version is frequently called by gf-precomp, keep it simple
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(maybe-fixnum-let ((d *gf-char*)(r 0))
(do (l) ((= 0 n) l)
(multiple-value-setq (n r) (truncate n d))
(setq l (cons r l)) )))
(defun gf-n2l-twoargs (n len)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (fixnum len) )
(maybe-fixnum-let ((d *gf-char*)(r 0))
(do (l) ((= 0 len) l)
@@ -1738,7 +1738,7 @@
;; leading coefficient retrieved from number representation
(defun gf-n2lc (n)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(maybe-fixnum-let ((d *gf-char*)(r 0))
(do () ((= 0 n) r)
(multiple-value-setq (n r) (truncate n d)) )))
@@ -1765,7 +1765,7 @@
;; p,n > 1 !
(defun gf-irr-p (y p n) ;; gf-irr-p is independent from any settings
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(let ((*gf-char* p)
#-gcl (*fixnump-2gf-char* (< (* 2 p) most-positive-fixnum)) ;; see above
(*gf-red* y)
@@ -1780,7 +1780,7 @@
;; find an irreducible element
(defun gf-irr (gf-char gf-exp)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(when (= 1 gf-exp)
(return-from gf-irr (list 1 1)) )
(let ((*gf-char* gf-char))
@@ -1839,7 +1839,7 @@
(t (gf-prim-p (gf-n2x n))) )))
(defun gf-prim-p (x)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(let ((fbp *gf-fs-base-p*) (mp *gf-x^p-powers*) tmp prod)
(do ((i 0 (1+ i)) (j 0 0) (lf (array-dimension *gf-fs-base-p* 0)))
((= i lf) t)
@@ -1908,7 +1908,7 @@
;; find a primitive element
(defun gf-prim ()
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(let* ((p *gf-char*)
(two-p (* 2 p))
(even-exp (evenp *gf-exp*))
@@ -1949,7 +1949,7 @@
;; returns an array of polynomials x^p^j, j = 0, 1, .. , (n-1), where n = *gf-exp*
(defun gf-x^p-powers (n)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(let ((p *gf-char*)(a (make-array n :element-type 'list :initial-element nil)) )
(setf (svref a 0) (list 1 1)) ;; x
(do ((j 1 (1+ j)))
@@ -1961,7 +1961,7 @@
;; y(x) mod *gf-red*
(defun gf-compose (x y)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(if (integerp x) (gf-at y x)
(do (res) (())
(setq res (gf-nxcplus res (cadr y)))
@@ -1973,7 +1973,7 @@
;; x(a)
(defun gf-at (x a) ;; Horner and square and multiply
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(if (integerp x) x
(maybe-fixnum-let ((a a))
(do ((n 0)) (())
@@ -2084,7 +2084,7 @@
;; find the lowest value k for which a^k = 1
(defun gf-ord (x)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(if *gf-tables?*
(gf-ord-by-table x)
(let ((k *gf-ord*) p (e 0)) (declare (fixnum e))
@@ -2112,7 +2112,7 @@
;; and ord((Fp^n)*) with help of the Chinese Remainder Theorem.
;;
(defun gf-group-order ()
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(maybe-fixnum-let ((modulus *gf-char*) (p *gf-char*))
(prog (e-list p^n (e 0) (ord 1)) (declare (fixnum e))
(do ((x (pfactor (cons *gf-rat-sym* *gf-red*)))) ;; a monic *gf-red* is assumed
@@ -2242,7 +2242,7 @@
mat )))
(defun gf-maybe-normal-basis (x)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(let ((powers *gf-x^p-powers*) ;; use again that f(x)^p = f(x^p)
(gf-exp *gf-exp*) (e (1- *gf-exp*)) )
(declare (fixnum gf-exp e))
@@ -2257,7 +2257,7 @@
;; The elements of the list are values in the range 0, 1, 2, ..., characteristic - 1.
(defun gf-coeffs-array (x n)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (fixnum n))
(let ((cs (make-array (1+ n) :initial-element 0)))
(do ((k n)) ((null x) cs) (declare (fixnum k))
@@ -2272,7 +2272,7 @@
(setq x (cddr x)) ) ))))
(defun gf-coeffs-list (x k)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (fixnum k))
(do () ((or (null x) (>= k (the fixnum (car x)))))
(setq x (cddr x)) )
@@ -2437,7 +2437,7 @@
;; Pohlig and Hellman reduction
(defun gf-dlog (a)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(if *gf-tables?*
(svref $gf_logs (gf-x2n a))
(let (p (e 0) odivp (g *gf-prim*) gg x dlog dlogs tmp)
@@ -2468,7 +2468,7 @@
(declaim (inline gf-dlog-f))
(defun gf-dlog-f (b y z a g q)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(let ((c (mod (cadr b) 3))) (declare (fixnum c))
(cond
((= 0 c)
@@ -2481,7 +2481,7 @@
;; Pollard rho for dlog computation (Brents variant of collision detection)
(defun gf-dlog-rho-brent (a g q)
- #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
+ #+ (or ccl gcl) (declare (optimize (speed 3) (safety 0)))
(declare (inline gf-dlog-f))
(cond
((equal '(0 1) a) 0)
commit 63785f0e721a3ee6cde11526f02a5b94c4e1bcf9
Merge: 41a26d3 dedaef4
Author: robert_dodier <rob...@us...>
Date: Fri Mar 8 13:31:54 2013 -0800
Merge branch 'master' of ssh://git.code.sf.net/p/maxima/code
commit 41a26d3fa1d1fedc3de826d1af2b8b4020dca6dd
Author: robert_dodier <rob...@us...>
Date: Sat Mar 2 01:15:33 2013 -0800
In plot2d/plot3d, accept subscripted variables as independent variables.
diff --git a/src/plot.lisp b/src/plot.lisp
index d344265..b1e6252 100644
--- a/src/plot.lisp
+++ b/src/plot.lisp
@@ -1675,7 +1675,7 @@ output-file))
(defun check-range (range &aux tem a b)
(or (and ($listp range)
(setq tem (cdr range))
- (symbolp (car tem))
+ (or (symbolp (car tem)) ($subvarp (car tem)))
(numberp (setq a ($float (meval* (second tem)))))
(numberp (setq b ($float (meval* (third tem)))))
(< a b))
@@ -2046,12 +2046,12 @@ Several functions depending on the two variables v1 and v2:
(progn
(setq lvars `((mlist) ,(second xrange) ,(second yrange)))
(setq fun (coerce-float-fun fun lvars))
- (when (delete
- (second lvars)
- (delete
- (third lvars)
- (rest ($listofvars (mfuncall fun (second lvars)
- (third lvars))))))
+ (when (cdr
+ ($delete
+ (second lvars)
+ ($delete
+ (third lvars)
+ ($listofvars (mfuncall fun (second lvars) (third lvars))))))
(mtell (intl:gettext "plot3d: expected <expr. of v1 and v2>, [v1, min, max], [v2, min, max]~%"))
(mtell (intl:gettext "plot3d: keep going and hope for the best.~%")))))
(let* ((pl
diff --git a/tests/rtest_plot.mac b/tests/rtest_plot.mac
index 7508f3e..e3bb570 100644
--- a/tests/rtest_plot.mac
+++ b/tests/rtest_plot.mac
@@ -368,5 +368,11 @@ block (local (foo),
plot3d([sin(t), cos(t), t], [t,-5,5], [y,-5,5], [grid,100,2], [gnuplot_pm3d,false])$
+/* plot2d/plot3d with subscripted variable */
+
+(kill (x, a), plot2d (a[x]^3, [a[x], -1, 1]));
+
+plot3d (a[x]^2 - x[a]^3, [a[x], -1, 1], [x[a], -1, 1]);
+
"FINIS" $
-----------------------------------------------------------------------
Summary of changes:
share/contrib/integration/rtest_abs_integrate.mac | 16 +++-
src/Makefile.am | 20 ++++-
src/compar.lisp | 30 +++---
src/db.lisp | 20 ----
src/maxmac.lisp | 15 +--
src/nforma.lisp | 103 ++++++++++++++++----
src/plot.lisp | 14 ++--
tests/rtest6.mac | 10 ++
tests/rtest_plot.mac | 6 +
tests/rtest_sign.mac | 19 ++++
10 files changed, 179 insertions(+), 74 deletions(-)
hooks/post-receive
--
Maxima CAS
|