[Maxima-commits] CVS: maxima/src combin.lisp, 1.18, 1.19 mactex.lisp, 1.50, 1.51 nrat4.lisp, 1.8, 1.9 polyrz.lisp, 1.7, 1.8 result.lisp, 1.8, 1.9 rpart.lisp, 1.9, 1.10

[Andreas E. <ar...@us...>]

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

Modified Files:
	combin.lisp mactex.lisp nrat4.lisp polyrz.lisp result.lisp 
	rpart.lisp 
Log Message:
replaced maclispisms by CL idioms (add1/sub1 etc.)


Index: combin.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/combin.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- combin.lisp	27 Feb 2007 22:25:28 -0000	1.18
+++ combin.lisp	13 Mar 2007 19:40:06 -0000	1.19
@@ -644,9 +644,7 @@
     (0 1)
     (1  cf(list 1))
     (t
-     (setq pp (list (add1
-		     (* (first cf) (second cf)))
-		    (car cf)))
+     (setq pp (list (1+ (* (first cf) (second cf))) (car cf)))
      (setq qq (list (second cf) 1))
      (show pp qq)
      (setq cf (cddr cf))

Index: mactex.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/mactex.lisp,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -d -r1.50 -r1.51
--- mactex.lisp	4 Mar 2007 20:09:16 -0000	1.50
+++ mactex.lisp	13 Mar 2007 19:40:06 -0000	1.51
@@ -54,22 +54,12 @@
 ;; in case a file-name is supplied, the output will be sent
 ;; (perhaps appended) to that file.
 
-;;(macsyma-module tex ); based on "mrg/grind"
-
-(declare-top
- (special lop rop ccol $gcprint texport $labels $inchar
-	  vaxima-main-dir
-	  )
- (*expr tex-lbp tex-rbp))
+(declare-top (special lop rop ccol $gcprint texport $labels $inchar vaxima-main-dir))
 
 ;; top level command the result of tex'ing the expression x.
 ;; Lots of messing around here to get C-labels verbatim printed
 ;; and function definitions verbatim "ground"
 
-;;(defmspec $tex(l) ;; mexplabel, and optional filename
-;;  (let ((args (cdr l)))
-;;  (apply 'tex1  args)))
-
 (defmspec $tex(l) ;; mexplabel, and optional filename
   ;;if filename supplied but 'nil' then return a string
   (let ((args (cdr l)))
@@ -183,7 +173,7 @@
 	    (myprinc " ")	    ; lead off with a space for safety
 	    ))				;so we split it up.
      (do ((ch chlst (cdr ch))
-	  (colc ccol (add1 colc)))
+	  (colc ccol (1+ colc)))
 	 ((null ch) (setq ccol colc))
        (write-char (car ch) texport))))
 

Index: nrat4.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/nrat4.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- nrat4.lisp	7 Nov 2005 17:37:11 -0000	1.8
+++ nrat4.lisp	13 Mar 2007 19:40:06 -0000	1.9
@@ -9,13 +9,11 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (in-package :maxima)
+
 (macsyma-module nrat4)
 
-(declare-top(genprefix fqz_)
-	    (special $ratsimpexpons *exp *exp2 *radsubst *loglist $radsubstflag 
-		     $radexpand $logsimp *v *var fr-factor radcanp ratsubvl)
-	    (*lexpr $ratsimp)
-	    (fixnum nargs))
+(declare-top (special $ratsimpexpons *exp *exp2 *radsubst *loglist $radsubstflag 
+		      $radexpand $logsimp *v *var fr-factor radcanp ratsubvl))
 
 (load-macsyma-macros rzmac ratmac)
 
@@ -34,7 +32,7 @@
 (defun rform (x) (cdr (ratf x)))
 
 (setq radcanp nil)
-
+
 (defmfun $ratcoef nargs
   (cond ((= nargs 3) (ratcoeff (arg 1) (arg 2) (arg 3)))
 	((= nargs 2) (ratcoeff (arg 1) (arg 2) 1))
@@ -112,7 +110,7 @@
   (cond ((null p) 0)
 	((zerop (car p)) (cadr p))
 	(t (constcoef (cddr p)))))
-
+
 (setq *radsubst nil ratsubvl t)		;SUBST ON VARLIST
 
 (defmfun $ratsubst (a b c)		;NEEDS CODE FOR FAC. FORM 
@@ -183,7 +181,7 @@
 	     varlist nil
 	     c (ratf c)))
      (return (cond (dontdisrepit c) (t ($ratdisrep c))))))
