[Maxima-commits] CVS: maxima/src simp.lisp,1.22,1.23

[Barton W. <wil...@us...>]

Update of /cvsroot/maxima/maxima/src
In directory sc8-pr-cvs7.sourceforge.net:/tmp/cvs-serv15811/src

Modified Files:
	simp.lisp 
Log Message:
fixes for simpabs bugs: 1636746, 1635370, 1635322, and 1635320

Index: simp.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/simp.lisp,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- simp.lisp	31 May 2006 17:34:54 -0000	1.22
+++ simp.lisp	16 Jan 2007 20:38:30 -0000	1.23
@@ -914,24 +914,35 @@
 
 ;;(DEFUN QSNT (X Y) (SIMPLIFY (LIST '(MTIMES) X (LIST '(MEXPT) Y -1))))
 
-(defmfun simpabs (x y z) 
+(setf (get '%mabs 'operators) 'simpabs)
+
+(defmfun simpabs (x y z)
   (oneargcheck x)
   (setq y (simpcheck (cadr x) z))
-  (cond ((numberp y) (abs y)) 
-	((or (ratnump y) ($bfloatp y)) (list (car y) (abs (cadr y)) (caddr y))) 
+  (cond ((numberp y) (abs y))
+	((or (arrayp y) ($member y $arrays)) `((mabs simp) ,y))
+	((or (ratnump y) ($bfloatp y)) (list (car y) (abs (cadr y)) (caddr y)))
+	((taylorize 'mabs (second x)))
+	((memq y '($inf $infinity $minf)) '$inf)
+	((memq y '($ind $und)) y)
 	((eq (setq z (csign y)) t) (cabs y))
-	((memq z '($pos $pz)) y) 
-	((memq z '($neg $nz)) (neg y)) 
+	((memq z '($pos $pz)) y)
+	((memq z '($neg $nz)) (neg y))
 	((eq z '$zero) 0)
 	((and (mexptp y) (integerp (caddr y)))
-	 (list (car y) (simpabs (list '(mabs) (cadr y)) nil t) (caddr y)))
+	 ;;(list (car y) (simpabs (list '(mabs) (cadr y)) nil t) (caddr y)))
+	 (list (car y) (simplifya (list '(mabs) (cadr y)) nil) (caddr y)))
 	((mtimesp y)
-	 (muln (mapcar #'(lambda (u) (simpabs (list '(mabs) u) nil t)) (cdr y)) t))
+	 ;; (muln (mapcar #'(lambda (u) (simpabs (list '(mabs) u) nil t)) (cdr y)) t)
+	 (muln (mapcar #'(lambda (u) (simplifya (list '(mabs) u) nil)) (cdr y)) t))
 	((mminusp y) (list '(mabs simp) (neg y)))
 	((mbagp y)
 	 (cons (car y)
-	       (mapcar #'(lambda (u) (simpabs (list '(mabs) u) nil t)) (cdr y))))
+	       (mapcar #'(lambda (u);;(simpabs (list '(mabs) u) nil t)
+			   (simplifya (list '(mabs) u) nil)) (cdr y))))
+	((op-equalp y '$conjugate) (simplifya `((mabs) ,(first (margs y))) nil))
 	(t (eqtest (list '(mabs) y) x))))
+
 
 (defun pls (x out)
   (prog (fm plusflag)