From: Robert D. <rob...@us...> - 2013-01-06 20:51:00
|
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 f0540a43467ec9bc128ffd582e3ffbbfb3d227b6 (commit) via e6a8e996fcd4cfbc94d785a593c7d071c0590c14 (commit) via f23230c5de01d6aff80fc14094810986d69e473a (commit) via cdc63f4691f60defbcaa05e27a7d1a34cab0d0fa (commit) via 655971c73d7a2e5e02aad420e9b86f70fb55cefc (commit) via bbcae4ff86724fd17d2703b968223b5377043ae8 (commit) via 23d46f5a68d5fbb8eb5dcc9d07489f6585300842 (commit) via ba7acd9e9d8616c799f8d2d3bc5a5429292f0523 (commit) via ed1e394eacb87ab587783a1995fafdc62c1e787b (commit) via d57e9456e3c88aa74047521fa93fce0a573b6d32 (commit) via c26dcbca9285398aefbc59bb30c2f3bc184b0d56 (commit) via 79482e4929ec9d39ca3da397fd2a9ee96068f72f (commit) via 420e1d5c4cea22420d9156e288407cc06f6b312d (commit) via fef1249385b7ffc445852411f9eda90e519fcebd (commit) via fc4fafba492727928780c1c9bbf6adf896afbe93 (commit) from e113f58d30d4f079ad228f8973b3071e966dcd7d (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 f0540a43467ec9bc128ffd582e3ffbbfb3d227b6 Merge: e6a8e99 e113f58 Author: robert_dodier <rob...@us...> Date: Sun Jan 6 11:58:36 2013 -0700 Merge branch 'master' of ssh://git.code.sf.net/p/maxima/code commit e6a8e996fcd4cfbc94d785a593c7d071c0590c14 Author: robert_dodier <rob...@us...> Date: Sun Jan 6 11:57:34 2013 -0700 Bind *READ-BASE* to 10. when loading files (both Lisp and Maxima, either explicitly via load or batch, or autoloading). diff --git a/src/autol.lisp b/src/autol.lisp index b3165e5..08e352b 100644 --- a/src/autol.lisp +++ b/src/autol.lisp @@ -5,7 +5,8 @@ ;;(aload "plot.o") (defun aload (file &aux *load-verbose* tem) - (let (($system (list '(mlist) + (let ((*read-base* 10.) + ($system (list '(mlist) #+kcl (concatenate 'string si::*system-directory* "../src/foo.{o,lsp,lisp}")))) (declare (special $system)) diff --git a/src/mload.lisp b/src/mload.lisp index 4db4da5..61b3a6a 100644 --- a/src/mload.lisp +++ b/src/mload.lisp @@ -91,7 +91,7 @@ (defun $batchload (filename &aux expr (*mread-prompt* "")) (declare (special *mread-prompt* *prompt-on-read-hang*)) (setq filename ($file_search1 filename '((mlist) $file_search_maxima))) - (let (($load_pathname filename) (noevalargs nil)) + (let (($load_pathname filename) (noevalargs nil) (*read-base* 10.)) (with-open-file (in-stream filename) (when $loadprint (format t (intl:gettext "~&read and interpret file: ~A~&") (cl:namestring (truename in-stream)))) @@ -195,11 +195,12 @@ (cond ((eq demo :test) (test-batch filename nil :show-all t)) (t - (with-open-file (in-stream filename) - (format t (intl:gettext "~%read and interpret file: ~A~%") - (truename in-stream)) - (catch 'macsyma-quit (continue in-stream demo)) - (namestring in-stream))))) + (let ((*read-base* 10.)) + (with-open-file (in-stream filename) + (format t (intl:gettext "~%read and interpret file: ~A~%") + (truename in-stream)) + (catch 'macsyma-quit (continue in-stream demo)) + (namestring in-stream)))))) ;; Return true if $float converts both a and b to floats and @@ -307,7 +308,8 @@ (show-all nil) (showtime nil)) (let ((result) (next-result) (next) (error-log) (all-differences nil) ($ratprint nil) (strm) - (*mread-prompt* "") (expr) (num-problems 0) (tmp-output) (save-output) (i 0) + (*mread-prompt* "") (*read-base* 10.) + (expr) (num-problems 0) (tmp-output) (save-output) (i 0) (start-run-time 0) (end-run-time 0) (start-real-time 0) (end-real-time 0) (test-start-run-time 0) (test-end-run-time 0) @@ -563,7 +565,7 @@ (setq *collect-errors* nil) (unless $testsuite_files - (load (concatenate 'string *maxima-testsdir* "/" "testsuite.lisp"))) + (let ((*read-base* 10.)) (load (concatenate 'string *maxima-testsdir* "/" "testsuite.lisp")))) (let ((error-break-file) (testresult) (tests-to-run (intersect-tests (cond ((consp tests) tests) diff --git a/src/suprv1.lisp b/src/suprv1.lisp index eec9bd8..c176117 100644 --- a/src/suprv1.lisp +++ b/src/suprv1.lisp @@ -189,7 +189,7 @@ #+lispworks (pathname-type (compile-file-pathname "foo.lisp")) #-(or gcl cmu clisp allegro openmcl lispworks) "")) (if (member type (list bin-ext "lisp" "lsp") :test 'equalp) - #-sbcl (load file) #+sbcl (with-compilation-unit nil (load file)) + (let ((*read-base* 10.)) #-sbcl (load file) #+sbcl (with-compilation-unit nil (load file))) ($load file))))) (defvar autoload 'generic-autoload) @@ -232,6 +232,7 @@ (if printp (format t (intl:gettext "loadfile: loading ~A.~%") file)) (let* ((path (pathname file)) ($load_pathname path) + (*read-base* 10.) (tem (errset #-sbcl (load (pathname file)) #+sbcl (with-compilation-unit nil (load (pathname file)))))) (or tem (merror (intl:gettext "loadfile: failed to load ~A") (namestring path))) (namestring path))) diff --git a/tests/rtest1.mac b/tests/rtest1.mac index 927d59b..f9143fe 100644 --- a/tests/rtest1.mac +++ b/tests/rtest1.mac @@ -310,6 +310,50 @@ true; string (10); "10"; +ibase : 2.; +2.; + +[1, 11, 111, 1111]; +[1., 3., 7., 15.]; + +(load (file_search (test_readbase_lisp, file_search_tests)), + test_readbase_lisp ()); +[1., 2., 3., 4., 10., 20., 30., 40.]; + +[1, 11, 111, 1111]; +[1., 3., 7., 15.]; + +(?autof (test_readbase_lisp_autoload, file_search (test_readbase_lisp_autoload, file_search_tests)), + test_readbase_lisp_autoload ()); +[2., 3., 5., 7., 11., 13., 17., 19.]; + +[1, 11, 111, 1111]; +[1., 3., 7., 15.]; + +(load (file_search (test_readbase_maxima, file_search_tests)), + test_readbase_maxima ()); +[4., 3., 2., 1., 40., 30., 20., 10.]; + +[1, 11, 111, 1111]; +[1., 3., 7., 15.]; + +(batch (file_search (test_readbase_maxima, file_search_tests)), + test_readbase_maxima ()); +[4., 3., 2., 1., 40., 30., 20., 10.]; + +[1, 11, 111, 1111]; +[1., 3., 7., 15.]; + +(auto_mexpr (test_readbase_maxima_autoload, file_search (test_readbase_maxima_autoload, file_search_tests)), + test_readbase_maxima_autoload ()); +[19., 17., 13., 11., 7., 5., 3., 2.]; + +[1, 11, 111, 1111]; +[1., 3., 7., 15.]; + +ibase : 10.; +10.; + /* SF bug report # 2992398 "sort doesn't give error for invalid comparison" */ commit f23230c5de01d6aff80fc14094810986d69e473a Author: robert_dodier <rob...@us...> Date: Sun Jan 6 11:51:37 2013 -0700 For file_search_tests, include Lisp file extensions as well as Maxima. This makes it possible to find Lisp files in the tests directory. diff --git a/src/init-cl.lisp b/src/init-cl.lisp index 58a7c6a..797e8dd 100644 --- a/src/init-cl.lisp +++ b/src/init-cl.lisp @@ -304,6 +304,7 @@ When one changes, the other does too." "") (lisp-patterns (concatenate 'string "$$$.{" ext ",lisp,lsp}")) (maxima-patterns "$$$.{mac,mc}") + (lisp+maxima-patterns (concatenate 'string "$$$.{" ext ",lisp,lsp,mac,mc}")) (demo-patterns "$$$.{dem,dm1,dm2,dm3,dmt}") (usage-patterns "$$.{usg,texi}") (share-subdirs-list (share-subdirs-list)) @@ -336,7 +337,7 @@ When one changes, the other does too." (combine-path *maxima-sharedir* share-subdirs usage-patterns) (combine-path *maxima-docdir* usage-patterns))) (setq $file_search_tests - `((mlist) ,(combine-path *maxima-testsdir* maxima-patterns))) + `((mlist) ,(combine-path *maxima-testsdir* lisp+maxima-patterns))) ;; If *maxima-lang-subdir* is not nil test whether corresponding info directory ;; with some data really exists. If not this probably means that required commit cdc63f4691f60defbcaa05e27a7d1a34cab0d0fa Merge: 655971c 1f2d24c Author: robert_dodier <rob...@us...> Date: Fri Jan 4 22:36:34 2013 -0700 Merge branch 'master' of ssh://git.code.sf.net/p/maxima/code commit 655971c73d7a2e5e02aad420e9b86f70fb55cefc Author: robert_dodier <rob...@us...> Date: Fri Jan 4 19:39:39 2013 -0700 Special variable clean-up: remove unused special OUTFILES. diff --git a/src/lmdcls.lisp b/src/lmdcls.lisp index 2812dfb..dfa5d13 100644 --- a/src/lmdcls.lisp +++ b/src/lmdcls.lisp @@ -123,7 +123,7 @@ meta-prop-l meta-prop-p mfexprp minpoly* mlocp mm* modulus *mopl* mplc* mprogp mproplist mspeclist mspeclist2 msump munbindp need-prog? negprods negsums nn* noevalargs noitems nonintegerl - *nounl* *nounsflag* opers opers-list outargs1 outargs2 outfiles + *nounl* *nounsflag* opers opers-list outargs1 outargs2 preserve-direction prods putl radcanp rd* real-infinities realonlyratnum *refchkl* return-mode returns rulefcnl rulesw scanmapp sfindex sign-imag-errp simplimplus-problems diff --git a/src/mlisp.lisp b/src/mlisp.lisp index d43819b..94d3a3c 100644 --- a/src/mlisp.lisp +++ b/src/mlisp.lisp @@ -29,7 +29,7 @@ or if apply is being used are printed.") $numer state-pdl *mdebug* *refchkl* *baktrcl* $norepeat $detout $doallmxops $doscmxops opers *mopl* $powerdisp $dispflag *alphabet* $%% %e-val - outfiles $macros linel $ratfac $ratwtlvl + $macros linel $ratfac $ratwtlvl $operators $partswitch *gcdl* *builtin-$props* $infolists)) diff --git a/src/transs.lisp b/src/transs.lisp index 56e2416..3f634f8 100644 --- a/src/transs.lisp +++ b/src/transs.lisp @@ -301,10 +301,8 @@ translated." (defun print* (p) (let ((^w t) - (outfiles (list transl-file)) (^r t) ($loadprint nil)) ;;; lusing old I/O !!!!! - (declare (special outfiles)) (sub-print* p))) ;;; i might as well be real pretty and flatten out PROGN's. commit bbcae4ff86724fd17d2703b968223b5377043ae8 Author: robert_dodier <rob...@us...> Date: Fri Jan 4 19:38:32 2013 -0700 Special variable clean-up: remove unused special declaration for $HELP. diff --git a/src/merror.lisp b/src/merror.lisp index 94ab393..b8ac982 100644 --- a/src/merror.lisp +++ b/src/merror.lisp @@ -77,7 +77,7 @@ (and $errormsg ($errormsg)) (cond (*mdebug* (let ((dispflag t) ret) - (declare (special $help dispflag)) + (declare (special dispflag)) (format t (intl:gettext " -- an error. Entering the Maxima debugger.~%~ Enter ':h' for help.~%")) (progn commit 23d46f5a68d5fbb8eb5dcc9d07489f6585300842 Author: robert_dodier <rob...@us...> Date: Fri Jan 4 18:41:25 2013 -0700 Special variable clean-up: remove unused special $FACTORFLAG. Replace specials *EXPR and *RULELIST by lexicals EXPR and RULELIST, resp. diff --git a/src/matrun.lisp b/src/matrun.lisp index 41f3259..79987e0 100644 --- a/src/matrun.lisp +++ b/src/matrun.lisp @@ -16,8 +16,7 @@ ;;; can be found in MAXSRC;TRANS5 >. Be sure to check on those ;;; if any semantic changes are made. -(declare-top (special *expr *rulelist $rules $factorflag - $maxapplyheight $maxapplydepth)) +(declare-top (special $rules $maxapplyheight $maxapplydepth)) ;; $MAXAPPLYDEPTH is the maximum depth within an expression to which ;; APPLYi will delve. If $MAXAPPLYDEPTH is 0, it is applied only to @@ -184,7 +183,7 @@ (go a))) (defmfun part* (e p preds) - (prog (flag saved val $factorflag) + (prog (flag saved val) (if (not (mtimesp e)) (matcherr)) (cond ((> (length p) (length preds)) (setq p (reverse p)) @@ -224,9 +223,9 @@ ;;; TRANSLATE property in MAXSRC;TRANS5 > (defmspec $apply1 (l) (setq l (cdr l)) - (let ((*expr (meval (car l)))) - (mapc #'(lambda (z) (setq *expr (apply1 *expr z 0))) (cdr l)) - *expr)) + (let ((expr (meval (car l)))) + (mapc #'(lambda (z) (setq expr (apply1 expr z 0))) (cdr l)) + expr)) (defmfun apply1 (expr *rule depth) (cond @@ -249,9 +248,9 @@ t)))))))) (defmspec $applyb1 (l) (setq l (cdr l)) - (let ((*expr (meval (car l)))) - (mapc #'(lambda (z) (setq *expr (car (apply1hack *expr z)))) (cdr l)) - *expr)) + (let ((expr (meval (car l)))) + (mapc #'(lambda (z) (setq expr (car (apply1hack expr z)))) (cdr l)) + expr)) (defmfun apply1hack (expr *rule) (prog (pairs max) @@ -283,14 +282,14 @@ (return expr))) (defmspec $apply2 (l) (setq l (cdr l)) - (let ((*rulelist (cdr l))) (apply2 (meval (car l)) 0))) + (let ((rulelist (cdr l))) (apply2 rulelist (meval (car l)) 0))) -(defmfun apply2 (expr depth) +(defmfun apply2 (rulelist expr depth) (cond ((> depth $maxapplydepth) expr) (t (prog (ans ruleptr rule-hit) - a (setq ruleptr *rulelist) + a (setq ruleptr rulelist) b (cond ((null ruleptr) (cond @@ -302,7 +301,7 @@ (simplifya (cons (delsimp (car expr)) - (mapcar #'(lambda (z) (apply2 z (1+ depth))) + (mapcar #'(lambda (z) (apply2 rulelist z (1+ depth))) (cdr expr))) t)))))) (cond ((progn (multiple-value-setq (ans rule-hit) (mcall (car ruleptr) expr)) rule-hit) @@ -311,16 +310,16 @@ (t (setq ruleptr (cdr ruleptr)) (go b))))))) (defmspec $applyb2 (l) (setq l (cdr l)) - (let ((*rulelist (cdr l))) (car (apply2hack (meval (car l)))))) + (let ((rulelist (cdr l))) (car (apply2hack rulelist (meval (car l)))))) -(defmfun apply2hack (e) +(defmfun apply2hack (rulelist e) (prog (pairs max) (setq max 0) - (cond ((atom e) (return (cons (apply2 e -1) 0))) - ((specrepp e) (return (apply2hack (specdisrep e))))) - (setq pairs (mapcar #'apply2hack (cdr e))) + (cond ((atom e) (return (cons (apply2 rulelist e -1) 0))) + ((specrepp e) (return (apply2hack rulelist (specdisrep e))))) + (setq pairs (mapcar #'(lambda (x) (apply2hack rulelist x)) (cdr e))) (setq max 0) (mapc #'(lambda (l) (setq max (max max (cdr l)))) pairs) (setq e (simplifya (cons (delsimp (car e)) (mapcar #'car pairs)) t)) (cond ((= max $maxapplyheight) (return (cons e max))) - (t (return (cons (apply2 e -1) (1+ max))))))) + (t (return (cons (apply2 rulelist e -1) (1+ max))))))) commit ba7acd9e9d8616c799f8d2d3bc5a5429292f0523 Author: robert_dodier <rob...@us...> Date: Fri Jan 4 18:32:33 2013 -0700 Special variable clean-up: remove unused specials ONEOFF*, EI*, EJ*, DOSIMP, *MOSESFLAG, and LININD*. diff --git a/src/matrix.lisp b/src/matrix.lisp index 7365090..4442b5e 100644 --- a/src/matrix.lisp +++ b/src/matrix.lisp @@ -12,9 +12,9 @@ (macsyma-module matrix) -(declare-top (special errrjfflag oneoff* ei* ej* *ech* *tri* *inv* - mdl dosimp $detout vlist mul* top* *det* genvar $ratfac - *mosesflag varlist header linind* $scalarmatrixp $sparse +(declare-top (special errrjfflag *ech* *tri* *inv* + mdl $detout vlist mul* top* *det* genvar $ratfac + varlist header $scalarmatrixp $sparse $algebraic *rank* *mat*)) (defmvar $detout nil) commit ed1e394eacb87ab587783a1995fafdc62c1e787b Author: robert_dodier <rob...@us...> Date: Fri Jan 4 18:28:29 2013 -0700 Special variable clean-up: rename special SIGN to ANTISYM-SIGN, to distinguish it from any other variable named SIGN, and better indicate its purpose. diff --git a/src/asum.lisp b/src/asum.lisp index 06caf47..e0ec412 100644 --- a/src/asum.lisp +++ b/src/asum.lisp @@ -997,28 +997,28 @@ summation when necessary." (setq opers (cons '$antisymmetric opers) *opers-list (cons '($antisymmetric . antisym) *opers-list)) -(declare-top (special sign)) +(declare-top (special antisym-sign)) (defmfun antisym (e z) (let ((l (mapcar #'(lambda (q) (simpcheck q z)) (cdr e)))) - (let (sign) (if (or (not (eq (caar e) 'mnctimes)) (freel l 'mnctimes)) + (let (antisym-sign) (if (or (not (eq (caar e) 'mnctimes)) (freel l 'mnctimes)) (setq l (bbsort1 l))) (cond ((equal l 0) 0) - ((prog1 (null sign) (setq e (oper-apply (cons (car e) l) t))) + ((prog1 (null antisym-sign) (setq e (oper-apply (cons (car e) l) t))) e) (t (neg e)))))) (defun bbsort1 (l) (prog (sl sl1) (if (or (null l) (null (cdr l))) (return l)) - (setq sign nil sl (list nil (car l))) + (setq antisym-sign nil sl (list nil (car l))) loop (setq l (cdr l)) (if (null l) (return (nreverse (cdr sl)))) (setq sl1 sl) loop1(cond ((null (cdr sl1)) (rplacd sl1 (cons (car l) nil))) ((alike1 (car l) (cadr sl1)) (return 0)) ((great (car l) (cadr sl1)) (rplacd sl1 (cons (car l) (cdr sl1)))) - (t (setq sign (not sign) sl1 (cdr sl1)) (go loop1))) + (t (setq antisym-sign (not antisym-sign) sl1 (cdr sl1)) (go loop1))) (go loop))) (setq opers (cons '$nary opers) diff --git a/src/mdot.lisp b/src/mdot.lisp index a5f9dc9..b4716e5 100644 --- a/src/mdot.lisp +++ b/src/mdot.lisp @@ -86,7 +86,7 @@ is no need to rely on the setting of this switch.") ;; Specials defined elsewhere. (declare-top (special $expop $expon ; Controls behavior of EXPAND - sign ; Something to do with BBSORT1 + antisym-sign ; track reversals when reordering noncommutative products errorsw)) ;; The operators "." and "^^" distribute over equations. @@ -381,11 +381,11 @@ is no need to rely on the setting of this switch.") (rplacd (last inner-product) (ncons (car rest)))))) (defun simpnct-antisym-check (l check) - (let (sign) + (let (antisym-sign) (cond ((and (get 'mnctimes '$antisymmetric) (cddr l)) (setq l (bbsort1 l)) (cond ((equal l 0) 0) - ((prog1 (null sign) + ((prog1 (null antisym-sign) (setq l (eqtest (cons '(mnctimes) l) check))) l) (t (neg l)))) commit d57e9456e3c88aa74047521fa93fce0a573b6d32 Author: robert_dodier <rob...@us...> Date: Fri Jan 4 13:03:57 2013 -0700 Special variable clean-up: remove unused specials *EXPR, *RULES, *RULELIST, ALIST, $NOUNDISP; remove unneeded special declarations for ARGS, PT, and *A* (and rename the latter to A). diff --git a/src/matcom.lisp b/src/matcom.lisp index 163302d..3b77957 100644 --- a/src/matcom.lisp +++ b/src/matcom.lisp @@ -14,9 +14,7 @@ ;; This is the Match Compiler. -(declare-top (special *expr *rules *rulelist $rules alist $props - args boundlist *a* pt - reflist topreflist program $noundisp)) +(declare-top (special $rules $props boundlist reflist topreflist program)) (defvar *afterflag nil) @@ -316,7 +314,7 @@ (proc-$defmatch (cdr form)))) (defun proc-$defmatch (l) - (prog (pt pt* args *a* boundlist reflist topreflist program name tem) + (prog (pt pt* args a boundlist reflist topreflist program name tem) (setq name (car l)) (setq pt (copy-tree (setq pt* (simplify (cadr l))))) (cond ((atom pt) @@ -326,13 +324,13 @@ (cond ((null (allatoms args)) (mtell (intl:gettext "defmatch: some pattern variables are not atoms.")) (return nil))) (setq boundlist args) - (setq *a* (genref)) - (cond ((atom (errset (compilematch *a* pt))) + (setq a (genref)) + (cond ((atom (errset (compilematch a pt))) (merror (intl:gettext "defmatch: failed to compile match for pattern ~M") pt)) (t (meta-fset name (list 'lambda - (cons *a* args) - `(declare (special ,*a* ,@ args)) + (cons a args) + `(declare (special ,a ,@ args)) (list 'catch ''match (nconc (list 'prog) (list (setq tem (cdr (reverse topreflist)))) @@ -363,7 +361,7 @@ do (setf (mget v 'rulenum) nil))) (defun proc-$tellsimp (l) - (prog (pt rhs boundlist reflist topreflist *a* program name tem + (prog (pt rhs boundlist reflist topreflist a program name tem oldstuff pgname oname rulenum) (setq pt (copy-tree (simplifya (car l) nil))) (setq name pt) @@ -374,8 +372,8 @@ (merror (intl:gettext "tellsimp: main operator of pattern must not be match variable; found: ~A") (fullstrip1 (getop name)))) ((member name '(mplus mtimes) :test #'eq) (mtell (intl:gettext "tellsimp: warning: putting rules on '+' or '*' is inefficient, and may not work.~%")))) - (setq *a* (genref)) - (cond ((atom (errset (compileeach *a* (cdr pt)))) + (setq a (genref)) + (cond ((atom (errset (compileeach a (cdr pt)))) (merror (intl:gettext "tellsimp: failed to compile match for pattern ~M") (cdr pt)))) (setq oldstuff (get name 'operators)) (setq rulenum (mget name 'rulenum)) @@ -391,14 +389,14 @@ (list 'lambda '(x a2 a3) `(declare (special x a2 a3)) (list 'prog - (list 'ans *a* 'rule-hit) - `(declare (special ans ,*a*)) + (list 'ans a 'rule-hit) + `(declare (special ans ,a)) (list 'setq 'x (list 'cons '(car x) (list 'setq - *a* + a '(cond (a3 (cdr x)) (t (mapcar #'(lambda (h) (simplifya h a3)) (cdr x))))))) @@ -458,7 +456,7 @@ (proc-$tellsimpafter (cdr form)))) (defun proc-$tellsimpafter (l) - (prog (pt rhs boundlist reflist topreflist *a* program name oldstuff plustimes pgname oname tem + (prog (pt rhs boundlist reflist topreflist a program name oldstuff plustimes pgname oname tem rulenum) (setq pt (copy-tree (simplifya (car l) nil))) (setq name pt) @@ -467,10 +465,10 @@ ((atom pt) (merror (intl:gettext "tellsimpafter: pattern must not be an atom; found: ~A") (fullstrip1 (getop name)))) ((mget (setq name (caar pt)) 'matchdeclare) (merror (intl:gettext "tellsimpafter: main operator of pattern must not be match variable; found: ~A") (fullstrip1 (getop name))))) - (setq *a* (genref)) + (setq a (genref)) (setq plustimes (member name '(mplus mtimes) :test #'eq)) - (if (atom (if plustimes (errset (compilematch *a* pt)) - (errset (compileeach *a* (cdr pt))))) + (if (atom (if plustimes (errset (compilematch a pt)) + (errset (compileeach a (cdr pt))))) (merror (intl:gettext "tellsimpafter: failed to compile match for pattern ~M") (cdr pt))) (setq oldstuff (get name 'operators)) (setq rulenum (mget name 'rulenum)) @@ -494,15 +492,15 @@ '(*afterflag x) (list 't (nconc (list 'prog) - (list (cons *a* '(*afterflag rule-hit))) - `((declare (special ,*a* *afterflag))) + (list (cons a '(*afterflag rule-hit))) + `((declare (special ,a *afterflag))) (list '(setq *afterflag t)) (cond (oldstuff (subst (list 'quote name) 'name '((cond ((or (atom x) (not (eq (caar x) name))) (return x))))))) (list (list 'setq - *a* + a (cond (plustimes 'x) (t '(cdr x))))) (list (list 'multiple-value-setq '(ans rule-hit) @@ -538,20 +536,20 @@ ;;(defvar *match-specials* nil);;Hell lets declare them all special, its safer--wfs (defun proc-$defrule (l) - (prog (pt rhs boundlist reflist topreflist name *a* program lhs* rhs* tem) + (prog (pt rhs boundlist reflist topreflist name a program lhs* rhs* tem) (if (not (= (length l) 3)) (wna-err '$defrule)) (setq name (car l)) (if (or (not (symbolp name)) (mopp name) (member name '($all $%) :test #'eq)) (merror (intl:gettext "defrule: rule name must be a symbol, and not an operator or 'all' or '%'; found: ~M") name)) (setq pt (copy-tree (setq lhs* (simplify (cadr l))))) (setq rhs (copy-tree (setq rhs* (simplify (caddr l))))) - (setq *a* (genref)) - (cond ((atom (errset (compilematch *a* pt))) + (setq a (genref)) + (cond ((atom (errset (compilematch a pt))) (merror (intl:gettext "defrule: failed to compile match for pattern ~M") pt)) (t (meta-fset name (list 'lambda - (list *a*) - `(declare (special ,*a*)) + (list a) + `(declare (special ,a)) (list 'catch ''match (nconc (list 'prog) (list (setq tem (nconc boundlist commit c26dcbca9285398aefbc59bb30c2f3bc184b0d56 Author: robert_dodier <rob...@us...> Date: Fri Jan 4 00:14:08 2013 -0700 Special variable clean-up: remove unneeded special declaration. diff --git a/src/marray.lisp b/src/marray.lisp index 1d72229..1f285a9 100644 --- a/src/marray.lisp +++ b/src/marray.lisp @@ -47,7 +47,6 @@ 'list))) ((hash-table-p ary) (let (vals (tab ary)) - (declare (special vals tab)) (maphash #'(lambda (x &rest l) l (unless (eq x 'dim1) (push (gethash x tab) vals))) ary) diff --git a/tests/rtest1a.mac b/tests/rtest1a.mac index 29b5b3b..def5f2e 100644 --- a/tests/rtest1a.mac +++ b/tests/rtest1a.mac @@ -47,3 +47,7 @@ bilx[3]; use_fast_arrays: false; false; + +block ([use_fast_arrays : true], kill (foo), foo [2] : 'x, foo [3] : 'y, foo [5] : 'z, foo [7] : 'a, sort (listarray (foo))); +[a, x, y, z]; + commit 79482e4929ec9d39ca3da397fd2a9ee96068f72f Author: robert_dodier <rob...@us...> Date: Thu Jan 3 17:02:54 2013 -0700 Special variable clean-up: replace specials CCOL and TEXPORT by lexicals, and cut out unused specials $GCPRINT and VAXIMA-MAIN-DIR. diff --git a/share/contrib/lurkmathml/mathml.lisp b/share/contrib/lurkmathml/mathml.lisp index 9c6ca5c..afed9d6 100644 --- a/share/contrib/lurkmathml/mathml.lisp +++ b/share/contrib/lurkmathml/mathml.lisp @@ -103,8 +103,8 @@ (format texport ";~%</pre>")) (t ; display the expression for MathML now: - (myprinc "<math xmlns=\"http://www.w3.org/1998/Math/MathML\"> ") - (mapc #'myprinc + (myprinc "<math xmlns=\"http://www.w3.org/1998/Math/MathML\"> " texport) + (mapc #'(lambda (x) (myprinc x texport)) ;;initially the left and right contexts are ;; empty lists, and there are implicit parens ;; around the whole expression diff --git a/share/contrib/tex2ooo.lisp b/share/contrib/tex2ooo.lisp index 475fa9f..d3eee38 100644 --- a/share/contrib/tex2ooo.lisp +++ b/share/contrib/tex2ooo.lisp @@ -79,8 +79,8 @@ (if mexplabel (setq mexplabel (quote-% mexplabel))) ; display the expression for TeX now: ;- (myprinc "$$") - (myprinc "") - (mapc #'myprinc + (myprinc "" texport) + (mapc #'(lambda (x) (myprinc x texport)) ;;initially the left and right contexts are ;; empty lists, and there are implicit parens ;; around the whole expression diff --git a/src/mactex.lisp b/src/mactex.lisp index 7251e99..bcf2b0a 100644 --- a/src/mactex.lisp +++ b/src/mactex.lisp @@ -56,7 +56,7 @@ ;; in case a file-name is supplied, the output will be sent ;; (perhaps appended) to that file. -(declare-top (special lop rop ccol $gcprint texport $labels $inchar vaxima-main-dir)) +(declare-top (special lop rop $labels $inchar)) (defvar *tex-environment-default* '("$$" . "$$")) @@ -123,9 +123,8 @@ strsym))) (defun tex1 (mexplabel &optional filename-or-stream) ;; mexplabel, and optional filename or stream - (prog (mexp texport $gcprint ccol x y itsalabel need-to-close-texport) - ;; $gcprint = nil turns gc messages off - (setq ccol 1) + (prog (mexp texport x y itsalabel need-to-close-texport) + (reset-ccol) (cond ((null mexplabel) (displa " No eqn given to TeX") (return nil))) @@ -188,8 +187,8 @@ (t (if mexplabel (setq mexplabel (quote-% mexplabel))) ; display the expression for TeX now: - (myprinc (car (get-tex-environment mexp))) - (mapc #'myprinc + (myprinc (car (get-tex-environment mexp)) texport) + (mapc #'(lambda (x) (myprinc x texport)) ;;initially the left and right contexts are ;; empty lists, and there are implicit parens ;; around the whole expression @@ -214,22 +213,20 @@ ;;- that a value is all printed on one line (and not divided ;;- by the crazy top level os routines) -(defun myprinc (chstr) - (prog (chlst) - (cond ((and (> (+ (length (setq chlst (exploden chstr))) ccol) 70.) - (or (stringp chstr) (equal chstr '| |))) - (terpri texport) ;would have exceeded the line length - (setq ccol 1.) - (myprinc " "))) ; lead off with a space for safetyso we split it up. - (do ((ch chlst (cdr ch)) - (colc ccol (1+ colc))) - ((null ch) (setq ccol colc)) - (write-char (car ch) texport)))) - -(defun myterpri nil - (cond (texport (terpri texport)) - (t (mterpri))) - (setq ccol 1)) +(let ((ccol 1)) + (defun reset-ccol () (setq ccol 1)) + + (defun myprinc (chstr texport) + (prog (chlst) + (cond ((and (> (+ (length (setq chlst (exploden chstr))) ccol) 70.) + (or (stringp chstr) (equal chstr '| |))) + (terpri texport) ;would have exceeded the line length + (setq ccol 1.) + (myprinc " " texport))) ; lead off with a space for safetyso we split it up. + (do ((ch chlst (cdr ch)) + (colc ccol (1+ colc))) + ((null ch) (setq ccol colc)) + (write-char (car ch) texport))))) (defun tex (x l r lop rop) ;; x is the expression of interest; l is the list of strings to its commit 420e1d5c4cea22420d9156e288407cc06f6b312d Merge: fef1249 80c3a21 Author: robert_dodier <rob...@us...> Date: Tue Jan 1 13:03:16 2013 -0700 Merge branch 'master' of ssh://git.code.sf.net/p/maxima/code commit fef1249385b7ffc445852411f9eda90e519fcebd Author: robert_dodier <rob...@us...> Date: Mon Dec 31 10:45:59 2012 -0700 Special variable clean-up: remove unused specials *FNEWVARSW, FACLIST, and RES, and replace special POLY* by lexical. diff --git a/src/lesfac.lisp b/src/lesfac.lisp index 46e9482..032418c 100644 --- a/src/lesfac.lisp +++ b/src/lesfac.lisp @@ -12,8 +12,6 @@ (macsyma-module lesfac) -(declare-top (special *fnewvarsw faclist res poly*)) - (load-macsyma-macros rzmac ratmac) (defun newsym2 (p e &aux (g (gensym))) @@ -245,12 +243,11 @@ (t (setq poly (fpcontent poly)) (ptimes (makprod (car poly) contswitch) (makprod1 (cadr poly)))))) -(defun makprod1 (poly*) +(defun makprod1 (poly) (do ((v varlist (cdr v)) (g genvar (cdr g)) - (p (pdis poly*)) - (res 1)) - ((null v) (maksymp poly*)) + (p (pdis poly))) + ((null v) (maksymp poly)) (and (alike1 p (car v)) (return (pget (car g)))))) (defun maksym (p) commit fc4fafba492727928780c1c9bbf6adf896afbe93 Author: robert_dodier <rob...@us...> Date: Mon Dec 31 00:57:24 2012 -0700 Additional examples to test some TeX functions not tested before. diff --git a/tests/rtest_tex.mac b/tests/rtest_tex.mac index abaa898..d39b5a0 100644 --- a/tests/rtest_tex.mac +++ b/tests/rtest_tex.mac @@ -261,3 +261,120 @@ with_stdout (s, close (s); unorder (); /* undo ordergreat above */ + +s : openw ("tmp-rtest-4.tex"); + +kill (a, b, c, d, foo, bar, baz, quux, u, v, w, x, y, z); + +with_stdout (s, + print ("\\documentclass{article}"), + print ("\\title{More \\TeX\\ examples}"), + print ("\\author{Maxim B.}"), + print ("\\begin{document}"), + print ("\\maketitle"), + tex_text ("Here are some more examples. Trying to cover all the bases here.\ + These were discovered by tracing all the functions named in 'TEX properties\ + and seeing which ones were not yet called."), + + print (""), + print ("'at noun expressions."), + + tex ('at (f (u), u = 0)), + tex (1 / (1 - 'at (diff (f (u), u), u = 0))), + + print ("Bigfloats."), + + tex ([0b0, 1b0, -1b0, 1b100]), + tex ((foo (0b0) + bar (1b0))/(baz (-1b0) - quux (1b100))), + + print ("Binomials."), + + tex ('binomial (N, M)), + tex ((a + 'binomial (f (u), sqrt (v)))^(1/2)), + + print ("Cube roots."), + + tex (cubrt (%pi)), + tex (sin (cubrt (1 - %pi))), + + print ("Kronecker delta."), + + tex (kron_delta (0, u)), + tex ((x - kron_delta (cos (y), sin (z)))^n), + + /* + * OMIT -- BOX SEEMS TO BE AMSTEX-SPECIFIC. + * + print ("Stuff in boxes."), + tex (box (u)), + tex (sqrt (box (1 - box (tan (u))))), + */ + + print ("Conditional expressions (verbs)."), + + tex (if 'a > 'b then a else b), + tex (if 'a > 'b then (if 'a > 'c then 'a else 'c) else b), + tex (if 'a > 'b then a elseif 'c > 'b then c else b), + tex (1 + if 'a > 'b then sqrt(a) else b^3), + + print ("Conditional expressions (nouns)."), + + tex ('if 'a > 'b then a else b), + tex ('if 'a > 'b then ('if 'a > 'c then 'a else 'c) else b), + tex ('if 'a > 'b then a elseif 'c > 'b then c else b), + tex (1 + 'if 'a > 'b then sqrt(a) else b^3), + + print ("For-loop expressions (nouns)."), + + tex ('for i thru n do print (i)), + tex (m * 'for i thru floor ((n + 1)/7) do print (i)), + + print ("For-loop expressions (verbs)."), + + tex ('(for i thru n do print (i))), + tex (m * '(for i thru floor ((n + 1)/7) do print (i))), + + print ("For-loops over lists (verbs)."), + + tex ('(for i in L do print (i))), + tex ((1 - a) / '(for i in foo (L[1], L[2]) do print (i))), + + print ("For-loops over lists (nouns)."), + + tex ('for i in L do print (i)), + tex ((1 - a) / 'for i in foo (L[1], L[2]) do print (i)), + + /* (GET 'MLABEL 'TEX) => TEX-MLABEL */ + /* NOT SURE ?? !! */ + + /* (GET 'MLABOX 'TEX) => TEX-MLABOX */ + /* NOT SURE ?? !! */ + + print ("Subscripted functions."), + + tex (F[x](y)), + tex (log (F[mod (x, m)](y!))), + + /* (GET 'TEXT-STRING 'TEX) => TEX-MTEXT */ + /* NOT SURE ?? !! */ + + /* (GET 'MTEXT 'TEX) => TEX-MTEXT */ + /* NOT SURE ?? !! */ + + print ("Rational numbers (RAT expressions)."), + + tex (ratsimp (17/19)), + tex (1/(a + ratsimp (17/19))), + + /* (GET 'SPACEOUT 'TEX) => TEX-SPACEOUT */ + /* NOT SURE ?? !! */ + + print ("Square roots."), + + tex (sqrt (u)), + tex (z - bessel_j (0, sqrt (1/(1 - u)))), + + print ("The end!"), + print ("\\end{document}")); + +close (s); ----------------------------------------------------------------------- Summary of changes: share/contrib/lurkmathml/mathml.lisp | 4 +- share/contrib/tex2ooo.lisp | 4 +- src/asum.lisp | 10 ++-- src/autol.lisp | 3 +- src/init-cl.lisp | 3 +- src/lesfac.lisp | 9 +-- src/lmdcls.lisp | 2 +- src/mactex.lisp | 41 ++++++------ src/marray.lisp | 1 - src/matcom.lisp | 50 +++++++-------- src/matrix.lisp | 6 +- src/matrun.lisp | 37 +++++------ src/mdot.lisp | 6 +- src/merror.lisp | 2 +- src/mlisp.lisp | 2 +- src/mload.lisp | 18 +++-- src/suprv1.lisp | 3 +- src/transs.lisp | 2 - tests/rtest1.mac | 44 +++++++++++++ tests/rtest1a.mac | 4 + tests/rtest_tex.mac | 117 ++++++++++++++++++++++++++++++++++ 21 files changed, 263 insertions(+), 105 deletions(-) hooks/post-receive -- Maxima CAS |