-
+
 (defun xptimes (x y) (if $ratwtlvl (wtptimes x y 0) (ptimes x y)))
 
 (defun allsubst00 (a b c)
@@ -213,7 +211,7 @@
   (do ((ptr l (cddr ptr)))
       ((null ptr) l)
     (setf (cadr ptr) (ptimes h (cadr ptr)))))
-
+
 
 (defun pairoff (l m)
   (cond ((null m) l) (t (cons (car m) (pairoff (cdr l) (cdr m))))))
@@ -266,9 +264,9 @@
     (setf (cadr ptr)
 	  (ptimes (psimp k (list (f- j (f* n (car ptr))) 1))
 		  (cadr ptr)))))
-
+
 (defun substforsum (a b maxpow)
-  (do ((pow 0 (add1 pow))
+  (do ((pow 0 (1+ pow))
        (quot) (zl-rem) (ans))
       ((not (lessp pow maxpow)) (list* maxpow b ans))
     (desetq (quot zl-rem) (pdivide b a))
@@ -310,7 +308,7 @@
       (and (not (atom (cdr x)))
 	   (null (cdddr x))
 	   (pureprod (caddr x)))))
-
+
 (defmfun $bothcoef (r var) 
   (prog (*var h varlist genvar $ratfac)
      (unless ($ratp r)
@@ -394,7 +392,7 @@
 (defmfun hand-side (e flag)
   (setq e (if (eq (caar e) 'mequal) (ncons e) (cdr e)))
   (mapcar #'(lambda (u) (if (eq flag 'l) (cadr u) (caddr u))) e))
-
+
 (comment subtitle radcan)
 
 (defmfun $radcan (exp)
@@ -435,7 +433,7 @@
 
 (defun allatoms (l)
   (loop for x in l always (atom x)))
-
+
 (defun rjfsimp (x &aux expon) 
   (cond ((and *radsubst $radsubstflag) x)
 	((not (m$exp? (setq x (let ($logsimp) (resimplify x))))) x)
@@ -465,7 +463,7 @@
   (if *radsubst (setq *exp2 (allsubst00 a b *exp2))))
 
 (setq *var nil)
-
+
 (defun spc1 (x)
   (cond ((mlogp x) (putonloglist x))
 	((and (mexptp x) (not (eq (cadr x) '$%e)))
@@ -504,7 +502,7 @@
 				    (cdr y))))
     (radsubst (rform y) (rget v))
     (dsubsta y x varlist)))
-
+
 (defun spc4 (x) 
   (if (and (m$exp? x)
 	   (not (memalike (caddr x) *v)))
@@ -566,7 +564,7 @@
       (radsubst (ratexpt rbase (cadr expon))
 		(ratexpt rad (caddr expon))))))
 
-
+
 (defun goodform (l) ;;bad -> good
   (loop for (exp coef) on l by #'pt-red
 	 collect (cons exp coef)))
@@ -583,7 +581,7 @@
      (setq negl (flsort negl) posl (flsort posl) l (append negl posl))
      (setq negl (mapcar (function cdr) negl)
 	   posl (mapcar (function cdr) posl))
-     a     (setq negl (zl-delete '((-1 . 1)) negl))
+     a     (setq negl (delete '((-1 . 1)) negl :test #'equal))
      (or negl
 	 (return (mapc #'(lambda (x) (rplacd x (spc2a (cdr x)))) l)))
      (setq maxnl (flmaxl negl)
@@ -598,8 +596,8 @@
      (cond ((and (flevenp maxpl) (not (flevenp maxnl)))
 	    (mapc #'(lambda (fp) (rplaca (car fp) (pminus (caar fp)))
 			    (cond ((oddp (cdar fp))
-				   (zl-delete '(-1 . 1) fp)
-				   (setq negl (zl-delete fp negl))
+				   (setq fp (delete '(-1 . 1) fp :test #'equal))
+				   (setq negl (delete fp negl :test #'equal))
 				   (and (cdr fp) (push (cdr fp) posl)))))
 		  maxnl)
 	    (go a))
@@ -614,7 +612,7 @@
   (mapl #'(lambda (x) (if (equal p (caaar x))
 			  (rplaca x (cdar x))))
 	pl)
-  (zl-delete nil pl))
+  (delete nil pl :test #'equal))
 
 (defun flmaxl (fpl)			;lists of fac. polys
   (cond ((null fpl) nil)
@@ -658,9 +656,3 @@
 	((> (cadr p) (cadr q)) t)
 	((< (cadr p) (cadr q)) nil)
 	(t (flgreat1 (caddr p) (caddr q)))))
-
-
-;; Undeclarations for the file:
-#-nil
-(declare-top(notype nargs))
-

Index: polyrz.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/polyrz.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- polyrz.lisp	7 Nov 2005 17:37:12 -0000	1.7
+++ polyrz.lisp	13 Mar 2007 19:40:06 -0000	1.8
@@ -9,18 +9,17 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (in-package :maxima)
-(macsyma-module polyrz)
 
-(declare-top(special errrjfflag $programmode varlist 
-		     $ratepsilon $ratprint $factorflag genvar
-		     equations $keepfloat $ratfac $rootsepsilon
-		     $multiplicities))
+(macsyma-module polyrz)
 
-(declare-top(genprefix a_5))
+(declare-top (special errrjfflag $programmode varlist 
+		      $ratepsilon $ratprint $factorflag genvar
+		      equations $keepfloat $ratfac $rootsepsilon
+		      $multiplicities))
 
 (load-macsyma-macros ratmac)
 
-
+
 ;;	PACKAGE FOR FINDING REAL ZEROS OF UNIVARIATE POLYNOMIALS
 ;;	WITH INTEGER COEFFICIENTS USING STURM SEQUENCES.
 
@@ -66,7 +65,7 @@
 	((equal (caar pt) 'rat) (cons (cadr pt) (caddr pt)))
 	(t (merror "~M Non-numeric argument" pt))))
 
-(declare-top(special equations))
+(declare-top (special equations))
 
 (defun sturmseq (exp eps)
   (let (varlist equations $factorflag $ratprint $ratfac)
@@ -78,7 +77,7 @@
 				(makrat eps)))
 	     (cons '(mlist) equations)))))
 
-(declare-top(unspecial equations))
+(declare-top (unspecial equations))
 
 (defmfun sturm1 (poly eps &aux b llist)
   (setq b (cons (root-bound (cdr poly)) 1))
@@ -89,16 +88,17 @@
   (prog (n lcf loglcf coef logb)
      (setq n (car p))
      (setq lcf (abs (cadr p)))
-     (setq loglcf (f1- (log2 lcf)))
+     (setq loglcf (1- (log2 lcf)))
      (setq logb 1)
      loop (cond ((null (setq p (cddr p))) (return (expt 2 logb)))
 		((lessp (setq coef (abs (cadr p))) lcf) (go loop)) )
-     (setq logb (max logb (f+ 1 (ceil (f- (log2 coef) loglcf)
-				      (f- n (car p)) )))) 
+     (setq logb (max logb (+ 1 (ceil (- (log2 coef) loglcf)
+				      (- n (car p)) )))) 
      (go loop) ))
 
-(defun ceil (a b) (plus (quotient a b)	;CEILING FOR POS A,B
-			(signum (remainder a b))))
+(defun ceil (a b)
+  (+ (quotient a b)			;CEILING FOR POS A,B
+     (signum (rem a b))))
 
 (defun sturmapc (fn llist multiplicity)
   (cond ((null llist) nil)
@@ -121,7 +121,8 @@
 	($float (fpcofrat1 (car pt) (cdr pt)))
 	(t (list '(rat simp) (car pt) (cdr pt))) ))
 
-(defun uprimitive (p) (pquotient p (ucontent p))) ;PRIMITIVE UNIVAR. POLY
+(defun uprimitive (p)
+  (pquotient p (ucontent p)))		;PRIMITIVE UNIVAR. POLY
 
 (defun sturm (p)
   (prog (p1 p2 seq r)
@@ -149,7 +150,7 @@
      a    (cond ((null seq)(return v)))
      (setq s (reval (car seq) pt))
      (setq seq (cdr seq))
-     (cond ((minusp (times s  ls))(setq v (add1 v)))
+     (cond ((minusp (* s  ls))(setq v (1+ v)))
 	   ((not (zerop ls))(go a)))
      (setq ls s)
      (go a) ))
@@ -174,10 +175,10 @@
 	      a    (cond ((equal m (car p)) (setq c (cadr p))
 			  (setq p (cddr p)))
 			 (t (setq c 0)))
-	      (cond ((zerop m) (return (signum (plus v (times bi c))))))
-	      (setq v (times a (plus v (times bi c))))
-	      (setq bi (times bi b))
-	      (setq m (sub1 m))
+	      (cond ((zerop m) (return (signum (+ v (* bi c))))))
+	      (setq v (* a (+ v (* bi c))))
+	      (setq bi (* bi b))
+	      (setq m (1- m))
 	      (go a) ))))
 
 (defun makpoint (pt)
@@ -197,8 +198,8 @@
 (defun rootaddup (llist l r)
   (cond ((null llist) 0)
 	((numberp (car llist)) (rootaddup (cddr llist) l r))
-	(t (plus (rootaddup (cddr llist) l r)
-		 (times (cadr llist) (nroot1 (car llist) l r)))) ))
+	(t (+ (rootaddup (cddr llist) l r)
+		 (* (cadr llist) (nroot1 (car llist) l r)))) ))
 
 (defun nroot1 (p l r)
   (let ((seq (sturm p)))
@@ -243,23 +244,23 @@
 	   (t (setq l mid)) )
      (go a) ))
 
-(defun rhalf (r) (rreduce (car r) (times 2 (cdr r))))
+(defun rhalf (r) (rreduce (car r) (* 2 (cdr r))))
 
 (defun rreduce (a b) 
   (let ((g (abs (gcd a b))))
-    (cons (quotient a g) (quotient b g))) )
+    (cons (truncate a g) (truncate b g))) )
 
 (defun rplus* (a b)
-  (cons (plus (times (car a) (cdr b))(times (car b) (cdr a)))
-	(times (cdr a) (cdr b))))
+  (cons (+ (* (car a) (cdr b)) (* (car b) (cdr a)))
+	(* (cdr a) (cdr b))))
 
 (defun rdifference* (a b)
   (rplus* a (cons (minus (car b)) (cdr b))) )
 
 (defun rlessp (a b)
-  (lessp (times (car a) (cdr b))
-	 (times (car b) (cdr a)) ))
-
+  (lessp (* (car a) (cdr b))
+	 (* (car b) (cdr a)) ))
+
 
 ;;; This next function is to do what SOLVE2 should do in programmode
 (defun multout (rootlist)
@@ -275,5 +276,4 @@
     (setq $multiplicities (cons '(mlist)  (cdr rootlist)))
     (car rootlist)))
 
-(declare-top(unspecial equations))
-
+(declare-top (unspecial equations))

Index: result.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/result.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- result.lisp	18 Feb 2007 10:40:53 -0000	1.8
+++ result.lisp	13 Mar 2007 19:40:06 -0000	1.9
@@ -9,9 +9,10 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (in-package :maxima)
+
 (macsyma-module result)
 
-(declare-top(special varlist genvar $ratfac $keepfloat modulus *alpha xv))
+(declare-top (special varlist genvar $ratfac $keepfloat modulus *alpha xv))
 
 (load-macsyma-macros ratmac)
 
@@ -29,7 +30,7 @@
 	  ((or (= n 0) (not (atom  (cdr rform))))
 	   (merror "The first argument to 'poly_discriminant' must be a polynomial in ~:M" var))
 	  (t (pdis (presign
-		    (// (f* n (f1- n)) 2)
+		    (ash (* n (1- n)) -1)
 		    (pquotient (resultant poly (pderivative poly rvar))
 			       (p-lc poly))))))))
 
@@ -51,9 +52,9 @@
 				      (t (ptimeschk (car res)
 						    (pexpt (makprod (cadr res) nil)
 							   (caddr res)))))
-				(times (cdar l1) (cdar l2)))))))
+				(* (cdar l1) (cdar l2)))))))
      (return (cond (formflag (pdis* ans)) (t (pdis ans))))))
-
+
 (defun result1 (p1 p2 var)
   (cond ((or (pcoefp p1) (pointergp var (car p1)))
 	 (list 1 p1 (pdegree p2 var)))
@@ -79,7 +80,7 @@
 
 (defmfun resultant (p1 p2)		;assumes same main var
   (if (> (p-le p2) (p-le p1))
-      (presign (f* (p-le p1) (p-le p2)) (resultant p2 p1)) 
+      (presign (* (p-le p1) (p-le p2)) (resultant p2 p1)) 
       (case $resultant
 	($subres (subresult p1 p2))
 	#+broken ($mod (modresult p1 p2))
@@ -88,23 +89,20 @@
 
 (defun presign (n p)
   (if (oddp n) (pminus p) p))
-
-(declare-top (splitfile subres))
+
 ;;computes resultant using subresultant p.r.s. TOMS Sept. 1978
 
 (defun subresult (p q)
   (loop for g = 1 then (p-lc p)
 	 for h = 1 then (pquotient (pexpt g d) h^1-d)
 	 for degq = (pdegree q (p-var p))
-	 for d = (f- (p-le p) degq)
-	 for h^1-d = (if (equal h 1) 1 (pexpt h (f1- d)))
+	 for d = (- (p-le p) degq)
+	 for h^1-d = (if (equal h 1) 1 (pexpt h (1- d)))
 	 if (zerop degq) return (if (pzerop q) q (pquotient (pexpt q d) h^1-d))
 	 do (psetq p q
-		   q (presign (f1+ d) (pquotient (prem p q)
+		   q (presign (1+ d) (pquotient (prem p q)
 						 (ptimes g (ptimes h h^1-d)))))))
 
-(declare-top (splitfile redres))
-
 ;;	PACKAGE FOR CALCULATING MULTIVARIATE POLYNOMIAL RESULTANTS 
 ;;	USING MODIFIED REDUCED P.R.S.
 
@@ -115,21 +113,19 @@
      (setq c 1)
      a    (if (pzerop (setq r (prem u v))) (return (pzero)))
      (setq c (ptimeschk c (pexpt (p-lc v)
-				 (f* (f- (p-le u) (p-le v))
-				     (f- (p-le v) (pdegree r (p-var u))
+				 (* (- (p-le u) (p-le v))
+				     (- (p-le v) (pdegree r (p-var u))
 					 1)))))
-     (setq sigma (f+ sigma (f* (p-le u) (p-le v))))
+     (setq sigma (+ sigma (* (p-le u) (p-le v))))
      (if (zerop (pdegree r (p-var u)))
 	 (return
 	   (presign sigma
 		    (pquotient (pexpt (pquotientchk r a) (p-le v)) c))))
      (psetq u v
 	    v (pquotientchk r a)
-	    a (pexpt (p-lc v) (f+ (p-le u) 1 (f- (p-le v)))))
+	    a (pexpt (p-lc v) (+ (p-le u) 1 (- (p-le v)))))
      (go a)))
 
-
-(declare-top (splitfile modres))
 
 ;;	PACKAGE FOR CALCULATING MULTIVARIATE POLYNOMIAL RESULTANTS 
 ;;	USING MODULAR AND EVALUATION HOMOMORPHISMS.
@@ -165,7 +161,7 @@
        (setq c* (cpres a* b* xr1 varl))
        (setqmodulus nil)
        (setq c (lagrange3 c c* p q))
-       (setq q (times p q))
+       (setq q (* p q))
        (cond ((greaterp q f) (return c))
 	     (t (go step2)) ) ))
 
@@ -173,11 +169,11 @@
     (not (eqn (pdegree a xv) m)))
 
   (defun coefbound (m n d e)
-    (times 2 (expt (f1+ m) (// n 2))
-	   (expt (f1+ n) (// m 2))
-	   (cond ((oddp n) (f1+ ($isqrt (f1+ m))))
+    (* 2 (expt (1+ m) (ash n -1))
+	   (expt (1+ n) (ash m -1))
+	   (cond ((oddp n) (1+ ($isqrt (1+ m))))
 		 (t 1))
-	   (cond ((oddp m) (f1+ ($isqrt (f1+ n))))
+	   (cond ((oddp m) (1+ ($isqrt (1+ n))))
 		 (t 1))
 	   ;; (FACTORIAL (PLUS M N)) USED TO REPLACE PREV. 4 LINES. KNU II P. 375
 	   (expt d n)
@@ -187,7 +183,7 @@
     (cond ((null a) (cons exp tot))
 	  (t (main2 (cddr a) var
 		    (max (setq var (pdegree (cadr a) var)) exp)
-		    (max (f+ (car a) var) tot))) ))
+		    (max (+ (car a) var) tot))) ))
 
   (defun cpres (a b xr1 varl)		;XR1 IS MAIN VAR WHICH
     (cond ((null varl) (cpres1 (cdr a) (cdr b))) ;RESULTANT ELIMINATES
@@ -200,18 +196,18 @@
 		   (setq varl (cdr varl))
 		   (setq m2 (main2 (cdr a) xv 0 0)) ;<XV DEG . TOTAL DEG>
 		   (setq n2 (main2 (cdr b) xv 0 0))
-		   (cond ((zerop (f+ (car m2) (car n2)))
+		   (cond ((zerop (+ (car m2) (car n2)))
 			  (cond ((null varl) (return (cpres1 (cdr a) (cdr b))))
 				(t (go step2)) ) ))
-		   (setq k (f1+ (min (f+ (f* m1 (car n2)) (f* n1 (car m2)))
-				     (f+ (f* m1 (cdr n2)) (f* n1 (cdr m2))
-					 (f- (f* m1 n1))) )))
+		   (setq k (1+ (min (+ (* m1 (car n2)) (* n1 (car m2)))
+				     (+ (* m1 (cdr n2)) (* n1 (cdr m2))
+					 (- (* m1 n1))) )))
 		   (setq c 0)
 		   (setq d 1)
 		   (setq m2 (car m2) n2 (car n2))
 		   (setq bp (minus 1))
 		   step3
-		   (cond ((equal (setq bp (add1 bp)) modulus)
+		   (cond ((equal (setq bp (1+ bp)) modulus)
 			  (merror "Resultant primes too small."))
 			 ((zerop m2) (setq a* a))
 			 (t (setq a* (pcsubst a bp xv))
@@ -223,10 +219,8 @@
 		   (setq c (lagrange33 c c* d bp))
 		   (setq d (ptimeschk d (list xv 1 1 0 (cminus bp))))
 		   (cond ((> (cadr d) k) (return c))
-			 (t (go step3))) )) ))
-  )
-
-(declare-top (splitfile bezout))
+			 (t (go step3))))))))
+
 
 ;; *** NOTE THAT MATRIX PRODUCED IS ALWAYS SYMETRIC
 ;; *** ABOUT THE MINOR DIAGONAL.
@@ -244,7 +238,7 @@
 		  p))))
 
 (defun vmake (poly n *l)
-  (do ((i (f1- n) (f1- i))) ((minusp i))
+  (do ((i (1- n) (1- i))) ((minusp i))
     (cond ((or (null poly) (< (car poly) i))
 	   (setq *l (cons 0 *l)))
 	  (t (setq *l (cons (cadr poly) *l))
@@ -252,15 +246,15 @@
   (nreverse *l))
 
 (defun bezout (p q)
-  (let* ((n (f1+ (p-le p)))
-	 (n2 (f- n (p-le q)))
+  (let* ((n (1+ (p-le p)))
+	 (n2 (- n (p-le q)))
 	 (a (vmake (p-terms p) n nil))
 	 (b (vmake (p-terms q) n nil))
 	 (ar (reverse (nthcdr n2 a)))
 	 (br (reverse (nthcdr n2 b)))
 	 (l (nzeros n nil)))
-    (rplacd (nthcdr (f1- (p-le p)) a) nil)
-    (rplacd (nthcdr (f1- (p-le p)) b) nil)
+    (rplacd (nthcdr (1- (p-le p)) a) nil)
+    (rplacd (nthcdr (1- (p-le p)) b) nil)
     (nconc
      (mapcar
       #'(lambda (ar br)

Index: rpart.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/rpart.lisp,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- rpart.lisp	12 Mar 2007 22:22:49 -0000	1.9
+++ rpart.lisp	13 Mar 2007 19:40:06 -0000	1.10
@@ -133,17 +133,17 @@
 ;;;Try risplit z/w and notice denominator.  If this check were not made,
 ;;; the real and imaginary parts would not each be over a common denominator.
 		    (eq (caadr sp) 'mtimes)
-		    ((lambda (nr ni)
-		       (cond ((equal (car nr) (car ni))
-			      (setq
-			       purerl (cons (car nr) purerl)
-			       compl
-			       (cons (cons (muln (nreverse (cdr nr)) t)
-					   (muln (nreverse (cdr ni)) t))
-				     compl)))
-			     (t (nreverse nr) (nreverse ni) nil)))
-		     (nreverse (cdar sp))
-		     (nreverse (cddr sp)))))
+		    (let ((nr (nreverse (cdar sp)))
+			  (ni (nreverse (cddr sp))))
+		      (cond ((equal (car nr) (car ni))
+			     (setq purerl (cons (car nr) purerl)
+				   compl (cons (cons (muln (nreverse (cdr nr)) t)
+						     (muln (nreverse (cdr ni)) t))
+					       compl)))
+			    (t
+			     (setq nr (nreverse nr))
+			     (setq ni (nreverse ni))
+			     nil)))))
 	      (t (setq compl (cons sp compl)))))
       (risplit (car l))))))
 
@@ -366,8 +366,8 @@
   (cond ((= n 1) bas)
         (t (do ((rp (car bas))
 		(ip (cdr bas))
-		(c 1 (quotient (times c ex) i))
-		(ex n (f1- ex)) (i 1 (f1+ i))
+		(c 1 (quotient (* c ex) i))
+		(ex n (1- ex)) (i 1 (1+ i))
 		(rori t (not rori)) (negp negp* (cdr negp))
 		(rpt nil) (ipt nil))
 	       ((< ex 0) (cons (addn rpt t) (addn ipt t)))
@@ -377,7 +377,7 @@
 			 (cons (negate-if (car negp)
 					  (mul c
 					       (powers rp ex)
-					       (powers ip (f1- i))))
+					       (powers ip (1- i))))
 			       (cond (rori rpt) (t ipt))))))))
 
  
@@ -392,13 +392,13 @@
 		     (eq (caddr exp) '$%pi)
 		     (null (cdddr exp)))
 		(cond ((integerp (cadr exp)) ;5*%pi
-		       (mul (abs (remainder (cadr exp) 2)) '$%pi))
+		       (mul (abs (rem (cadr exp) 2)) '$%pi))
 					;Neither 0 nor 1 appears as a coef
 		      ((and (listp (cadr exp))
 			    (eq 'rat (caaadr exp))) ;5/2*%pi
 		       (mul (list* '(rat simp)
-				   (sub1 (remainder (add1 (cadadr exp))
-						    (times 2 (caddadr exp))))
+				   (1- (rem (1+ (cadadr exp))
+						    (* 2 (caddadr exp))))
 				   (cddadr exp))
 			    '$%pi))
 		      (t exp)))