[Maxima-commits] CVS: maxima/src factor.lisp, 1.21, 1.22 homog.lisp, 1.9, 1.10 mat.lisp, 1.14, 1.15 rat3d.lisp, 1.16, 1.17 result.lisp, 1.12, 1.13

On 10/26/10 3:26 PM, Andreas Eder wrote:
> Update of /cvsroot/maxima/maxima/src
> In directory sfp-cvsdas-4.v30.ch3.sourceforge.com:/tmp/cvs-serv26967/src
>
> Modified Files:
> 	factor.lisp homog.lisp mat.lisp rat3d.lisp result.lisp 
> Log Message:
>
> replaced nzeros by the appropriate call to make-list where possible;
> moved nzeros to homog.lisp, the only remaining place it is used;
> replaced its implementation with a simpler one;
>
>
>
I don't have any problems with the nzeros change, but can we please
separate out the important changes from the indentation changes like in
mat.lisp?  It took me quite a while to find out that of all the changes,
there was just one change to replace nzero.  (And there was nothing
wrong, to me, with the existing code.)

If someone has to go and fix a bug in mat.lisp, it's a pain to look
through all of these changes only to discover just one change that
relates to the checkin comment.

Ray

> Index: mat.lisp
> ===================================================================
> RCS file: /cvsroot/maxima/maxima/src/mat.lisp,v
> retrieving revision 1.14
> retrieving revision 1.15
> diff -u -d -r1.14 -r1.15
> --- mat.lisp	10 Sep 2009 03:12:05 -0000	1.14
> +++ mat.lisp	26 Oct 2010 19:25:59 -0000	1.15
> @@ -52,7 +52,7 @@
>       (setq varlist varl)
>       (mapc #'newvar eql)
>       (and (not $algebraic)
> -	  (some #'algp varlist) 
> +	  (some #'algp varlist)
>  	  (setq $algebraic t))
>       (setf (symbol-value nam) (make-array (list (1+ (setq xn* (length eql)))
>  						(1+ (setq xm* (1+ (length varl)))))))
> @@ -84,28 +84,29 @@
>  (defun ptorat (ax m n)
>    (prog (i j)
>       (setq ax (get-array-pointer ax))
> -     (setq i (1+ m) n (1+ n)) 
> +     (setq i (1+ m))
> +     (incf n)
>       loop1
> -     (cond ((equal i 1) (return nil)))
> -     (setq i (1- i) j n)
> +     (when (equal i 1) (return nil))
> +     (decf i)
> +     (setq j n)
>       loop2
> -     (cond ((equal j 1) (go loop1)))
> -     (setq j (1- j))
> +     (when (equal j 1) (go loop1))
> +     (decf j)
>       (setf (aref ax i j) (cons (aref ax i j) 1))
>       (go loop2)))
>  
>  (defun meqhk (z)
> -  (cond ((and (not (atom z)) (eq (caar z) 'mequal))
> -	 (simplus (list '(mplus) (cadr z) (list '(mtimes) -1 (caddr z))) 1 nil))
> -	(t z)))
> +  (if (and (not (atom z)) (eq (caar z) 'mequal))
> +      (simplus (list '(mplus) (cadr z) (list '(mtimes) -1 (caddr z))) 1 nil)
> +      z))
>  
>  (defun const (e varl)
> -  (prog (zl)
> -     (setq varl (mapcar (function (lambda(x) (caadr (ratrep* x)))) varl))
> -     (setq e (cdr (ratrep* e)))
> -     (setq zl (nzeros (length varl) nil))
> -     (return (ratreduce (pctimes -1 (pcsubsty zl varl (car e)))
> -			(pcsubsty zl varl (cdr e))))))
> +  (setq varl (mapcar #'(lambda(x) (caadr (ratrep* x))) varl))
> +  (setq e (cdr (ratrep* e)))
> +  (let ((zl (make-list (length varl) :initial-element 0)))
> +    (ratreduce (pctimes -1 (pcsubsty zl varl (car e)))
> +	       (pcsubsty zl varl (cdr e)))))
>  
>  (defvar *mosesflag nil)
>  
> @@ -118,7 +119,7 @@
>  
>  (defmvar $linsolve_params t "`linsolve' generates %Rnums")
>  
> -(defun ith (x n) 
> +(defun ith (x n)
>    (if (atom x) nil (nth (1- n) x)))
>  
>  (defun polyize (ax r m mul)
> @@ -151,7 +152,7 @@
>        (cond ((equal 1 (setq d (cdr (aref ax r c)))) nil)
>  	    (t (setq mul (ptimes mul (pquotient d (pgcd mul d)))))))))
>  
> -;; The author of the following programs is Tadatoshi Minamikawa (TM). 
> +;; The author of the following programs is Tadatoshi Minamikawa (TM).
>  ;; This program is one-step fraction-free Gaussian elimination with
>  ;; optimal pivotting.  DRB claims the hair in this program is not
>  ;; necessary and that straightforward Gaussian elimination is sufficient,
> @@ -213,7 +214,7 @@
>  					       (aref ax (aref *row* k) (aref *col* j))))
>  			  delta))))
>      (do ((i (1+ k) (1+ i)))
> -        ((> i nrow))
> +	((> i nrow))
>        (setf (aref ax (aref *row* i) (aref *col* k)) 0))
>      (setq delta (aref ax (aref *row* k) (aref *col* k))))
>    ;; UNDOES COLUMN HACK IN PIVOT.
> @@ -253,7 +254,7 @@
>      (setq variableorder (cons i variableorder)))
>    (do ((i (1+ rank) (1+ i)))
>        ((> i n))
> -    (cond ((equal (aref ax (aref *row* i) (aref *col* m)) 0) 
> +    (cond ((equal (aref ax (aref *row* i) (aref *col* m)) 0)
>  	   (setq dependentrows (cons (aref *row* i) dependentrows)))
>  	  (t (setq inconsistentrows (cons (aref *row* i) inconsistentrows)))))
>    (do ((i 1 (1+ i)))
> @@ -416,7 +417,7 @@
>    (prog (dummy)
>       (setq dummy (aref *row* i))
>       (setf (aref *row* i) (aref *row* j))
> -     (setf (aref *row* j) dummy) 
> +     (setf (aref *row* j) dummy)
>       (cond ((= i j) (return nil))
>  	   (t (setq permsign (not permsign))))))
>  
> @@ -432,7 +433,7 @@
>  
>  (defun solve2 (llist)
>    (setq $multiplicities nil)
> -  (map2c #'(lambda (equatn multipl) 
> +  (map2c #'(lambda (equatn multipl)
>  	     (setq equations
>  		   (nconc equations (list (displine equatn))))
>  	     (push multipl $multiplicities)
> @@ -444,9 +445,9 @@
>  ;; Displays an expression and returns its linelabel.
>  
>  (defmfun displine (exp)
> -  (let ($nolabels (tim 0)) 
> +  (let ($nolabels (tim 0))
>      (elabel exp)
> -    (cond ($dispflag (remprop linelable 'nodisp) 
> +    (cond ($dispflag (remprop linelable 'nodisp)
>  		     (setq tim (get-internal-run-time))
>  		     (mterpri)
>  		     (displa (list '(mlable) linelable exp))
>