From: Rupert Swarbrick <rswarbrick@us...>  20140728 22:39:50

This is an automated email from the git hooks/postreceive 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 6db8907fce2cff0e9ef01fe660d3a6d647ade567 (commit) from 71578fbaaeaebeb632f7446ece47c79235ebc767 (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 6db8907fce2cff0e9ef01fe660d3a6d647ade567 Author: Rupert Swarbrick <rswarbrick@...> Date: Mon Jul 28 23:37:56 2014 +0100 Avoid infinite recursion in SP1TRIGEX There was an infinite recursion in SP1TRIGEX when evaluating powerseries(sin(x+qq),x,pp); that caused bug #2772. It happened when trying to expand sin(pp+qq) (which is free of X). Arguably, we might try to spot that the expression is free of X before trying to expand it, but it's probably a good idea to make sure that SP1TRIGEX can't ever trigger an infinite recursion. The problem was that there was some special code to deal with the case when all terms involved X, but no code for the opposite case. This patch rewrites SP1TRIGEX in (I think) a more obvious fashion, factoring out the actual expansion rules to avoid having to assign to variables (and changing their meanings, which confused me a bit). The rewrite uses SCHATCHENCOND, a macro that I wrote recently to factor some logic out of INTEGRATEEXPSPECIAL. As such, the patch moves that macro from sin.lisp into schatc.lisp. There is no code change in the macro, but there is a comment added about how to write an "otherwise" clause. The extra code responsible for actually fixing the bug is the ROTATEF near the top of the new SP1TRIGEX. I'm not including a test, because I don't know how to write one that won't kill the testsuite on failure. diff git a/src/maxima.system b/src/maxima.system index 0e554ce..80a4097 100644  a/src/maxima.system +++ b/src/maxima.system @@ 566,7 +566,8 @@ (:module integration :sourcepathname "" :components ((:file "sinint") (:file "sin")  (:file "risch"))) + (:file "risch")) + :dependson (patternmatching)) (:module taylorseries :sourcepathname "" :components ((:file "hayat"))) (:module definiteintegration :sourcepathname "" @@ 575,7 +576,8 @@ (:module trigonometry :sourcepathname "" :components ((:file "trigi") (:file "trigo")  (:file "trgred"))) + (:file "trgred")) + :dependson (patternmatching)) (:module specialfunctions :sourcepathname "" :components ((:file "specfn"))) (:module matrixalgebra :sourcepathname "" diff git a/src/schatc.lisp b/src/schatc.lisp index 984cb46..63d3423 100644  a/src/schatc.lisp +++ b/src/schatc.lisp @@ 627,4 +627,63 @@ (cdr w1)) (exp1)))) +;; Factor out the common logic to write a COND statement that uses the Schatchen +;; pattern matcher. +;; +;; Each clause in CLAUSES should match (TEST VARIABLES &body BODY). This will be +;; transformed into a COND clause that first runs TEST and binds the result to +;; W. TEST is assumed to boil down to a call to M2, which returns an alist of +;; results for the matched variables. VARIABLES should be a list of symbols and +;; the clause only matches if each of these symbols is bound in the alist. +;; +;; As a special rule, if the CAR of TEST is of the form (AND F1 F2 .. FN) then +;; the result of evaluating F1 is bound to W and then the clause only matches if +;; F2 .. FN all evaluate to true as well as the test described above. +;; +;; If the clause matches then the result of the cond is that of evaluating BODY +;; (in an implicit PROGN) with each variable bound to the corresponding element +;; of the alist. +;; +;; To add an unconditional form at the bottom, use a clause of the form +;; +;; (T NIL F1 .. FN). +;; +;; This will always match and doesn't try to bind any extra variables. + +(defmacro schatchencond (w &body clauses) + `(let ((,w)) + (cond + ,@(loop + for clause in clauses + collecting + (let ((test (car clause)) + (variables (cadr clause)) + (body (cddr clause))) + ;; A clause matches in the cond if TEST returns nonnil and + ;; binds all the expected variables in the alist. As a special + ;; syntax, if the car of TEST is 'AND, then we bind W to the + ;; result of the first argument and then check the following + ;; arguments in an environment where W is bound (but the + ;; variables aren't). + (let ((condtest + (if (and (not (atom test)) (eq 'and (car test))) + `(progn + (setf ,w ,(cadr test)) + (and ,w ,@(loop for var in variables + collecting `(cdras ',var ,w)) + ,@(cddr test))) + `(progn + (setf ,w ,test) + (and ,w ,@(loop for var in variables + collecting `(cdras ',var ,w)))))) + ;; If the clause matched, we explicitly bind all of those + ;; variables in a let form and then evaluate the + ;; associated body. + (condbody + `((let ,(loop for var in variables + collecting `(,var (cdras ',var ,w))) + ,@body)))) + `(,condtest + ,@condbody))))))) + (declaretop (unspecial var ans)) diff git a/src/sin.lisp b/src/sin.lisp index 45c3a91..80e92a9 100644  a/src/sin.lisp +++ b/src/sin.lisp @@ 2301,58 +2301,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Factor out the common logic to write a COND statement that uses the Schatchen ;; pattern matcher. ;; ;; Each clause in CLAUSES should match (TEST VARIABLES &body BODY). This will be ;; transformed into a COND clause that first runs TEST and binds the result to ;; W. TEST is assumed to boil down to a call to M2, which returns an alist of ;; results for the matched variables. VARIABLES should be a list of symbols and ;; the clause only matches if each of these symbols is bound in the alist. ;; ;; As a special rule, if the CAR of TEST is of the form (AND F1 F2 .. FN) then ;; the result of evaluating F1 is bound to W and then the clause only matches if ;; F2 .. FN all evaluate to true as well as the test described above. ;; ;; If the clause matches then the result of the cond is that of evaluating BODY ;; (in an implicit PROGN) with each variable bound to the corresponding element ;; of the alist. (defmacro schatchencond (w &body clauses)  `(let ((,w))  (cond  ,@(loop  for clause in clauses  collecting  (let ((test (car clause))  (variables (cadr clause))  (body (cddr clause)))  ;; A clause matches in the cond if TEST returns nonnil and  ;; binds all the expected variables in the alist. As a special  ;; syntax, if the car of TEST is 'AND, then we bind W to the  ;; result of the first argument and then check the following  ;; arguments in an environment where W is bound (but the  ;; variables aren't).  (let ((condtest  (if (and (not (atom test)) (eq 'and (car test)))  `(progn  (setf ,w ,(cadr test))  (and ,w ,@(loop for var in variables  collecting `(cdras ',var ,w))  ,@(cddr test)))  `(progn  (setf ,w ,test)  (and ,w ,@(loop for var in variables  collecting `(cdras ',var ,w))))))  ;; If the clause matched, we explicitly bind all of those  ;; variables in a let form and then evaluate the  ;; associated body.  (condbody  `((let ,(loop for var in variables  collecting `(,var (cdras ',var ,w)))  ,@body))))  `(,condtest  ,@condbody)))))))  (defun integrateexpspecial (expr var &aux w const) ;; First factor the expression. diff git a/src/trgred.lisp b/src/trgred.lisp index 47b7257..b847f5e 100644  a/src/trgred.lisp +++ b/src/trgred.lisp @@ 538,39 +538,65 @@ (sp1trigex e)) ( e ))) +;; Return the expansion of ((trigfun) ((mplus) a b)). For example sin(a+b) = +;; sin(a)cos(b) + cos(a)sin(b). +(defun expandtrigofsum (trigfun a b) + (ecase trigfun + (%sin + (m+ (m* (sp1trig (list '(%sin) a)) + (sp1trig (list '(%cos) b))) + (m* (sp1trig (list '(%cos) a)) + (sp1trig (list '(%sin) b))))) + (%cos + (m (m* (sp1trig (list '(%cos) a)) + (sp1trig (list '(%cos) b))) + (m* (sp1trig (list '(%sin) a)) + (sp1trig (list '(%sin) b))))) + (%sinh + (m+ (m* (sp1trig (list '(%sinh) a)) + (sp1trig (list '(%cosh) b))) + (m* (sp1trig (list '(%cosh) a)) + (sp1trig (list '(%sinh) b))))) + (%cosh + (m+ (m* (sp1trig (list '(%cosh) a)) + (sp1trig (list '(%cosh) b))) + (m* (sp1trig (list '(%sinh) a)) + (sp1trig (list '(%sinh) b))))))) + +;; Try to expand f(a+b) where f is sin, cos, sinh or cosh. (defun sp1trigex (e)  (let* ((ans (m2 (cadr e) '((mplus) ((coeffpp) (fr freevar))  ((coeffpp) (exp true)))))  (fr (cdr (assoc 'fr ans :test #'eq)))  (exp (cdr (assoc 'exp ans :test #'eq))))  (cond ((signp e fr)  (setq fr (cadr exp)  exp (if (cdddr exp)  (cons (car exp) (cddr exp))  (caddr exp)))))  (cond ((or (equal fr 0)  (null (member (caar e) '(%sin %cos %sinh %cosh) :test #'eq)))  e)  ((eq (caar e) '%sin)  (m+ (m* (sp1trig (list '(%sin) exp))  (sp1trig (list '(%cos) fr)))  (m* (sp1trig (list '(%cos) exp))  (sp1trig (list '(%sin) fr)))))  ((eq (caar e) '%cos)  (m (m* (sp1trig (list '(%cos) exp))  (sp1trig (list '(%cos) fr)))  (m* (sp1trig (list '(%sin) exp))  (sp1trig (list '(%sin) fr)))))  ((eq (caar e) '%sinh)  (m+ (m* (sp1trig (list '(%sinh) exp))  (sp1trig (list '(%cosh) fr)))  (m* (sp1trig (list '(%cosh) exp))  (sp1trig (list '(%sinh) fr)))))  ((eq (caar e) '%cosh)  (m+ (m* (sp1trig (list '(%cosh) exp))  (sp1trig (list '(%cosh) fr)))  (m* (sp1trig (list '(%sinh) exp))  (sp1trig (list '(%sinh) fr)))))))) + (schatchencond w + ;; Ideally, we'd like to split the argument of the trig function into terms + ;; that involve VAR and those that are free of it. + ((m2 (cadr e) '((mplus) ((coeffpp) (a freevar)) ((coeffpp) (b true)))) + (a b) + + ;; Make sure that if B is zero then so is A (to simplify the cond) + (when (signp e b) (rotatef a b)) + + ;; Assuming we didn't just swap them, A will be free of VAR and B will + ;; contain any other terms. If A is zero (because the argument of trig + ;; function is a sum of terms, all of which involve VAR), then fall back on + ;; a different splitting, by terms of taking the first term of B. + (cond + ((and (signp e a) + (not (atom b)) + (eq (caar b) 'mplus)) + (expandtrigofsum (caar e) + (cadr b) + (if (cdddr b) + (cons (car b) (cddr b)) + (caddr b)))) + + ;; For some weird reason, B isn't a sum. Give up. + ((signp e a) e) + + ;; Do the splitting we intended in the first place. + (t + (expandtrigofsum (caar e) a b)))) + + ;; E doesn't match f(a+b). Return it unmodified. + (t nil e))) (defun sp1atrig (fn exp) (cond ((atom exp)  Summary of changes: src/maxima.system  6 ++ src/schatc.lisp  59 ++++++++++++++++++++++++++++++++++ src/sin.lisp  52  src/trgred.lisp  90 ++++++++++++++++++++++++++++++++++ 4 files changed, 121 insertions(+), 86 deletions() hooks/postreceive  Maxima CAS 