maxima-commits — Git commit messages

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles-2 updated. branch-5_49-base-441-gb44a4e14c

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles-2 has been updated
       via  b44a4e14c437d7057201d59e50847e9cf8f6a9e4 (commit)
      from  422be532bfcf818d246db96774a0f9fd1bc0ca31 (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 b44a4e14c437d7057201d59e50847e9cf8f6a9e4
Author: Raymond Toy <toy...@gm...>
Date:   Thu Apr 23 22:13:31 2026 -0700

    Break circular dependency between grind and displa
    
    We break the dependency by moving all of the mgrind functions to a new
    file mgrind.lisp in the same module.  This means displa.lisp and
    grind.lisp are independent of each other and both depend on
    mgrind.lisp.

diff --git a/src/grind.lisp b/src/grind.lisp
index 452408e1d..54cd62208 100644
--- a/src/grind.lisp
+++ b/src/grind.lisp
@@ -58,31 +58,6 @@
     '$done))
 
 
-(defun mgrind (x out)
-  (setq chrps 0)
-  (mprint (msize x nil nil 'mparen 'mparen) out))
-
-(defun mprint (x out)
-  (cond ((characterp x)
-	 (incf chrps)
-	 (write-char x out))
-	((< (car x) (chrct*)) (mapc #'(lambda (l) (mprint l out)) (cdr x)))
-	(t (prog (i) (setq i chrps)
-		 (mprint (cadr x) out)
-		 (cond ((null (cddr x)) (return nil))
-		       ((and (or (atom (cadr x)) (< (caadr x) (chrct*)))
-			     (or (> (chrct*) (truncate $linel 2))
-				 (atom (caddr x)) (< (caaddr x) (chrct*))))
-			(setq i chrps)
-			(mprint (caddr x) out))
-		       (t (setq i (1+ i)) (setq chrps 0) (terpri out)
-			  (mtyotbsp i out) (mprint (caddr x) out)))
-		 (do ((l (cdddr x) (cdr l))) ((null l))
-		   (cond
-		     ((or (atom (car l)) (< (caar l) (chrct*))) nil)
-		     (t (setq chrps 0) (terpri out) (mtyotbsp i out)))
-		   (mprint (car l) out))))))
-
 (defun mtyotbsp (n out)
   (declare (fixnum n))
   (incf chrps n)
@@ -129,480 +104,17 @@
     (t (setq x  (cdr x))
        (do () ((null x) l) (setq l (string1 (car x) l) x (cdr x))))))
 
-(defun msize (x l r lop rop)
-  (setq x (nformat-check x))
-  (cond ((atom x) (msize-atom x l r))
-        ((and (atom (car x)) (setq x (cons '(mprogn) x)) nil))
-	((or (<= (lbp (caar x)) (rbp lop)) (>= (lbp rop) (rbp (caar x))))
-	 (msize-paren x l r))
-	((member 'array (cdar x) :test #'eq) (msize-array x l r))
-	((safe-get (caar x) 'grind)
-	 (the #-ecl (values t) #+ecl t (funcall (get (caar x) 'grind) x l r)))
-	(t (msize-function x l r nil))))
-
-(defun msize-atom (x l r)
-  (prog (y)
-     (cond ((numberp x) (setq y (exploden x)))
-           ((stringp x)
-            (setq y (coerce x 'list))
-            (do ((l y (cdr l))) ((null l))
-              (cond ((member (car l) '(#\" #\\ ) :test #'equal)
-                     (rplacd l (cons (car l) (cdr l)))
-                     (rplaca l #\\ )
-                     (setq l (cdr l)))))
-            (setq y (cons #\" (nconc y (list #\")))))
-           ((and (setq y (safe-get x 'reversealias))
-                 (not (and (member x $aliases :test #'eq) (get x 'noun))))
-            (setq y (exploden (stripdollar y))))
-           ((null (setq y (exploden x))))
-           ((safe-get x 'noun) (return (msize-atom (get x 'noun) l r)))
-           ((char= #\$ (car y)) (setq y (slash (cdr y))))
-           ((member (marray-type x) '(array hash-table $functional))
-            (return (msize-array-object x l r)))
-           (t (setq y (if $lispdisp (cons #\? (slash y)) (slash y)))))
-     (return (msz y l r))))
-
-(defun msz (x l r)
-  (setq x (nreconc l (nconc x r))) (cons (length x) x))
-
-(defun slash (x)
-  (cond ((null x) '())
-	(t
-	 (do ((l (cdr x) (cdr l))) ((null l))
-					; Following test is the same (except backslash is not included,
-					; so backslash is preceded by backslash) as in SCAN-TOKEN (src/nparse.lisp).
-	   (if (or (ascii-numberp (car l)) (alphabetp (car l)))
-	       nil
-	       (progn (rplacd l (cons (car l) (cdr l)))
-		      (rplaca l #\\) (setq l (cdr l)))))
-	 (if (alphabetp (car x)) x (cons #\\ x)))))
-
 ;;#-cl
 ;;(DEFUN ALPHANUMP (N) (DECLARE (FIXNUM N))
 ;;  (OR (ASCII-NUMBERP N) (ALPHABETP N)))
 
-(defun msize-paren (x l r)
-  (msize x (cons #\( l) (cons #\) r) 'mparen 'mparen))
-
-;; The variables LB and RB are not uses here syntactically, but for
-;; communication.  The FORTRAN program rebinds them to #/( and #/) since
-;; Fortran array references are printed with parens instead of brackets.
-
-(defvar *lb* #\[)
-(defvar *rb* #\])
-
-(defun msize-array (x l r &aux f)
-  (if (eq (caar x) 'mqapply) (setq f (cadr x) x (cdr x)) (setq f (caar x)))
-  (cond ((atom (car x)))
-	((and (symbolp (caar x)) (get (caar x) 'verb) (get (caar x) 'alias))
-	 (setq l (revappend '(#\' #\') l)))
-	((and (symbolp (caar x))
-	      (get (caar x) 'noun)
-	      (not (member (caar x) (cdr $aliases) :test #'eq))
-	      (not (get (caar x) 'reversealias)))
-	 (setq l (cons #\' l))))
-  (setq l (msize f l (list *lb*) lop 'mfunction)
-	r (msize-list (cdr x) nil (cons *rb* r)))
-  (cons (+ (car l) (car r)) (cons l (cdr r))))
-
-(defun msize-function (x l r op)
-  (cond ((not (symbolp (caar x))))
-	((and (get (caar x) 'verb) (get (caar x) 'alias))
-	 (setq l (revappend '(#\' #\') l)))
-	((and (get (caar x) 'noun) (not (member (caar x) (cdr $aliases) :test #'eq))
-	      (not (get (caar x) 'reversealias)))
-	 (setq l (cons #\' l))))
-  (setq l (msize (if op (getop (caar x)) (caar x)) l (ncons #\( ) 'mparen 'mparen)
-	r (msize-list (cdr x) nil (cons #\) r)))
-  (cons (+ (car l) (car r)) (cons l (cdr r))))
-
-(defun msize-list (x l r)
-  (if (null x) (msz nil l r)
-      (do ((nl) (w 0))
-	  ((null (cdr x))
-	   (setq nl (cons (msize (car x) l r 'mparen 'mparen) nl))
-	   (cons (+ w (caar nl)) (nreverse nl)))
-	(declare (fixnum w))
-	(setq nl (cons (msize (car x) l (list #\,) 'mparen 'mparen) nl)
-	      w (+ w (caar nl)) x (cdr x) l nil))))
-
-(defun msize-prefix (x l r)
-  (msize (cadr x) (revappend (strsym (caar x)) l) r (caar x) rop))
-
-(defun msize-infix (x l r)
-  (if (not (= (length (cdr x)) 2))
-    (return-from msize-infix (msize-function x l r t)))
-  (setq l (msize (cadr x) l nil lop (caar x))
-	r (msize (caddr x) (reverse (strsym (caar x))) r (caar x) rop))
-  (list (+ (car l) (car r)) l r))
-
-(defun msize-postfix (x l r)
-  (msize (cadr x) l (append (strsym (caar x)) r) lop (caar x)))
-
-(defun msize-nary (x l r) (msznary x l r (strsym (caar x))))
-
-(defun msize-nofix (x l r) (msize (caar x) l r (caar x) rop))
-
-(defun msize-matchfix (x l r)
-  (setq l (nreconc l (car (strsym (caar x))))
-	l (cons (length l) l)
-	r (append (cdr (strsym (caar x))) r)
-	x (msize-list (cdr x) nil r))
-  (cons (+ (car l) (car x)) (cons l (cdr x))))
-
-(defun msznary (x l r dissym)
-  (cond ((null (cddr x)) (msize-function x l r t))
-	(t (setq l (msize (cadr x) l nil lop (caar x)))
-	   (do ((ol (cddr x) (cdr ol)) (nl (list l)) (w (car l)))
-	       ((null (cdr ol))
-		(setq r (msize (car ol) (reverse dissym) r (caar x) rop))
-		(cons (+ (car r) w) (nreverse (cons r nl))))
-	     (declare (fixnum w))
-	     (setq nl (cons (msize (car ol) (reverse dissym) nil (caar x) (caar x))
-			    nl)
-		   w (+ (caar nl) w))))))
-
-(defun strsym (x) (or (get x 'strsym) (get x 'dissym)))
-
-(defprop bigfloat msz-bigfloat grind)
-
-(defun msz-bigfloat (x l r)
-  (msz (mapcar #'get-first-char (fpformat x)) l r))
-
-(defprop mprogn msize-matchfix grind)
-(defprop mprogn ((#\( ) #\) ) strsym)
-
-(defprop mlist msize-matchfix grind)
-(setf (get '%mlist 'grind) (get 'mlist 'grind))
-
-;;; ----------------------------------------------------------------------------
-
-;; Formatting a mlabel-expression
-
-(defprop mlabel msize-mlabel grind)
-
-(defun msize-mlabel (x l r)
-  (if *display-labels-p*
-      (setq l (cons (msize (cadr x) (list #\( ) (list #\) #\ ) nil nil) l)))
-  (msize (caddr x) l r lop rop))
-
 ;;; ----------------------------------------------------------------------------
 
-;; Formatting a mtext-expression
-
-(defprop mtext msize-mtext grind)
-
-(defun msize-mtext (x l r)
-  (setq x (cdr x))
-  (if (null x)
-      (msz nil l r)
-      (do ((nl) (w 0))
-          ((null (cdr x))
-           (setq nl (cons (if (stringp (car x))
-                              (msz (makestring (car x)) l r)
-                              (msize (car x) l r lop rop))
-                          nl))
-           (cons (+ w (caar nl)) (nreverse nl)))
-        (setq nl (cons (if (stringp (car x))
-                           (msz (makestring (car x)) l r)
-                           (msize (car x) l r lop rop))
-                       nl)
-              w (+ w (caar nl))
-              x (cdr x)
-              l nil))))
-
-(defprop mqapply msz-mqapply grind)
-
-(defun msz-mqapply (x l r)
-  (setq l (msize (cadr x) l (list #\( ) lop 'mfunction)
-	r (msize-list (cddr x) nil (cons #\) r)))
-  (cons (+ (car l) (car r)) (cons l (cdr r))))
-
-; SPACEOUT appears solely in trace output. See mtrace.lisp.
-
-(defprop spaceout msize-spaceout grind)
-
-(defun msize-spaceout (x ll r)
-  (declare (ignore ll r))
-  (let ((n (cadr x))
-	l)
-    (dotimes (i n)
-      (push #\space l))
-    (cons n l)))
-
-(defprop mquote msize-prefix grind)
-
-(defprop msetq msize-infix grind)
-(defprop msetq (#\:) strsym)
-(defprop msetq 180. lbp)
-(defprop msetq 20. rbp)
-
-(defprop mset msize-infix grind)
-(defprop mset (#\: #\:) strsym)
-(defprop mset 180. lbp)
-(defprop mset 20. rbp)
-
 ;;; ----------------------------------------------------------------------------
 
 ;; Formatting a mdefine or mdefmacro expression
 
-(defprop mdefine msz-mdef grind)
-(defprop mdefine (#\: #\=) strsym)
-(defprop mdefine 180 lbp)
-(defprop mdefine  20 rbp)
-
-;; copy binding powers to nounified operator
-(setf (get '%mdefine 'lbp) (get 'mdefine 'lbp))
-(setf (get '%mdefine 'rbp) (get 'mdefine 'rbp))
-
-(defprop mdefmacro msz-mdef grind)
-(defprop mdefmacro (#\: #\: #\=) strsym)
-(defprop mdefmacro 180 lbp)
-(defprop mdefmacro  20 rbp)
-
-;; copy binding powers to nounified operator
-(setf (get '%mdefmacro 'lbp) (get 'mdefmacro 'lbp))
-(setf (get '%mdefmacro 'rbp) (get 'mdefmacro 'rbp))
-
-(defun msz-mdef (x l r)
-  (setq l (msize (cadr x) l (copy-list (strsym (caar x))) lop (caar x))
-        r (msize (caddr x) nil r (caar x) rop))
-  (cond ((not (atom (cadr l)))
-         ;; An expression like g(x):=x:
-         ;;   left side  l = (6 (2 #\g #\( ) (4 #\x #\) #\: #\= ))
-         ;;   right side r = (1 #\x )
-         ;; the result is (7 (2 #\g #\( ) (4 #\x #\) #\: #\= ) (1 #\x ))
-         (setq x (cons (- (car l) (caadr l)) (cddr l)))
-         (if (and (not (atom (cadr r)))
-                  (not (atom (caddr r)))
-                  (< (+ (car l) (caadr r) (caaddr r)) $linel))
-             (setq x (nconc x (list (cadr r) (caddr r)))
-                   r (cons (car r) (cdddr r))))
-         (cons (+ (car l) (car r)) (cons (cadr l) (cons x (cdr r)))))
-        (t
-         ;; An expression like x f :=x or f x:=x, where f is a postfix or a
-         ;; prefix operator. Example for a postfix operator:
-         ;;   left side  l = (5 #\x #\space #\f #\: #\= )
-         ;;   right side r = (1 #\x)
-         ;; the result is (6 (5 #\x #\space #\f #\: #\=) (1 #\x))
-         (cons (+ (car l) (car r)) (cons l (ncons r))))))
-
-(defprop mfactorial msize-postfix grind)
-(defprop mfactorial 160. lbp)
-(defprop mfactorial 159. rbp)
-
-(defprop mexpt msz-mexpt grind)
-(defprop mexpt 140. lbp)
-(defprop mexpt 139. rbp)
-
-(defun msz-mexpt (x l r)
-  (setq l (msize (cadr x) l nil lop 'mexpt)
-	r (if (mmminusp (setq x (nformat-check (caddr x))))
-	      (msize (cadr x) (reverse '(#\^ #\-)) r 'mexpt rop)
-	      (msize x (list #\^) r 'mexpt rop)))
-  (list (+ (car l) (car r)) l r))
-
-
-(defprop mncexpt msize-infix grind)
-(defprop mncexpt 140. lbp)
-(defprop mncexpt 139. rbp)
-
-(defprop mnctimes msize-nary grind)
-(defprop mnctimes 130. lbp)
-(defprop mnctimes 129. rbp)
-
-(defprop mtimes msz-mtimes grind)
-(defprop mtimes 120. lbp)
-(defprop mtimes 120. rbp)
-
-(defun msz-mtimes (x l r) (msznary x l r '(#\*)))
-
-
-(defprop mquotient msize-infix grind)
-(defprop mquotient 120. lbp)
-(defprop mquotient 120. rbp)
-(defprop rat msize-infix grind)
-(defprop rat 120. lbp)
-(defprop rat 120. rbp)
-
-(defprop mplus msz-mplus grind)
-(defprop mplus 100. lbp)
-(defprop mplus 100. rbp)
-
-(defun msz-mplus (x l r)
-  (cond ((null (cddr x))
-	 (if (null (cdr x))
-	     (msize-function x l r t)
-	     (msize (cadr x) (append (ncons #\+) l) r 'mplus rop)))
-	(t (setq l (msize (cadr x) l nil lop 'mplus) x (cddr x))
-	   (do ((nl (list l)) (w (car l)) (dissym))
-	       ((null (cdr x))
-		(if (mmminusp (car x)) (setq l (cadar x) dissym (list #\-))
-		    (setq l (car x) dissym (list #\+)))
-		(setq r (msize l dissym r 'mplus rop))
-		(cons (+ (car r) w) (nreverse (cons r nl))))
-	     (declare (fixnum w))
-	     (if (mmminusp (car x)) (setq l (cadar x) dissym (list #\-))
-		 (setq l (car x) dissym (list #\+)))
-	     (setq nl (cons (msize l dissym nil 'mplus 'mplus) nl)
-		   w (+ (caar nl) w)
-		   x (cdr x))))))
-
-(defprop mminus msize-mminus grind)
-(defprop mminus (#\-) strsym)
-(defprop mminus 134. rbp)
-(defprop mminus 100. lbp)
-
-(defun msize-mminus (x l r)
-  (cond ((null (cddr x))
-         (if (null (cdr x))
-             (msize-function x l r t)
-             (msize (cadr x) (append (ncons #\- ) l) r 'mminus rop)))
-        (t
-         (setq l (msize (cadr x) l nil lop 'mminus)
-               x (cddr x))
-         (do ((nl (list l))
-              (w (car l))
-              (dissym))
-             ((null (cdr x))
-              (if (mmminusp (car x))
-                  (setq l (cadar x) dissym (list #\+ ))
-                  (setq l (car x) dissym (list #\- )))
-              (setq r (msize l dissym r 'mminus rop))
-              (cons (+ (car r) w) (nreverse (cons r nl))))
-           (declare (fixnum w))
-           (if (mmminusp (car x))
-               (setq l (cadar x) dissym (list #\+ ))
-               (setq l (car x) dissym (list #\- )))
-           (setq nl (cons (msize l dissym nil 'mminus 'mminus) nl)
-                 w (+ (caar nl) w)
-                 x (cdr x))))))
-
-(defprop mequal msize-infix grind)
-(defprop mequal 80. lbp)
-(defprop mequal 80. rbp)
-
-(defprop mnotequal msize-infix grind)
-(defprop mnotequal 80. lbp)
-(defprop mnotequal 80. rbp)
-
-(defprop mgreaterp msize-infix grind)
-(defprop mgreaterp 80. lbp)
-(defprop mgreaterp 80. rbp)
-
-(defprop mgeqp msize-infix grind)
-(defprop mgeqp 80. lbp)
-(defprop mgeqp 80. rbp)
-
-(defprop mlessp msize-infix grind)
-(defprop mlessp 80. lbp)
-(defprop mlessp 80. rbp)
-
-(defprop mleqp msize-infix grind)
-(defprop mleqp 80. lbp)
-(defprop mleqp 80. rbp)
-
-(defprop mnot msize-prefix grind)
-(defprop mnot 70. rbp)
-
-(defprop mand msize-nary grind)
-(defprop mand 65. lbp)
-(defprop mand 65. rbp)
-
-(defprop mor msize-nary grind)
-(defprop mor 60. lbp)
-(defprop mor 60. rbp)
-
-(defprop mcond msz-mcond grind)
-(defprop mcond 45. lbp)
-(defprop mcond 45. rbp)
-
-(defprop %mcond msz-mcond grind)
-(defprop %mcond 45. lbp)
-(defprop %mcond 45. rbp)
-
-;; See comments above DIM-MCOND in displa.lisp concerning MCOND parsing and formatting.
-
-(defun msz-mcond (x l r)
-  (let ((if (nreconc l '(#\i #\f #\space))))
-    (setq if (cons (length if) if)
-	  l (msize (cadr x) nil nil 'mcond 'mparen))
-
-
-    (let ((args (cdddr x))
-	  (else-literal (reverse (exploden " else ")))
-	  (elseif-literal (reverse (exploden " elseif ")))
-	  (then-literal (reverse (exploden " then ")))
-	  (parts)
-	  (part))
-
-      (let ((sgra (reverse args)))
-	(if (and (or (eq (car sgra) nil) (eq (car sgra) '$false)) (eq (cadr sgra) t))
-	    (setq args (reverse (cddr sgra)))))
-
-      (setq parts (list if l))
-
-      (setq part (cond ((= (length args) 0)
-			`(,(msize (caddr x) (copy-tree then-literal) r 'mcond rop)))
-		       (t
-			`(,(msize (caddr x) (copy-tree then-literal) nil 'mcond 'mparen))))
-
-	    parts (append parts part))
-
-      (loop while (>= (length args) 2) do
-	   (let ((maybe-elseif (car args)) (else-or-then (cadr args)))
-	     (cond
-	       ((= (length args) 2)
-		(cond
-		  ((eq maybe-elseif t)
-		   (let ((else-arg else-or-then))
-		     (setq
-		      part `(,(msize else-arg (copy-tree else-literal) r 'mcond rop))
-		      parts (append parts part))))
-		  (t
-		   (let ((elseif-arg maybe-elseif) (then-arg else-or-then))
-		     (setq
-		      part `(,(msize elseif-arg (copy-tree elseif-literal) nil 'mcond 'mparen)
-			      ,(msize then-arg (copy-tree then-literal) r 'mcond rop))
-		      parts (append parts part))))))
-	       (t
-		(let ((elseif-arg maybe-elseif) (then-arg else-or-then))
-		  (setq
-		   part `(,(msize elseif-arg (copy-tree elseif-literal) nil 'mcond 'mparen)
-			   ,(msize then-arg (copy-tree then-literal) nil 'mcond 'mparen))
-		   parts (append parts part))))))
-
-	   (setq args (cddr args)))
-
-      (cons (apply '\+ (mapcar #'car parts)) parts))))
-
-(defprop text-string msize-text-string grind)
-
-(defun msize-text-string (x ll r)
-  (declare (ignore ll r))
-  (cons (length (cdr x)) (cdr x)))
-
-(defprop mdo msz-mdo grind)
-(defprop mdo 25. lbp)
-(defprop mdo 25. rbp)
-
-(defprop mdoin msz-mdoin grind)
-(defprop mdoin 30. lbp)
-(defprop mdoin 30. rbp)
-
-(defprop %mdo msz-mdo grind)
-(defprop %mdo 25. lbp)
-(defprop %mdo 25. rbp)
-
-(defprop %mdoin msz-mdoin grind)
-(defprop %mdoin 30. lbp)
-(defprop %mdoin 30. rbp)
-
-(defun msz-mdo (x l r)
-  (msznary (cons '(mdo) (strmdo x)) l r '(#\space)))
 
-(defun msz-mdoin (x l r)
-  (msznary (cons '(mdo) (strmdoin x)) l r '(#\space)))
 
 (defun strmdo (x)
   (nconc (cond ((second x) `($for ,(second x))))
diff --git a/src/maxima.system b/src/maxima.system
index 221a432e2..529aa214d 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -730,8 +730,12 @@
                                    "fundamental-macros" "prerequisites"
                                    "simp-utilities")
 	    :components
-	    ((:file "displa")
-	     (:file "grind")))
+	    ((:file "mgrind") ; grinding/sizing utilities
+             ;; displa and grind are now independent.
+             (:file "displa"            ; 2D display
+                    :depends-on ("mgrind"))
+	     (:file "grind"             ; Linear display
+                    :depends-on ("mgrind"))))
    (:module gcd :source-pathname ""
 	    :depends-on ("globals" "defmfun" "declarations" "destructuring-let"
                                    "fundamental-macros" "prerequisites" 
diff --git a/src/mgrind.lisp b/src/mgrind.lisp
new file mode 100644
index 000000000..d43908656
--- /dev/null
+++ b/src/mgrind.lisp
@@ -0,0 +1,505 @@
+;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+;;;
+;;; This file is part of the Maxima computer algebra system
+;;; (https://sourceforge.net/projects/maxima/)
+;;;
+;;; Maxima is copyrighted by its authors and licensed under the GNU
+;;; General Public License.  See COPYING and AUTHORS for details.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package :maxima)
+
+(defun mgrind (x out)
+  (setq chrps 0)
+  (mprint (msize x nil nil 'mparen 'mparen) out))
+
+(defun mprint (x out)
+  (cond ((characterp x)
+	 (incf chrps)
+	 (write-char x out))
+	((< (car x) (chrct*)) (mapc #'(lambda (l) (mprint l out)) (cdr x)))
+	(t (prog (i) (setq i chrps)
+		 (mprint (cadr x) out)
+		 (cond ((null (cddr x)) (return nil))
+		       ((and (or (atom (cadr x)) (< (caadr x) (chrct*)))
+			     (or (> (chrct*) (truncate $linel 2))
+				 (atom (caddr x)) (< (caaddr x) (chrct*))))
+			(setq i chrps)
+			(mprint (caddr x) out))
+		       (t (setq i (1+ i)) (setq chrps 0) (terpri out)
+			  (mtyotbsp i out) (mprint (caddr x) out)))
+		 (do ((l (cdddr x) (cdr l))) ((null l))
+		   (cond
+		     ((or (atom (car l)) (< (caar l) (chrct*))) nil)
+		     (t (setq chrps 0) (terpri out) (mtyotbsp i out)))
+		   (mprint (car l) out))))))
+
+(defun msize (x l r lop rop)
+  (setq x (nformat-check x))
+  (cond ((atom x) (msize-atom x l r))
+        ((and (atom (car x)) (setq x (cons '(mprogn) x)) nil))
+	((or (<= (lbp (caar x)) (rbp lop)) (>= (lbp rop) (rbp (caar x))))
+	 (msize-paren x l r))
+	((member 'array (cdar x) :test #'eq) (msize-array x l r))
+	((safe-get (caar x) 'grind)
+	 (the #-ecl (values t) #+ecl t (funcall (get (caar x) 'grind) x l r)))
+	(t (msize-function x l r nil))))
+
+(defun msize-atom (x l r)
+  (prog (y)
+     (cond ((numberp x) (setq y (exploden x)))
+           ((stringp x)
+            (setq y (coerce x 'list))
+            (do ((l y (cdr l))) ((null l))
+              (cond ((member (car l) '(#\" #\\ ) :test #'equal)
+                     (rplacd l (cons (car l) (cdr l)))
+                     (rplaca l #\\ )
+                     (setq l (cdr l)))))
+            (setq y (cons #\" (nconc y (list #\")))))
+           ((and (setq y (safe-get x 'reversealias))
+                 (not (and (member x $aliases :test #'eq) (get x 'noun))))
+            (setq y (exploden (stripdollar y))))
+           ((null (setq y (exploden x))))
+           ((safe-get x 'noun) (return (msize-atom (get x 'noun) l r)))
+           ((char= #\$ (car y)) (setq y (slash (cdr y))))
+           ((member (marray-type x) '(array hash-table $functional))
+            (return (msize-array-object x l r)))
+           (t (setq y (if $lispdisp (cons #\? (slash y)) (slash y)))))
+     (return (msz y l r))))
+
+(defun msize-paren (x l r)
+  (msize x (cons #\( l) (cons #\) r) 'mparen 'mparen))
+
+;; The variables LB and RB are not uses here syntactically, but for
+;; communication.  The FORTRAN program rebinds them to #/( and #/) since
+;; Fortran array references are printed with parens instead of brackets.
+
+(defvar *lb* #\[)
+(defvar *rb* #\])
+
+(defun msize-array (x l r &aux f)
+  (if (eq (caar x) 'mqapply) (setq f (cadr x) x (cdr x)) (setq f (caar x)))
+  (cond ((atom (car x)))
+	((and (symbolp (caar x)) (get (caar x) 'verb) (get (caar x) 'alias))
+	 (setq l (revappend '(#\' #\') l)))
+	((and (symbolp (caar x))
+	      (get (caar x) 'noun)
+	      (not (member (caar x) (cdr $aliases) :test #'eq))
+	      (not (get (caar x) 'reversealias)))
+	 (setq l (cons #\' l))))
+  (setq l (msize f l (list *lb*) lop 'mfunction)
+	r (msize-list (cdr x) nil (cons *rb* r)))
+  (cons (+ (car l) (car r)) (cons l (cdr r))))
+
+(defun msize-function (x l r op)
+  (cond ((not (symbolp (caar x))))
+	((and (get (caar x) 'verb) (get (caar x) 'alias))
+	 (setq l (revappend '(#\' #\') l)))
+	((and (get (caar x) 'noun) (not (member (caar x) (cdr $aliases) :test #'eq))
+	      (not (get (caar x) 'reversealias)))
+	 (setq l (cons #\' l))))
+  (setq l (msize (if op (getop (caar x)) (caar x)) l (ncons #\( ) 'mparen 'mparen)
+	r (msize-list (cdr x) nil (cons #\) r)))
+  (cons (+ (car l) (car r)) (cons l (cdr r))))
+
+(defun msize-list (x l r)
+  (if (null x) (msz nil l r)
+      (do ((nl) (w 0))
+	  ((null (cdr x))
+	   (setq nl (cons (msize (car x) l r 'mparen 'mparen) nl))
+	   (cons (+ w (caar nl)) (nreverse nl)))
+	(declare (fixnum w))
+	(setq nl (cons (msize (car x) l (list #\,) 'mparen 'mparen) nl)
+	      w (+ w (caar nl)) x (cdr x) l nil))))
+
+(defprop mquote msize-prefix grind)
+
+(defprop mnot msize-prefix grind)
+(defprop mnot 70. rbp)
+
+(defun msize-prefix (x l r)
+  (msize (cadr x) (revappend (strsym (caar x)) l) r (caar x) rop))
+
+(defprop msetq msize-infix grind)
+(defprop msetq (#\:) strsym)
+(defprop msetq 180. lbp)
+(defprop msetq 20. rbp)
+
+(defprop mset msize-infix grind)
+(defprop mset (#\: #\:) strsym)
+(defprop mset 180. lbp)
+(defprop mset 20. rbp)
+
+
+(defprop mncexpt msize-infix grind)
+(defprop mncexpt 140. lbp)
+(defprop mncexpt 139. rbp)
+
+(defprop mquotient msize-infix grind)
+(defprop mquotient 120. lbp)
+(defprop mquotient 120. rbp)
+(defprop rat msize-infix grind)
+(defprop rat 120. lbp)
+(defprop rat 120. rbp)
+
+(defprop mequal msize-infix grind)
+(defprop mequal 80. lbp)
+(defprop mequal 80. rbp)
+
+(defprop mnotequal msize-infix grind)
+(defprop mnotequal 80. lbp)
+(defprop mnotequal 80. rbp)
+
+(defprop mgreaterp msize-infix grind)
+(defprop mgreaterp 80. lbp)
+(defprop mgreaterp 80. rbp)
+
+(defprop mgeqp msize-infix grind)
+(defprop mgeqp 80. lbp)
+(defprop mgeqp 80. rbp)
+
+(defprop mlessp msize-infix grind)
+(defprop mlessp 80. lbp)
+(defprop mlessp 80. rbp)
+
+(defprop mleqp msize-infix grind)
+(defprop mleqp 80. lbp)
+(defprop mleqp 80. rbp)
+
+(defun msize-infix (x l r)
+  (if (not (= (length (cdr x)) 2))
+    (return-from msize-infix (msize-function x l r t)))
+  (setq l (msize (cadr x) l nil lop (caar x))
+	r (msize (caddr x) (reverse (strsym (caar x))) r (caar x) rop))
+  (list (+ (car l) (car r)) l r))
+
+(defprop mfactorial msize-postfix grind)
+(defprop mfactorial 160. lbp)
+(defprop mfactorial 159. rbp)
+
+(defun msize-postfix (x l r)
+  (msize (cadr x) l (append (strsym (caar x)) r) lop (caar x)))
+
+(defprop mnctimes msize-nary grind)
+(defprop mnctimes 130. lbp)
+(defprop mnctimes 129. rbp)
+
+(defprop mand msize-nary grind)
+(defprop mand 65. lbp)
+(defprop mand 65. rbp)
+
+(defprop mor msize-nary grind)
+(defprop mor 60. lbp)
+(defprop mor 60. rbp)
+
+(defun msize-nary (x l r) (msznary x l r (strsym (caar x))))
+
+(defun msize-nofix (x l r) (msize (caar x) l r (caar x) rop))
+
+
+(defprop mprogn msize-matchfix grind)
+(defprop mprogn ((#\( ) #\) ) strsym)
+
+(defprop mlist msize-matchfix grind)
+(setf (get '%mlist 'grind) (get 'mlist 'grind))
+
+
+(defun msize-matchfix (x l r)
+  (setq l (nreconc l (car (strsym (caar x))))
+	l (cons (length l) l)
+	r (append (cdr (strsym (caar x))) r)
+	x (msize-list (cdr x) nil r))
+  (cons (+ (car l) (car x)) (cons l (cdr x))))
+
+;; Formatting a mlabel-expression
+
+(defprop mlabel msize-mlabel grind)
+
+(defun msize-mlabel (x l r)
+  (if *display-labels-p*
+      (setq l (cons (msize (cadr x) (list #\( ) (list #\) #\ ) nil nil) l)))
+  (msize (caddr x) l r lop rop))
+
+;; Formatting a mtext-expression
+
+(defprop mtext msize-mtext grind)
+
+(defun msize-mtext (x l r)
+  (setq x (cdr x))
+  (if (null x)
+      (msz nil l r)
+      (do ((nl) (w 0))
+          ((null (cdr x))
+           (setq nl (cons (if (stringp (car x))
+                              (msz (makestring (car x)) l r)
+                              (msize (car x) l r lop rop))
+                          nl))
+           (cons (+ w (caar nl)) (nreverse nl)))
+        (setq nl (cons (if (stringp (car x))
+                           (msz (makestring (car x)) l r)
+                           (msize (car x) l r lop rop))
+                       nl)
+              w (+ w (caar nl))
+              x (cdr x)
+              l nil))))
+
+
+; SPACEOUT appears solely in trace output. See mtrace.lisp.
+
+(defprop spaceout msize-spaceout grind)
+
+(defun msize-spaceout (x ll r)
+  (declare (ignore ll r))
+  (let ((n (cadr x))
+	l)
+    (dotimes (i n)
+      (push #\space l))
+    (cons n l)))
+
+(defprop mminus msize-mminus grind)
+(defprop mminus (#\-) strsym)
+(defprop mminus 134. rbp)
+(defprop mminus 100. lbp)
+
+(defun msize-mminus (x l r)
+  (cond ((null (cddr x))
+         (if (null (cdr x))
+             (msize-function x l r t)
+             (msize (cadr x) (append (ncons #\- ) l) r 'mminus rop)))
+        (t
+         (setq l (msize (cadr x) l nil lop 'mminus)
+               x (cddr x))
+         (do ((nl (list l))
+              (w (car l))
+              (dissym))
+             ((null (cdr x))
+              (if (mmminusp (car x))
+                  (setq l (cadar x) dissym (list #\+ ))
+                  (setq l (car x) dissym (list #\- )))
+              (setq r (msize l dissym r 'mminus rop))
+              (cons (+ (car r) w) (nreverse (cons r nl))))
+           (declare (fixnum w))
+           (if (mmminusp (car x))
+               (setq l (cadar x) dissym (list #\+ ))
+               (setq l (car x) dissym (list #\- )))
+           (setq nl (cons (msize l dissym nil 'mminus 'mminus) nl)
+                 w (+ (caar nl) w)
+                 x (cdr x))))))
+
+(defprop text-string msize-text-string grind)
+
+(defun msize-text-string (x ll r)
+  (declare (ignore ll r))
+  (cons (length (cdr x)) (cdr x)))
+
+;;; msz
+(defun msz (x l r)
+  (setq x (nreconc l (nconc x r))) (cons (length x) x))
+
+(defun msznary (x l r dissym)
+  (cond ((null (cddr x)) (msize-function x l r t))
+	(t (setq l (msize (cadr x) l nil lop (caar x)))
+	   (do ((ol (cddr x) (cdr ol)) (nl (list l)) (w (car l)))
+	       ((null (cdr ol))
+		(setq r (msize (car ol) (reverse dissym) r (caar x) rop))
+		(cons (+ (car r) w) (nreverse (cons r nl))))
+	     (declare (fixnum w))
+	     (setq nl (cons (msize (car ol) (reverse dissym) nil (caar x) (caar x))
+			    nl)
+		   w (+ (caar nl) w))))))
+
+(defprop bigfloat msz-bigfloat grind)
+
+(defun msz-bigfloat (x l r)
+  (msz (mapcar #'get-first-char (fpformat x)) l r))
+
+;;; ----------------------------------------------------------------------------
+
+(defprop mqapply msz-mqapply grind)
+
+(defun msz-mqapply (x l r)
+  (setq l (msize (cadr x) l (list #\( ) lop 'mfunction)
+	r (msize-list (cddr x) nil (cons #\) r)))
+  (cons (+ (car l) (car r)) (cons l (cdr r))))
+
+(defprop mdefine msz-mdef grind)
+(defprop mdefine (#\: #\=) strsym)
+(defprop mdefine 180 lbp)
+(defprop mdefine  20 rbp)
+
+;; copy binding powers to nounified operator
+(setf (get '%mdefine 'lbp) (get 'mdefine 'lbp))
+(setf (get '%mdefine 'rbp) (get 'mdefine 'rbp))
+
+(defprop mdefmacro msz-mdef grind)
+(defprop mdefmacro (#\: #\: #\=) strsym)
+(defprop mdefmacro 180 lbp)
+(defprop mdefmacro  20 rbp)
+
+;; copy binding powers to nounified operator
+(setf (get '%mdefmacro 'lbp) (get 'mdefmacro 'lbp))
+(setf (get '%mdefmacro 'rbp) (get 'mdefmacro 'rbp))
+
+(defun msz-mdef (x l r)
+  (setq l (msize (cadr x) l (copy-list (strsym (caar x))) lop (caar x))
+        r (msize (caddr x) nil r (caar x) rop))
+  (cond ((not (atom (cadr l)))
+         ;; An expression like g(x):=x:
+         ;;   left side  l = (6 (2 #\g #\( ) (4 #\x #\) #\: #\= ))
+         ;;   right side r = (1 #\x )
+         ;; the result is (7 (2 #\g #\( ) (4 #\x #\) #\: #\= ) (1 #\x ))
+         (setq x (cons (- (car l) (caadr l)) (cddr l)))
+         (if (and (not (atom (cadr r)))
+                  (not (atom (caddr r)))
+                  (< (+ (car l) (caadr r) (caaddr r)) $linel))
+             (setq x (nconc x (list (cadr r) (caddr r)))
+                   r (cons (car r) (cdddr r))))
+         (cons (+ (car l) (car r)) (cons (cadr l) (cons x (cdr r)))))
+        (t
+         ;; An expression like x f :=x or f x:=x, where f is a postfix or a
+         ;; prefix operator. Example for a postfix operator:
+         ;;   left side  l = (5 #\x #\space #\f #\: #\= )
+         ;;   right side r = (1 #\x)
+         ;; the result is (6 (5 #\x #\space #\f #\: #\=) (1 #\x))
+         (cons (+ (car l) (car r)) (cons l (ncons r))))))
+
+
+(defprop mexpt msz-mexpt grind)
+(defprop mexpt 140. lbp)
+(defprop mexpt 139. rbp)
+
+(defun msz-mexpt (x l r)
+  (setq l (msize (cadr x) l nil lop 'mexpt)
+	r (if (mmminusp (setq x (nformat-check (caddr x))))
+	      (msize (cadr x) (reverse '(#\^ #\-)) r 'mexpt rop)
+	      (msize x (list #\^) r 'mexpt rop)))
+  (list (+ (car l) (car r)) l r))
+
+(defprop mtimes msz-mtimes grind)
+(defprop mtimes 120. lbp)
+(defprop mtimes 120. rbp)
+
+(defun msz-mtimes (x l r) (msznary x l r '(#\*)))
+
+(defprop mplus msz-mplus grind)
+(defprop mplus 100. lbp)
+(defprop mplus 100. rbp)
+
+(defun msz-mplus (x l r)
+  (cond ((null (cddr x))
+	 (if (null (cdr x))
+	     (msize-function x l r t)
+	     (msize (cadr x) (append (ncons #\+) l) r 'mplus rop)))
+	(t (setq l (msize (cadr x) l nil lop 'mplus) x (cddr x))
+	   (do ((nl (list l)) (w (car l)) (dissym))
+	       ((null (cdr x))
+		(if (mmminusp (car x)) (setq l (cadar x) dissym (list #\-))
+		    (setq l (car x) dissym (list #\+)))
+		(setq r (msize l dissym r 'mplus rop))
+		(cons (+ (car r) w) (nreverse (cons r nl))))
+	     (declare (fixnum w))
+	     (if (mmminusp (car x)) (setq l (cadar x) dissym (list #\-))
+		 (setq l (car x) dissym (list #\+)))
+	     (setq nl (cons (msize l dissym nil 'mplus 'mplus) nl)
+		   w (+ (caar nl) w)
+		   x (cdr x))))))
+
+(defprop mcond msz-mcond grind)
+(defprop mcond 45. lbp)
+(defprop mcond 45. rbp)
+
+(defprop %mcond msz-mcond grind)
+(defprop %mcond 45. lbp)
+(defprop %mcond 45. rbp)
+
+;; See comments above DIM-MCOND in displa.lisp concerning MCOND parsing and formatting.
+
+(defun msz-mcond (x l r)
+  (let ((if (nreconc l '(#\i #\f #\space))))
+    (setq if (cons (length if) if)
+	  l (msize (cadr x) nil nil 'mcond 'mparen))
+
+
+    (let ((args (cdddr x))
+	  (else-literal (reverse (exploden " else ")))
+	  (elseif-literal (reverse (exploden " elseif ")))
+	  (then-literal (reverse (exploden " then ")))
+	  (parts)
+	  (part))
+
+      (let ((sgra (reverse args)))
+	(if (and (or (eq (car sgra) nil) (eq (car sgra) '$false)) (eq (cadr sgra) t))
+	    (setq args (reverse (cddr sgra)))))
+
+      (setq parts (list if l))
+
+      (setq part (cond ((= (length args) 0)
+			`(,(msize (caddr x) (copy-tree then-literal) r 'mcond rop)))
+		       (t
+			`(,(msize (caddr x) (copy-tree then-literal) nil 'mcond 'mparen))))
+
+	    parts (append parts part))
+
+      (loop while (>= (length args) 2) do
+	   (let ((maybe-elseif (car args)) (else-or-then (cadr args)))
+	     (cond
+	       ((= (length args) 2)
+		(cond
+		  ((eq maybe-elseif t)
+		   (let ((else-arg else-or-then))
+		     (setq
+		      part `(,(msize else-arg (copy-tree else-literal) r 'mcond rop))
+		      parts (append parts part))))
+		  (t
+		   (let ((elseif-arg maybe-elseif) (then-arg else-or-then))
+		     (setq
+		      part `(,(msize elseif-arg (copy-tree elseif-literal) nil 'mcond 'mparen)
+			      ,(msize then-arg (copy-tree then-literal) r 'mcond rop))
+		      parts (append parts part))))))
+	       (t
+		(let ((elseif-arg maybe-elseif) (then-arg else-or-then))
+		  (setq
+		   part `(,(msize elseif-arg (copy-tree elseif-literal) nil 'mcond 'mparen)
+			   ,(msize then-arg (copy-tree then-literal) nil 'mcond 'mparen))
+		   parts (append parts part))))))
+
+	   (setq args (cddr args)))
+
+      (cons (apply '\+ (mapcar #'car parts)) parts))))
+
+(defprop mdo msz-mdo grind)
+(defprop mdo 25. lbp)
+(defprop mdo 25. rbp)
+
+(defprop %mdo msz-mdo grind)
+(defprop %mdo 25. lbp)
+(defprop %mdo 25. rbp)
+
+(defun msz-mdo (x l r)
+  (msznary (cons '(mdo) (strmdo x)) l r '(#\space)))
+
+(defprop mdoin msz-mdoin grind)
+(defprop mdoin 30. lbp)
+(defprop mdoin 30. rbp)
+
+(defprop %mdoin msz-mdoin grind)
+(defprop %mdoin 30. lbp)
+(defprop %mdoin 30. rbp)
+
+(defun msz-mdoin (x l r)
+  (msznary (cons '(mdo) (strmdoin x)) l r '(#\space)))
+
+(defun strsym (x) (or (get x 'strsym) (get x 'dissym)))
+
+(defun slash (x)
+  (cond ((null x) '())
+	(t
+	 (do ((l (cdr x) (cdr l))) ((null l))
+					; Following test is the same (except backslash is not included,
+					; so backslash is preceded by backslash) as in SCAN-TOKEN (src/nparse.lisp).
+	   (if (or (ascii-numberp (car l)) (alphabetp (car l)))
+	       nil
+	       (progn (rplacd l (cons (car l) (cdr l)))
+		      (rplaca l #\\) (setq l (cdr l)))))
+	 (if (alphabetp (car x)) x (cons #\\ x)))))
+

-----------------------------------------------------------------------

Summary of changes:
 src/grind.lisp                  | 488 ----------------------------------------
 src/maxima.system               |   8 +-
 src/{grind.lisp => mgrind.lisp} | 446 +++++++++++++-----------------------
 3 files changed, 166 insertions(+), 776 deletions(-)
 copy src/{grind.lisp => mgrind.lisp} (76%)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles-2 updated. branch-5_49-base-440-g422be532b

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles-2 has been updated
       via  422be532bfcf818d246db96774a0f9fd1bc0ca31 (commit)
      from  258628fe88a2237edab8312d11f42b073f1118df (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 422be532bfcf818d246db96774a0f9fd1bc0ca31
Author: Raymond Toy <toy...@gm...>
Date:   Thu Apr 23 21:35:07 2026 -0700

    nformat depends on poisson-series
    
    poisson-series doesn't call anything in nformat so there's no
    circular dependency there.  We can make nformat depend on
    poisson-series so $outofpois is defined before nformat uses it.

diff --git a/src/maxima.system b/src/maxima.system
index fd1dc4f82..221a432e2 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -260,8 +260,8 @@
              (:file "simp"
                     :depends-on ("simp-utils" "opers" "mopers" "mutils"))))
    (:module nformat :source-pathname ""
-            ;; There are other dependencies.  
-            :depends-on ("float-properties" "simp-utilities")
+            ;; poisson-series just to get $outofpois defined before its use.
+            :depends-on ("float-properties" "simp-utilities" "poisson-series")
             :components
             ((:file "nforma")))
    (:module basic-utilities :source-pathname ""

-----------------------------------------------------------------------

Summary of changes:
 src/maxima.system | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles-2 updated. branch-5_49-base-439-g258628fe8

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles-2 has been updated
       via  258628fe88a2237edab8312d11f42b073f1118df (commit)
       via  9995a7a7036d1b6e0e4ae81549214f338e5db505 (commit)
      from  fcd9a9018ba263edceb47c7848a5c40dffff11ce (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 258628fe88a2237edab8312d11f42b073f1118df
Author: Raymond Toy <toy...@gm...>
Date:   Thu Apr 23 21:23:11 2026 -0700

    Break circular dependency between basic-utilities and display
    
    The dependency was basically that basic-utilities calls functions in
    nforma.lisp, but displa.lisp called things in basic-utilities.  By
    moving nforma.lisp to its own module, nformat, the dependency is
    removed.
    
    To make this work and remove new circular dependencies, move
    float-inf-p and float-nan-p from float.lisp to float-properties.lisp.
    
    Now the dependency is a simple float-properties -> simp-utilities ->
    nformat -> basic-utilities.  There are still some circular
    dependencies, but I feel it's a bit less than before.  nforma needs
    $outofpois, but that seems unavoidable.
    
    Make a note of the dependency in nformat to poisson-series.

diff --git a/src/float-properties.lisp b/src/float-properties.lisp
index a14a6fdb1..fb13eaf81 100644
--- a/src/float-properties.lisp
+++ b/src/float-properties.lisp
@@ -270,3 +270,37 @@
 
 (defmfun $float_nan_p (x)
   (and (typep x 'double-float) (/= x x)))
+
+(defun float-nan-p (x)
+  (and (floatp x) (not (= x x))))
+
+(defun float-inf-p (x)
+  (and (floatp x) (not (float-nan-p x)) (beyond-extreme-values x)))
+
+(defun beyond-extreme-values (x)
+  (multiple-value-bind (most-negative most-positive) (extreme-float-values x)
+    (cond
+      ((< x 0) (< x most-negative))
+      ((> x 0) (> x most-positive))
+      (t nil))))
+
+(defun extreme-float-values (x)
+  ;; BLECHH, I HATE ENUMERATING CASES. IS THERE A BETTER WAY ??
+  (typecase x ;gcl returns an atomic list type with type-of
+    ;; The main purpose of the #+ read-time conditionals is to prevent
+    ;; compiler warnings on Lisp implementations that don't have distinct types
+    ;; for all floating point types defined by Common Lisp.
+;;    #+has-distinct-short-float
+    (short-float (values most-negative-short-float most-positive-short-float))
+;;    #+has-distinct-single-float
+    (single-float (values most-negative-single-float most-positive-single-float))
+;;    #+has-distinct-double-float
+    (double-float (values most-negative-double-float most-positive-double-float))
+;;    #+has-distinct-long-float
+    (long-float (values most-negative-long-float most-positive-long-float))
+    ;; NOT SURE THE FOLLOWING REALLY WORKS
+    ;; #+(and cmu double-double)
+    ;; (kernel:double-double-float
+    ;;   (values most-negative-double-double-float most-positive-double-double-float))
+    ))
+
diff --git a/src/float.lisp b/src/float.lisp
index a7458906c..b8476abfc 100644
--- a/src/float.lisp
+++ b/src/float.lisp
@@ -610,39 +610,6 @@
 				   fprateps)))
 			(cons num den))))))))
 
-(defun float-nan-p (x)
-  (and (floatp x) (not (= x x))))
-
-(defun float-inf-p (x)
-  (and (floatp x) (not (float-nan-p x)) (beyond-extreme-values x)))
-
-(defun beyond-extreme-values (x)
-  (multiple-value-bind (most-negative most-positive) (extreme-float-values x)
-    (cond
-      ((< x 0) (< x most-negative))
-      ((> x 0) (> x most-positive))
-      (t nil))))
-
-(defun extreme-float-values (x)
-  ;; BLECHH, I HATE ENUMERATING CASES. IS THERE A BETTER WAY ??
-  (typecase x ;gcl returns an atomic list type with type-of
-    ;; The main purpose of the #+ read-time conditionals is to prevent
-    ;; compiler warnings on Lisp implementations that don't have distinct types
-    ;; for all floating point types defined by Common Lisp.
-;;    #+has-distinct-short-float
-    (short-float (values most-negative-short-float most-positive-short-float))
-;;    #+has-distinct-single-float
-    (single-float (values most-negative-single-float most-positive-single-float))
-;;    #+has-distinct-double-float
-    (double-float (values most-negative-double-float most-positive-double-float))
-;;    #+has-distinct-long-float
-    (long-float (values most-negative-long-float most-positive-long-float))
-    ;; NOT SURE THE FOLLOWING REALLY WORKS
-    ;; #+(and cmu double-double)
-    ;; (kernel:double-double-float
-    ;;   (values most-negative-double-double-float most-positive-double-double-float))
-    ))
-
 ;; Convert a floating point number into a bigfloat.
 (defun floattofp (x)
   (if (float-nan-p x)
diff --git a/src/maxima.system b/src/maxima.system
index 95f288344..fd1dc4f82 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -259,10 +259,15 @@
                     :depends-on ("simp-utils"))
              (:file "simp"
                     :depends-on ("simp-utils" "opers" "mopers" "mutils"))))
+   (:module nformat :source-pathname ""
+            ;; There are other dependencies.  
+            :depends-on ("float-properties" "simp-utilities")
+            :components
+            ((:file "nforma")))
    (:module basic-utilities :source-pathname ""
-            ;; Note: this depends on nformat and merror which causes a
-            ;; circular dependency.
-            :depends-on ("simp-utilities" "fundamental-macros")
+            ;; Note: this depends on merror which causes a circular
+            ;; dependency.
+            :depends-on ("simp-utilities" "fundamental-macros" "nformat")
             :components
             ((:file "opr-util")
              (:file "basic-util")))
@@ -726,7 +731,6 @@
                                    "simp-utilities")
 	    :components
 	    ((:file "displa")
-	     (:file "nforma")
 	     (:file "grind")))
    (:module gcd :source-pathname ""
 	    :depends-on ("globals" "defmfun" "declarations" "destructuring-let"

commit 9995a7a7036d1b6e0e4ae81549214f338e5db505
Author: Raymond Toy <toy...@gm...>
Date:   Thu Apr 23 18:39:32 2026 -0700

    Add comment on dependencies of basic-utilities
    
    We can't do this because they would currently cause a cycle.

diff --git a/src/maxima.system b/src/maxima.system
index 39d816195..95f288344 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -260,6 +260,9 @@
              (:file "simp"
                     :depends-on ("simp-utils" "opers" "mopers" "mutils"))))
    (:module basic-utilities :source-pathname ""
+            ;; Note: this depends on nformat and merror which causes a
+            ;; circular dependency.
+            :depends-on ("simp-utilities" "fundamental-macros")
             :components
             ((:file "opr-util")
              (:file "basic-util")))

-----------------------------------------------------------------------

Summary of changes:
 src/float-properties.lisp | 34 ++++++++++++++++++++++++++++++++++
 src/float.lisp            | 33 ---------------------------------
 src/maxima.system         |  9 ++++++++-
 3 files changed, 42 insertions(+), 34 deletions(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles-2 created. branch-5_49-base-437-gfcd9a9018

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles-2 has been created
        at  fcd9a9018ba263edceb47c7848a5c40dffff11ce (commit)

- Log -----------------------------------------------------------------
commit fcd9a9018ba263edceb47c7848a5c40dffff11ce
Author: Raymond Toy <toy...@gm...>
Date:   Thu Apr 23 16:51:26 2026 -0700

    Add basic-utilities module for basic utilities
    
    New file opr-util.lisp contains getopr and friends that are used in
    many files.
    
    New file basic-util.lisp has other basic utilities used in many files
    like recur-apply, maxima-substitute, union* and friends, $listp,
    depends.
    
    Also, added that simp-util depends on mopers because simp-util uses
    mul and friends.

diff --git a/src/basic-util.lisp b/src/basic-util.lisp
new file mode 100644
index 000000000..f39685542
--- /dev/null
+++ b/src/basic-util.lisp
@@ -0,0 +1,202 @@
+;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+;;;
+;;; This file is part of the Maxima computer algebra system
+;;; (https://sourceforge.net/projects/maxima/)
+;;;
+;;; Maxima is copyrighted by its authors and licensed under the GNU
+;;; General Public License.  See COPYING and AUTHORS for details.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package :maxima)
+
+;;; Basic utilities used by many routines.  These functions were moved
+;;; from various files to here to reduce or fix some circular
+;;; dependencies.
+
+
+(defun recur-apply (fun e)
+  (cond ((eq (caar e) 'bigfloat) e)
+	((specrepp e) (funcall fun (specdisrep e)))
+	(t (let ((newargs (mapcar fun (cdr e))))
+	     (if (alike newargs (cdr e))
+		 e
+		 (simplifya (cons (cons (caar e) (member 'array (cdar e) :test #'eq)) newargs)
+			    nil))))))
+
+;; replace y with x in z, but leave z's second arg unchanged.
+;; This is for cases like at(integrate(x, x, a, b), [x=3])
+;; where second arg of integrate binds a new variable x,
+;; and we do not wish to subst 3 for x inside integrand.
+(defun subst-except-second-arg (x y z)
+  (cond 
+    ((member (caar z) '(%integrate %sum %product %limit %laplace))
+     (append 
+       (list (remove 'simp (car z))   ; ensure resimplification after substitution
+             (if (eq y (third z))     ; if (third z) is new var that shadows y
+                 (second z)           ; leave (second z) unchanged
+                 (subst1 x y (second z))) ; otherwise replace y with x in (second z)
+             (third z))               ; never change integration var
+       (mapcar (lambda (z) (subst1 x y z)); do subst in limits of integral
+               (cdddr z))))
+    ((eq (caar z) '%at)
+     ;; similar considerations here, but different structure of expression.
+     (let*
+       ((at-eqn-or-eqns (third z))
+        (at-eqns-list (if (eq (caar at-eqn-or-eqns) 'mlist) (rest at-eqn-or-eqns) (list at-eqn-or-eqns))))
+       (list
+         (remove 'simp (car z)) ;; ensure resimplification after substitution
+         (if (member y (mapcar #'(lambda (e) (second e)) at-eqns-list))
+           (second z)
+           (subst1 x y (second z)))
+         `((mlist) ,@(mapcar #'(lambda (e) (list (first e) (second e) (subst1 x y (third e)))) at-eqns-list)))))
+    ((eq (caar z) '%derivative)
+     ;; and again, with yet a different structure.
+     (let*
+       ((vars-and-degrees (rest (rest z)))
+        (diff-vars (loop for v in vars-and-degrees by #'cddr collect v))
+        (diff-degrees (loop for n in (rest vars-and-degrees) by #'cddr collect n)))
+       (append
+         (list
+           (remove 'simp (car z)) ;; ensure resimplification after substitution
+           (if (member y diff-vars)
+             (second z)
+             (subst1 x y (second z))))
+         (apply #'append (loop for v in diff-vars for n in diff-degrees collect (list v (subst1 x y n)))))))
+    (t z)))
+
+(defun subst0 (new old)
+  (cond ((atom new) new)
+	((alike (cdr new) (cdr old))
+	 (cond ((eq (caar new) (caar old)) old)
+	       (t (simplifya (cons (cons (caar new) (member 'array (cdar old) :test #'eq)) (cdr old))
+			     nil))))
+	((member 'array (cdar old) :test #'eq)
+	 (simplifya (cons (cons (caar new) '(array)) (cdr new)) nil))
+	(t (simplifya new nil))))
+
+;;Remainder of page is update from F302 --gsb
+
+(defun subst1 (x y z)			; Y is an atom
+  (cond ((atom z) (if (equal y z) x z))
+	((specrepp z) (subst1 x y (specdisrep z)))
+	((eq (caar z) 'bigfloat) z)
+	((and (eq (caar z) 'rat) (or (equal y (cadr z)) (equal y (caddr z))))
+	 (div (subst1 x y (cadr z)) (subst1 x y (caddr z))))
+	((at-substp z) (subst-except-second-arg x y z))
+	((and (eq y t) (eq (caar z) 'mcond))
+	 (list (cons (caar z) nil) (subst1 x y (cadr z)) (subst1 x y (caddr z))
+	       (cadddr z) (subst1 x y (car (cddddr z)))))
+	(t (let ((margs (mapcar #'(lambda (z1) (subst1 x y z1)) (cdr z)))
+                 (oprx (getopr x)) (opry (getopr y)))
+	     (if (and $opsubst
+		      (or (eq opry (caar z))
+			  (and (eq (caar z) 'rat) (eq opry 'mquotient))))
+		 (if (or (numberp x)
+			 (member x '(t nil $%e $%pi $%i) :test #'eq)
+			 (and (not (atom x))
+			      (not (or (eq (car x) 'lambda)
+				       (eq (caar x) 'lambda)))))
+		     (if (or (and (member 'array (cdar z) :test #'eq)
+				  (or (and (mnump x) $subnumsimp)
+				      (and (not (mnump x)) (not (atom x)))))
+			     ($subvarp x))
+			 (let ((substp 'mqapply))
+			   (subst0 (list* '(mqapply) x margs) z))
+			 (merror (intl:gettext "subst: cannot substitute ~M for operator ~M in expression ~M") x y z))
+		     (subst0 (cons (cons oprx nil) margs) z))
+		 (subst0 (cons (cons (caar z) nil) margs) z))))))
+
+(defun subst2 (x y z negxpty timesp)
+  (let (newexpt)
+    (cond ((atom z) z)
+	  ((specrepp z) (subst2 x y (specdisrep z) negxpty timesp))
+	  ((at-substp z) z) ;; IS SUBST-EXCEPT-SECOND-ARG APPROPRIATE HERE ?? !!
+	  ((alike1 y z) x)
+	  ((and timesp (eq (caar z) 'mtimes) (alike1 y (setq z (nformat z)))) x)
+	  ((and (eq (caar y) 'mexpt) (eq (caar z) 'mexpt) (alike1 (cadr y) (cadr z))
+		(setq newexpt (cond ((alike1 negxpty (caddr z)) -1)
+				    ($exptsubst (expthack (caddr y) (caddr z))))))
+	   (list '(mexpt) x newexpt))
+	  ((and $derivsubst (eq (caar y) '%derivative) (eq (caar z) '%derivative)
+		(alike1 (cadr y) (cadr z)))
+	   (let ((tail (subst-diff-match (cddr y) (cdr z))))
+	     (cond ((null tail) z)
+		   (t (cons (cons (caar z) nil) (cons x (cdr tail)))))))
+	  (t (recur-apply #'(lambda (z1) (subst2 x y z1 negxpty timesp)) z)))))
+
+(defun maxima-substitute (x y z) ; The args to SUBSTITUTE are assumed to be simplified.
+  ;; Prevent replacing dependent variable with constant in derivative
+  (cond ((and (not (atom z))
+              (eq (caar z) '%derivative)
+              (eq (cadr z) y)
+              (typep x 'number))
+         z)
+        (t
+         (let ((in-p t) (substp t))
+           (if (and (mnump y) (= (signum1 y) 1))
+	       (let ($sqrtdispflag ($pfeformat t)) (setq z (nformat-all z))))
+           (simplifya
+            (if (atom y)
+	        (cond ((equal y -1)
+		       (setq y '((mminus) 1))
+                       (subst2 x y (nformat-all z) nil nil)) ;; negxpty and timesp don't matter in this call since (caar y) != 'mexpt
+	              (t
+		       (cond ((and (not (symbolp x))
+			           (functionp x))
+		              (let ((tem (gensym)))
+			        (setf (get  tem  'operators) 'application-operator)
+			        (setf (symbol-function tem) x)
+			        (setq x tem))))
+		       (subst1 x y z)))
+	        (let ((negxpty (if (and (eq (caar y) 'mexpt)
+				        (= (signum1 (caddr y)) 1))
+			           (mul2 -1 (caddr y))))
+	              (timesp (if (eq (caar y) 'mtimes)
+                                  (setq y (nformat y)))))
+	          (subst2 x y z negxpty timesp)))
+            nil)))))
+
+(defun substitutel (l1 l2 e)
+  "l1 is a list of expressions.  l2 is a list of variables. For each 
+   element in list l2, substitute corresponding element of l1 into e"
+  (do ((l1 l1 (cdr l1))
+       (l2 l2 (cdr l2)))
+      ((null l1) e)
+    (setq e (maxima-substitute (car l1) (car l2) e))))
+
+(defun union* (a b)
+  (do ((a a (cdr a))
+       (x b))
+      ((null a) x)
+    (if (not (memalike (car a) b)) (setq x (cons (car a) x)))))
+
+(defun intersect* (a b)
+  (do ((a a (cdr a))
+       (x))
+      ((null a) x)
+    (if (memalike (car a) b) (setq x (cons (car a) x)))))
+
+(defun nthelem (n e)
+  (car (nthcdr (1- n) e)))
+
+(defmfun $listp (x)
+  (and (not (atom x))
+       (not (atom (car x)))
+       (eq (caar x) 'mlist)))
+
+(defun depends (e x &aux l)
+  (setq e (specrepcheck e))
+  (cond ((alike1 e x) t)
+        ((mnump e) nil)
+        ((and (symbolp e) (setq l (mget e 'depends)))
+         ;; Go recursively through the list of dependencies.
+         ;; This code detects indirect dependencies like a(x) and x(t).
+         (dependsl l x))
+        ((atom e) nil)
+        (t (or (depends (caar e) x)
+               (dependsl (cdr e) x)))))
+
+(defun dependsl (l x)
+  (dolist (u l)
+    (if (depends u x) (return t))))
+
diff --git a/src/comm.lisp b/src/comm.lisp
index 61d526a71..b2353e058 100644
--- a/src/comm.lisp
+++ b/src/comm.lisp
@@ -14,28 +14,6 @@
 
 (declare-top (special *linelabel*))
 
-;; op and opr properties
-
-(defvar *opr-table* (make-hash-table :test #'equal))
-
-(defun getopr0 (x)
-  (or
-    (and (symbolp x) (get x 'opr))
-    (and (stringp x) (gethash x *opr-table*))))
-
-(defun getopr (x)
-  (or (getopr0 x) x))
-
-(defun putopr (x y)
-  (or
-    (and (symbolp x) (setf (get x 'opr) y))
-    (and (stringp x) (setf (gethash x *opr-table*) y))))
-
-(defun remopr (x)
-  (or
-    (and (symbolp x) (remprop x 'opr))
-    (and (stringp x) (remhash x *opr-table*))))
-
 ;; This business about operator properties is terrible --
 ;; this stuff should be in src/nparse.lisp, and it should be split up
 ;; for each operator. Extra points for making it declarative.
@@ -61,22 +39,6 @@
   "If TRUE allows DIFF(X~Y,T) to work where ~ is defined in
 	  SHARE;VECT where VECT_CROSS is set to TRUE.")
 
-(defmfun $listp (x)
-  (and (not (atom x))
-       (not (atom (car x)))
-       (eq (caar x) 'mlist)))
-
-(defun atomchk (e fun 2ndp)
-  (if (or (atom e) (eq (caar e) 'bigfloat))
-      (merror (intl:gettext "~:M: ~Margument must be a non-atomic expression; found ~M") fun (if 2ndp "2nd " "") e)))
-
-(defmfun $member (x e)
-  (atomchk e '$member t)
-  (setq x (specrepcheck x))
-  (dolist (i (margs e))
-    (when (alike1 x (specrepcheck i))
-      (return t))))
-
 (defmfun $substitute (new old &optional (expr nil three-arg?))
   (cond (three-arg? (maxima-substitute new old expr))
 	(t
@@ -136,138 +98,7 @@
                            (let (($simp t)) (resimplify z)))
                         (setq z (maxima-substitute (cdar l) (caar l) z))))))))))
 
-(defun maxima-substitute (x y z) ; The args to SUBSTITUTE are assumed to be simplified.
-  ;; Prevent replacing dependent variable with constant in derivative
-  (cond ((and (not (atom z))
-              (eq (caar z) '%derivative)
-              (eq (cadr z) y)
-              (typep x 'number))
-         z)
-        (t
-         (let ((in-p t) (substp t))
-           (if (and (mnump y) (= (signum1 y) 1))
-	       (let ($sqrtdispflag ($pfeformat t)) (setq z (nformat-all z))))
-           (simplifya
-            (if (atom y)
-	        (cond ((equal y -1)
-		       (setq y '((mminus) 1))
-                       (subst2 x y (nformat-all z) nil nil)) ;; negxpty and timesp don't matter in this call since (caar y) != 'mexpt
-	              (t
-		       (cond ((and (not (symbolp x))
-			           (functionp x))
-		              (let ((tem (gensym)))
-			        (setf (get  tem  'operators) 'application-operator)
-			        (setf (symbol-function tem) x)
-			        (setq x tem))))
-		       (subst1 x y z)))
-	        (let ((negxpty (if (and (eq (caar y) 'mexpt)
-				        (= (signum1 (caddr y)) 1))
-			           (mul2 -1 (caddr y))))
-	              (timesp (if (eq (caar y) 'mtimes)
-                                  (setq y (nformat y)))))
-	          (subst2 x y z negxpty timesp)))
-            nil)))))
-
-;;Remainder of page is update from F302 --gsb
-
-(defun subst1 (x y z)			; Y is an atom
-  (cond ((atom z) (if (equal y z) x z))
-	((specrepp z) (subst1 x y (specdisrep z)))
-	((eq (caar z) 'bigfloat) z)
-	((and (eq (caar z) 'rat) (or (equal y (cadr z)) (equal y (caddr z))))
-	 (div (subst1 x y (cadr z)) (subst1 x y (caddr z))))
-	((at-substp z) (subst-except-second-arg x y z))
-	((and (eq y t) (eq (caar z) 'mcond))
-	 (list (cons (caar z) nil) (subst1 x y (cadr z)) (subst1 x y (caddr z))
-	       (cadddr z) (subst1 x y (car (cddddr z)))))
-	(t (let ((margs (mapcar #'(lambda (z1) (subst1 x y z1)) (cdr z)))
-                 (oprx (getopr x)) (opry (getopr y)))
-	     (if (and $opsubst
-		      (or (eq opry (caar z))
-			  (and (eq (caar z) 'rat) (eq opry 'mquotient))))
-		 (if (or (numberp x)
-			 (member x '(t nil $%e $%pi $%i) :test #'eq)
-			 (and (not (atom x))
-			      (not (or (eq (car x) 'lambda)
-				       (eq (caar x) 'lambda)))))
-		     (if (or (and (member 'array (cdar z) :test #'eq)
-				  (or (and (mnump x) $subnumsimp)
-				      (and (not (mnump x)) (not (atom x)))))
-			     ($subvarp x))
-			 (let ((substp 'mqapply))
-			   (subst0 (list* '(mqapply) x margs) z))
-			 (merror (intl:gettext "subst: cannot substitute ~M for operator ~M in expression ~M") x y z))
-		     (subst0 (cons (cons oprx nil) margs) z))
-		 (subst0 (cons (cons (caar z) nil) margs) z))))))
-
-(defun subst2 (x y z negxpty timesp)
-  (let (newexpt)
-    (cond ((atom z) z)
-	  ((specrepp z) (subst2 x y (specdisrep z) negxpty timesp))
-	  ((at-substp z) z) ;; IS SUBST-EXCEPT-SECOND-ARG APPROPRIATE HERE ?? !!
-	  ((alike1 y z) x)
-	  ((and timesp (eq (caar z) 'mtimes) (alike1 y (setq z (nformat z)))) x)
-	  ((and (eq (caar y) 'mexpt) (eq (caar z) 'mexpt) (alike1 (cadr y) (cadr z))
-		(setq newexpt (cond ((alike1 negxpty (caddr z)) -1)
-				    ($exptsubst (expthack (caddr y) (caddr z))))))
-	   (list '(mexpt) x newexpt))
-	  ((and $derivsubst (eq (caar y) '%derivative) (eq (caar z) '%derivative)
-		(alike1 (cadr y) (cadr z)))
-	   (let ((tail (subst-diff-match (cddr y) (cdr z))))
-	     (cond ((null tail) z)
-		   (t (cons (cons (caar z) nil) (cons x (cdr tail)))))))
-	  (t (recur-apply #'(lambda (z1) (subst2 x y z1 negxpty timesp)) z)))))
-
-;; replace y with x in z, but leave z's second arg unchanged.
-;; This is for cases like at(integrate(x, x, a, b), [x=3])
-;; where second arg of integrate binds a new variable x,
-;; and we do not wish to subst 3 for x inside integrand.
-(defun subst-except-second-arg (x y z)
-  (cond 
-    ((member (caar z) '(%integrate %sum %product %limit %laplace))
-     (append 
-       (list (remove 'simp (car z))   ; ensure resimplification after substitution
-             (if (eq y (third z))     ; if (third z) is new var that shadows y
-                 (second z)           ; leave (second z) unchanged
-                 (subst1 x y (second z))) ; otherwise replace y with x in (second z)
-             (third z))               ; never change integration var
-       (mapcar (lambda (z) (subst1 x y z)); do subst in limits of integral
-               (cdddr z))))
-    ((eq (caar z) '%at)
-     ;; similar considerations here, but different structure of expression.
-     (let*
-       ((at-eqn-or-eqns (third z))
-        (at-eqns-list (if (eq (caar at-eqn-or-eqns) 'mlist) (rest at-eqn-or-eqns) (list at-eqn-or-eqns))))
-       (list
-         (remove 'simp (car z)) ;; ensure resimplification after substitution
-         (if (member y (mapcar #'(lambda (e) (second e)) at-eqns-list))
-           (second z)
-           (subst1 x y (second z)))
-         `((mlist) ,@(mapcar #'(lambda (e) (list (first e) (second e) (subst1 x y (third e)))) at-eqns-list)))))
-    ((eq (caar z) '%derivative)
-     ;; and again, with yet a different structure.
-     (let*
-       ((vars-and-degrees (rest (rest z)))
-        (diff-vars (loop for v in vars-and-degrees by #'cddr collect v))
-        (diff-degrees (loop for n in (rest vars-and-degrees) by #'cddr collect n)))
-       (append
-         (list
-           (remove 'simp (car z)) ;; ensure resimplification after substitution
-           (if (member y diff-vars)
-             (second z)
-             (subst1 x y (second z))))
-         (apply #'append (loop for v in diff-vars for n in diff-degrees collect (list v (subst1 x y n)))))))
-    (t z)))
-
-(defun subst0 (new old)
-  (cond ((atom new) new)
-	((alike (cdr new) (cdr old))
-	 (cond ((eq (caar new) (caar old)) old)
-	       (t (simplifya (cons (cons (caar new) (member 'array (cdar old) :test #'eq)) (cdr old))
-			     nil))))
-	((member 'array (cdar old) :test #'eq)
-	 (simplifya (cons (cons (caar new) '(array)) (cdr new)) nil))
-	(t (simplifya new nil))))
+
 
 (defun expthack (y z)
   (prog (nn* dn* yn yd zn zd qd)
@@ -312,15 +143,6 @@
        (or (member (caar z) '(%derivative %del) :test #'eq)
            (member (caar z) dummy-variable-operators :test #'eq))))
 
-(defun recur-apply (fun e)
-  (cond ((eq (caar e) 'bigfloat) e)
-	((specrepp e) (funcall fun (specdisrep e)))
-	(t (let ((newargs (mapcar fun (cdr e))))
-	     (if (alike newargs (cdr e))
-		 e
-		 (simplifya (cons (cons (caar e) (member 'array (cdar e) :test #'eq)) newargs)
-			    nil))))))
-
 (defmfun $depends (&rest args)
   (when (oddp (length args))
     (merror (intl:gettext "depends: number of arguments must be even.")))
@@ -464,22 +286,6 @@
   (let (y)
     (and (atom e) (setq y (mget e '$atomgrad)) (assolike x y))))
 
-(defun depends (e x &aux l)
-  (setq e (specrepcheck e))
-  (cond ((alike1 e x) t)
-        ((mnump e) nil)
-        ((and (symbolp e) (setq l (mget e 'depends)))
-         ;; Go recursively through the list of dependencies.
-         ;; This code detects indirect dependencies like a(x) and x(t).
-         (dependsl l x))
-        ((atom e) nil)
-        (t (or (depends (caar e) x)
-               (dependsl (cdr e) x)))))
-
-(defun dependsl (l x)
-  (dolist (u l)
-    (if (depends u x) (return t))))
-
 (defun sdiff (e x) ; The args to SDIFF are assumed to be simplified.
   ;; Remove a special representation from the variable of differentiation
   (setq x (specrepcheck x))
@@ -703,29 +509,6 @@
 	   (dolist (u (cdr x))
 	     (if (not (mequalp u)) (return t))))))
 
-(defun substitutel (l1 l2 e)
-  "l1 is a list of expressions.  l2 is a list of variables. For each 
-   element in list l2, substitute corresponding element of l1 into e"
-  (do ((l1 l1 (cdr l1))
-       (l2 l2 (cdr l2)))
-      ((null l1) e)
-    (setq e (maxima-substitute (car l1) (car l2) e))))
-
-(defun union* (a b)
-  (do ((a a (cdr a))
-       (x b))
-      ((null a) x)
-    (if (not (memalike (car a) b)) (setq x (cons (car a) x)))))
-
-(defun intersect* (a b)
-  (do ((a a (cdr a))
-       (x))
-      ((null a) x)
-    (if (memalike (car a) b) (setq x (cons (car a) x)))))
-
-(defun nthelem (n e)
-  (car (nthcdr (1- n) e)))
-
 (defun remsimp (e)
   (if (atom e) e (cons (delsimp (car e)) (mapcar #'remsimp (cdr e)))))
 
diff --git a/src/maxima.system b/src/maxima.system
index aba20b3b9..39d816195 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -250,14 +250,19 @@
             ;; circular dependency.
             :depends-on ("prerequisites" "defmfun")
             :components
-            ((:file "simp-utils")
-             (:file "mopers")
+            ((:file "mopers")
              (:file "opers"
                     :depends-on ("mopers"))
+             (:file "simp-utils"
+                    :depends-on ("mopers"))
              (:file "mutils"
                     :depends-on ("simp-utils"))
              (:file "simp"
                     :depends-on ("simp-utils" "opers" "mopers" "mutils"))))
+   (:module basic-utilities :source-pathname ""
+            :components
+            ((:file "opr-util")
+             (:file "basic-util")))
    (:module m2-pattern-matcher :source-pathname ""
             :depends-on ("simp-utilities")
             :components
@@ -305,7 +310,8 @@
 	    :depends-on ("globals" "defmfun" "compatibility-macros" "compatibility-macros1"
                                    "declarations" "fundamental-macros" "prerequisites"
                                    "utility-macros"
-                                   "simp-utilities")
+                                   "simp-utilities"
+                                   "basic-utilities")
 	    :components
 	    ((:file "comm")
 	     (:file "comm2")))
diff --git a/src/mlisp.lisp b/src/mlisp.lisp
index 9eb84b2bc..a86431e56 100644
--- a/src/mlisp.lisp
+++ b/src/mlisp.lisp
@@ -431,11 +431,6 @@ is EQ to FNNAME if the latter is non-NIL."
       (cadr form)
       (caar form)))
 
-(defun margs (form)
-  (if (eq (caar form) 'mqapply)
-      (cddr form)
-      (cdr form)))
-
 (defun badfunchk (fnname val flag)
   (if (or flag (numberp val) (member val '(t nil $%e $%pi $%i) :test #'eq))
       (let ((type (if aryp (intl:gettext "an array") (intl:gettext "a function"))))
diff --git a/src/opr-util.lisp b/src/opr-util.lisp
new file mode 100644
index 000000000..66f82b7da
--- /dev/null
+++ b/src/opr-util.lisp
@@ -0,0 +1,34 @@
+;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+;;;
+;;; This file is part of the Maxima computer algebra system
+;;; (https://sourceforge.net/projects/maxima/)
+;;;
+;;; Maxima is copyrighted by its authors and licensed under the GNU
+;;; General Public License.  See COPYING and AUTHORS for details.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package :maxima)
+
+;; op and opr properties
+
+(defvar *opr-table* (make-hash-table :test #'equal))
+
+(defun getopr0 (x)
+  (or
+    (and (symbolp x) (get x 'opr))
+    (and (stringp x) (gethash x *opr-table*))))
+
+(defun getopr (x)
+  (or (getopr0 x) x))
+
+(defun putopr (x y)
+  (or
+    (and (symbolp x) (setf (get x 'opr) y))
+    (and (stringp x) (setf (gethash x *opr-table*) y))))
+
+(defun remopr (x)
+  (or
+    (and (symbolp x) (remprop x 'opr))
+    (and (stringp x) (remhash x *opr-table*))))
+
+
diff --git a/src/simp-utils.lisp b/src/simp-utils.lisp
index f922e4f2d..67bb775eb 100644
--- a/src/simp-utils.lisp
+++ b/src/simp-utils.lisp
@@ -137,3 +137,19 @@
        (zerop1 (sub exp
                     (mul var (coeff exp var 1))))))
 
+(defun margs (form)
+  (if (eq (caar form) 'mqapply)
+      (cddr form)
+      (cdr form)))
+
+(defun atomchk (e fun 2ndp)
+  (if (or (atom e) (eq (caar e) 'bigfloat))
+      (merror (intl:gettext "~:M: ~Margument must be a non-atomic expression; found ~M") fun (if 2ndp "2nd " "") e)))
+
+(defmfun $member (x e)
+  (atomchk e '$member t)
+  (setq x (specrepcheck x))
+  (dolist (i (margs e))
+    (when (alike1 x (specrepcheck i))
+      (return t))))
+

-----------------------------------------------------------------------


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch master updated. branch-5_49-base-436-g8455cf8d8

[rtoy <rt...@us...>]

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  8455cf8d814fdea76848ef748ee34f0dbdd80846 (commit)
       via  7639343d0c003b66f99c7aaab320b16b85e247a3 (commit)
       via  a5d11fa885b27a967c8d26712d0f26c64e5f2679 (commit)
       via  4ab582f71781666618165c25b0ab821328f94371 (commit)
       via  860e9733581bb6fc86ae227372d50aa50806560d (commit)
       via  00ddbe5b5dbf5db2de48caadc8bf590c3771392b (commit)
       via  a2060858c4b91934c04275436f8aa6b0d0eb5021 (commit)
       via  424e55b3d4ba49c2337a85e6d76bb955005b837c (commit)
       via  777848aa6455934fca7f46c88aa7f3d8c584abb0 (commit)
       via  2313b77146f9e596450957bf5442c918465d204b (commit)
       via  292dd91d1c6da8e1755b306f892f84147a3cad86 (commit)
       via  1afa87ef875f87e688702cb365b0ba1b204853b0 (commit)
       via  5cb2f3ca9dbfd0621e38e3de9ed452a750abc9ee (commit)
       via  a4b6ce46dd8df13abdafd0b467535a18ef5c6704 (commit)
       via  0f0ec31b52b863d211e119d66e8539c0117c97a2 (commit)
       via  f10fe1f89564e15a990bae3c39b447da51c0633e (commit)
       via  6cb9305041dc6fb7f14e2cd064ab4e467c3101d4 (commit)
       via  93c79c8d11b4531b5553133e415745cbc59fc6c5 (commit)
       via  529be2a2bc43fde31d809999ddd3611bee6fffad (commit)
      from  38565d87b2abf7b111360edcb1b99fac3f314f88 (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 8455cf8d814fdea76848ef748ee34f0dbdd80846
Merge: 38565d87b 7639343d0
Author: Raymond Toy <toy...@gm...>
Date:   Thu Apr 23 16:14:47 2026 -0700

    Merge branch 'rtoy-break-dependency-cycles'


-----------------------------------------------------------------------

Summary of changes:
 src/comm.lisp            |   3 +-
 src/compar.lisp          |   3 -
 src/expintegral.lisp     |  23 +----
 src/gamma.lisp           | 100 ------------------
 src/hyp.lisp             |   1 -
 src/irinte.lisp          |   7 --
 src/maxima.system        | 124 ++++++++++++++++-------
 src/mutils-fn.lisp       | 107 ++++++++++++++++++++
 src/mutils.lisp          | 129 ++----------------------
 src/numerical-utils.lisp | 134 +++++++++++++++++++++++++
 src/schatc-util.lisp     |  17 ++++
 src/simp-fn.lisp         | 146 +++++++++++++++++++++++++++
 src/simp-utils.lisp      | 139 +++++++++++++++++++++++++
 src/simp.lisp            | 256 +++++++----------------------------------------
 src/sin-util.lisp        |  30 ++++++
 src/sin.lisp             |  47 ---------
 src/trigi.lisp           |   3 -
 src/utils.lisp           |  15 ---
 src/var-predicate.lisp   |  49 +++++++++
 19 files changed, 757 insertions(+), 576 deletions(-)
 create mode 100644 src/mutils-fn.lisp
 create mode 100644 src/numerical-utils.lisp
 create mode 100644 src/schatc-util.lisp
 create mode 100644 src/simp-fn.lisp
 create mode 100644 src/simp-utils.lisp
 create mode 100644 src/sin-util.lisp
 create mode 100644 src/var-predicate.lisp


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles updated. branch-5_49-base-428-g7639343d0

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles has been updated
       via  7639343d0c003b66f99c7aaab320b16b85e247a3 (commit)
       via  a5d11fa885b27a967c8d26712d0f26c64e5f2679 (commit)
      from  4ab582f71781666618165c25b0ab821328f94371 (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 7639343d0c003b66f99c7aaab320b16b85e247a3
Author: Raymond Toy <toy...@gm...>
Date:   Thu Apr 23 15:54:01 2026 -0700

    Use consistent file header for info/license

diff --git a/src/mutils-fn.lisp b/src/mutils-fn.lisp
index acc8badbc..6a5712f93 100644
--- a/src/mutils-fn.lisp
+++ b/src/mutils-fn.lisp
@@ -1,4 +1,10 @@
 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+;;;
+;;; This file is part of the Maxima computer algebra system
+;;; (https://sourceforge.net/projects/maxima/)
+;;;
+;;; Maxima is copyrighted by its authors and licensed under the GNU
+;;; General Public License.  See COPYING and AUTHORS for details.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (in-package :maxima)
diff --git a/src/numerical-utils.lisp b/src/numerical-utils.lisp
index 80594b1e9..d01983607 100644
--- a/src/numerical-utils.lisp
+++ b/src/numerical-utils.lisp
@@ -1,7 +1,11 @@
-;;;;  -*- LISP -*-
-
-;;;; This software has NO WARRANTY, not even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+;;;
+;;; This file is part of the Maxima computer algebra system
+;;; (https://sourceforge.net/projects/maxima/)
+;;;
+;;; Maxima is copyrighted by its authors and licensed under the GNU
+;;; General Public License.  See COPYING and AUTHORS for details.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (in-package :maxima)
 
diff --git a/src/schatc-util.lisp b/src/schatc-util.lisp
index e9e194d95..8c44a419d 100644
--- a/src/schatc-util.lisp
+++ b/src/schatc-util.lisp
@@ -1,4 +1,11 @@
 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+;;;
+;;; This file is part of the Maxima computer algebra system
+;;; (https://sourceforge.net/projects/maxima/)
+;;;
+;;; Maxima is copyrighted by its authors and licensed under the GNU
+;;; General Public License.  See COPYING and AUTHORS for details.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (in-package :maxima)
 
diff --git a/src/simp-fn.lisp b/src/simp-fn.lisp
index b16ec5711..0e099e5e8 100644
--- a/src/simp-fn.lisp
+++ b/src/simp-fn.lisp
@@ -1,4 +1,11 @@
 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+;;;
+;;; This file is part of the Maxima computer algebra system
+;;; (https://sourceforge.net/projects/maxima/)
+;;;
+;;; Maxima is copyrighted by its authors and licensed under the GNU
+;;; General Public License.  See COPYING and AUTHORS for details.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (in-package :maxima)
 
diff --git a/src/simp-utils.lisp b/src/simp-utils.lisp
index a40ed0d5e..f922e4f2d 100644
--- a/src/simp-utils.lisp
+++ b/src/simp-utils.lisp
@@ -1,4 +1,10 @@
 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+;;;
+;;; This file is part of the Maxima computer algebra system
+;;; (https://sourceforge.net/projects/maxima/)
+;;;
+;;; Maxima is copyrighted by its authors and licensed under the GNU
+;;; General Public License.  See COPYING and AUTHORS for details.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (in-package :maxima)
diff --git a/src/sin-util.lisp b/src/sin-util.lisp
index 330141a7d..ada9ab4ae 100644
--- a/src/sin-util.lisp
+++ b/src/sin-util.lisp
@@ -1,4 +1,11 @@
 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+;;;
+;;; This file is part of the Maxima computer algebra system
+;;; (https://sourceforge.net/projects/maxima/)
+;;;
+;;; Maxima is copyrighted by its authors and licensed under the GNU
+;;; General Public License.  See COPYING and AUTHORS for details.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (in-package :maxima)
 
diff --git a/src/var-predicate.lisp b/src/var-predicate.lisp
index 20666184a..60086fe65 100644
--- a/src/var-predicate.lisp
+++ b/src/var-predicate.lisp
@@ -1,4 +1,11 @@
 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+;;;
+;;; This file is part of the Maxima computer algebra system
+;;; (https://sourceforge.net/projects/maxima/)
+;;;
+;;; Maxima is copyrighted by its authors and licensed under the GNU
+;;; General Public License.  See COPYING and AUTHORS for details.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (in-package :maxima)
 

commit a5d11fa885b27a967c8d26712d0f26c64e5f2679
Author: Raymond Toy <toy...@gm...>
Date:   Thu Apr 23 15:53:36 2026 -0700

    Remove file components that have been moved or replaced

diff --git a/src/maxima.system b/src/maxima.system
index d109b0230..aba20b3b9 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -241,9 +241,7 @@
 	    :depends-on ("defmfun" "compatibility-macros" "compatibility-macros1"
                                    "prerequisites" "errset")
 	    :components
-	    (#+nil
-             (:file "mopers")
-	     (:file "mforma")))
+	    ((:file "mforma")))
    (:module simp-utilities :source-pathname ""
             ;; There are other dependencies.  We call $ratdisrep,
             ;; $outofpois, $ratsimp and others.  These are all
@@ -295,16 +293,12 @@
                                    "compatibility-macros1" "declarations" "fundamental-macros"
                                    "prerequisites")
 	    :components
-	    (#+nil
-             (:file "opers")
-             (:file "utils")
+	    ((:file "utils")
 	     (:file "sumcon")
 	     (:file "sublis")
 	     (:file "merror")
 	     (:file "mformt")
-	     #+nil
-             (:file "mutils")
-             (:file "mutils-fn")
+	     (:file "mutils-fn")
 	     (:file "outmis")
 	     (:file "ar")))
    (:module commands :source-pathname ""
@@ -613,9 +607,7 @@
                                    "numerical-utilities"
                                    "simp-utilities")
 	    :components
-	    (#+nil
-             (:file "simp")
-             (:file "simp-fn")
+	    ((:file "simp-fn")
 	     (:file "float")
 	     (:file "csimp")
 	     (:file "csimp2")

-----------------------------------------------------------------------

Summary of changes:
 src/maxima.system        | 16 ++++------------
 src/mutils-fn.lisp       |  6 ++++++
 src/numerical-utils.lisp | 12 ++++++++----
 src/schatc-util.lisp     |  7 +++++++
 src/simp-fn.lisp         |  7 +++++++
 src/simp-utils.lisp      |  6 ++++++
 src/sin-util.lisp        |  7 +++++++
 src/var-predicate.lisp   |  7 +++++++
 8 files changed, 52 insertions(+), 16 deletions(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch master updated. branch-5_49-base-417-g38565d87b

[dauti <da...@us...>]

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  38565d87b2abf7b111360edcb1b99fac3f314f88 (commit)
      from  162a6093a8ed1eb17e1446f33757701b6ea57816 (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 38565d87b2abf7b111360edcb1b99fac3f314f88
Author: Wolfgang Dautermann <da...@us...>
Date:   Thu Apr 23 22:57:35 2026 +0200

    Add new ECL/crosscompiling files to automake.
    
    For 'make dist'. That target doesn't seem to work
    currently, some issues in the russian translation
    part???
    
    Remove an unneeded file for crosscompilation.

diff --git a/crosscompile-windows/CMakeLists.txt b/crosscompile-windows/CMakeLists.txt
index f67fe7815..973db8a00 100644
--- a/crosscompile-windows/CMakeLists.txt
+++ b/crosscompile-windows/CMakeLists.txt
@@ -297,7 +297,6 @@ configure_file("${CMAKE_SOURCE_DIR}/wine-lisp.sh.tmpl" "${CMAKE_BINARY_DIR}/wine
 configure_file("${CMAKE_SOURCE_DIR}/wine-sbcl.sh.tmpl" "${CMAKE_BINARY_DIR}/wine-sbcl.sh")
 configure_file("${CMAKE_SOURCE_DIR}/wine-ccl.sh.tmpl" "${CMAKE_BINARY_DIR}/wine-ccl.sh")
 configure_file("${CMAKE_SOURCE_DIR}/wine-ecl.sh.tmpl" "${CMAKE_BINARY_DIR}/wine-ecl.sh")
-configure_file("${CMAKE_SOURCE_DIR}/ecl/ecl-lisp-build.sh.tmpl" "${CMAKE_BINARY_DIR}/ecl-lisp-build.sh")
 
 externalproject_add(maxima
   # first copy the maxima source to a build directory, since out-of-source-builds do not work
diff --git a/crosscompile-windows/Makefile.am b/crosscompile-windows/Makefile.am
index f637c0ea6..639fbc7fe 100644
--- a/crosscompile-windows/Makefile.am
+++ b/crosscompile-windows/Makefile.am
@@ -4,9 +4,10 @@ EXTRA_DIST =\
  README.txt TODO.txt LICENSE_APPENDIX.txt\
  maxima-icon.bmp maxima-icon.ico maxima-icon.svg maxima-installerimage.bmp\
  wine-clisp.sh.tmpl wine-lisp.sh.tmpl wine-sbcl.sh.tmpl wine-ccl.sh.tmpl\
- sbcl.sh licenses.html\
+ wine-ecl.sh.tmpl sbcl.sh licenses.html\
  lispselector.bat lispselector.tcl\
  xmaxima.bat downloads/.keep\
  gnuplot/CMakeLists.txt sbcl/CMakeLists.txt tcltk/CMakeLists.txt abcl/CMakeLists.txt ccl/CMakeLists.txt\
  vtk/CMakeLists.txt wine/CMakeLists.txt wxmaxima/CMakeLists.txt wxwidgets/CMakeLists.txt\
- texinfo/CMakeLists.txt maxima_longnames.c clisp/CMakeLists.txt
+ texinfo/CMakeLists.txt maxima_longnames.c clisp/CMakeLists.txt \
+ ecl/strm_os.d ecl/CMakeLists.txt winlibs/CMakeLists.txt
diff --git a/crosscompile-windows/ecl/ecl-lisp-build.sh.tmpl b/crosscompile-windows/ecl/ecl-lisp-build.sh.tmpl
deleted file mode 100755
index eb0c75668..000000000
--- a/crosscompile-windows/ecl/ecl-lisp-build.sh.tmpl
+++ /dev/null
@@ -1,15 +0,0 @@
-#!/bin/sh
-
-# This script builds Maxima/ECL with the lisp only build procedure.
-# Don't know, why it does not work with the usual ./configure ; make procedure...
-
-# maxima.bat is overwritten by the lisp build procedure, save it and restore it afterwards.
-cp ${CMAKE_BINARY_DIR}/maxima-prefix/src/maxima/src/maxima.bat ${CMAKE_BINARY_DIR}/maxima-prefix/src/maxima/src/maxima.bat.bak
-cd ${CMAKE_BINARY_DIR}/maxima-prefix/src/maxima
-${CMAKE_BINARY_DIR}/wine-ecl.sh --load "configure.lisp" --eval "(configure :interactive nil)" --eval "(quit)"
-cd ${CMAKE_BINARY_DIR}/maxima-prefix/src/maxima/src
-#${CMAKE_BINARY_DIR}/wine-ecl.sh --load "maxima-build.lisp" --eval "(maxima-compile)" --eval "(build-maxima-lib)" --eval "(quit)"
-#${CMAKE_BINARY_DIR}/wine-ecl.sh --load "maxima-build.lisp" --eval "(maxima-compile)" --eval "(maxima-dump)" --eval "(quit)"
-${CMAKE_BINARY_DIR}/wine-ecl.sh --load "maxima-build.lisp" --eval "(maxima-compile)" --eval "(quit)"
-cp ${CMAKE_BINARY_DIR}/maxima-prefix/src/maxima/src/maxima.bat ${CMAKE_BINARY_DIR}/maxima-prefix/src/maxima/src/maxima.bat.bak-after-lisp-build
-cp ${CMAKE_BINARY_DIR}/maxima-prefix/src/maxima/src/maxima.bat.bak ${CMAKE_BINARY_DIR}/maxima-prefix/src/maxima/src/maxima.bat

-----------------------------------------------------------------------

Summary of changes:
 crosscompile-windows/CMakeLists.txt             |  1 -
 crosscompile-windows/Makefile.am                |  5 +++--
 crosscompile-windows/ecl/ecl-lisp-build.sh.tmpl | 15 ---------------
 3 files changed, 3 insertions(+), 18 deletions(-)
 delete mode 100755 crosscompile-windows/ecl/ecl-lisp-build.sh.tmpl


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch master updated. branch-5_49-base-416-g162a6093a

[tomasriker <tom...@us...>]

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  162a6093a8ed1eb17e1446f33757701b6ea57816 (commit)
      from  5ed3b159c792c2626a1b41cb2d2e860a723b6b2d (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 162a6093a8ed1eb17e1446f33757701b6ea57816
Author: David Scherfgen <d.s...@go...>
Date:   Thu Apr 23 08:35:18 2026 +0200

    APPARENTLY-A-DIRECTORY-P: support Allegro CL via EXCL:FILE-DIRECTORY-P
    
    Allegro CL puts a directory's name into :NAME, unlike other Lisps,
    so we need a different test. Allegro CL provides an internal function for this.

diff --git a/src/mload.lisp b/src/mload.lisp
index 0ba8f6138..a220814e1 100644
--- a/src/mload.lisp
+++ b/src/mload.lisp
@@ -640,7 +640,8 @@
     (if foo (not (apparently-a-directory-p foo)))))
 
 (defun apparently-a-directory-p (path)
-  (member (pathname-name path) '(nil :unspecific) :test #'eq))
+  #+allegro (excl:file-directory-p path)
+  #-allegro (member (pathname-name path) '(nil :unspecific) :test #'eq))
 
 ;; We keep these here in case we want to optimize the search.  To
 ;; speed things up, we might want to support search lists like

-----------------------------------------------------------------------

Summary of changes:
 src/mload.lisp | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch master updated. branch-5_49-base-415-g5ed3b159c

[tomasriker <tom...@us...>]

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  5ed3b159c792c2626a1b41cb2d2e860a723b6b2d (commit)
      from  dee5760083240743043639aece795d3fcaaa94c3 (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 5ed3b159c792c2626a1b41cb2d2e860a723b6b2d
Author: David Scherfgen <d.s...@go...>
Date:   Thu Apr 23 08:09:20 2026 +0200

    APPARENTLY-A-DIRECTORY-P: also check for :UNSPECIFIC to support LispWorks
    
    In LispWorks, PATHNAME-NAME of a directory listed by DIRECTORY is :UNSPECIFIC,
    not NIL.

diff --git a/src/mload.lisp b/src/mload.lisp
index 2bcc6a5a4..0ba8f6138 100644
--- a/src/mload.lisp
+++ b/src/mload.lisp
@@ -640,7 +640,7 @@
     (if foo (not (apparently-a-directory-p foo)))))
 
 (defun apparently-a-directory-p (path)
-  (eq (pathname-name path) nil))
+  (member (pathname-name path) '(nil :unspecific) :test #'eq))
 
 ;; We keep these here in case we want to optimize the search.  To
 ;; speed things up, we might want to support search lists like

-----------------------------------------------------------------------

Summary of changes:
 src/mload.lisp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles updated. branch-5_49-base-426-g4ab582f71

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles has been updated
       via  4ab582f71781666618165c25b0ab821328f94371 (commit)
       via  860e9733581bb6fc86ae227372d50aa50806560d (commit)
      from  00ddbe5b5dbf5db2de48caadc8bf590c3771392b (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 4ab582f71781666618165c25b0ab821328f94371
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 19:32:19 2026 -0700

    Update dependencies for variable-predicates
    
    The module hypergeometric (hyp.lisp) needs functions from
    variable-predicates so add the dependency.

diff --git a/src/maxima.system b/src/maxima.system
index 1914d4c14..d109b0230 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -758,7 +758,8 @@
             ;; Simplification and evaluation of hypergeometric functions.
             :depends-on ("compatibility-macros1" "declarations" "defmfun" "errset" "globals"
                          "miscellaneous" "other-macros" "prerequisites" "utility-macros"
-                         "m2-pattern-matcher")
+                         "m2-pattern-matcher"
+                         "variable-predicates")
             :components
             ((:file "hyp")
 	     (:file "hypergeometric")

commit 860e9733581bb6fc86ae227372d50aa50806560d
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 19:25:29 2026 -0700

    Break circular dependency between irinte and sin
    
    First, all the variable predicate stuff like `freevar` and `varp` to
    the new file var-predicates that is in the new module
    variable-predicates.  This removes a lot of the dependency between
    irinte and sin.  (These predicates are also used in other files.)
    
    Second, irinte was using a few functions from sin like `integerp2`,
    `integerp1`, `zerp`, and `nonzerp`.  Moved to a new file sin-util.
    Now sin depends on irinte but not vice versa.  And sin and irinte both
    depend on sin-util.
    
    Third, laplac and hypgeo are definite integration routines so they can
    be movedto the definite-integetion module.
    
    Dependencies updated.

diff --git a/src/irinte.lisp b/src/irinte.lisp
index 06d454516..14d48d6ea 100644
--- a/src/irinte.lisp
+++ b/src/irinte.lisp
@@ -14,12 +14,8 @@
 
 (load-macsyma-macros rzmac)
 
-(defun zerp (a) (equal a 0))
-
 (defun integerpfr (a) (if (not (maxima-integerp a)) (integerp1 a)))
 
-(defun nonzerp (a) (not (equal a 0)))
-
 (defun hasvar2 (exp var2)
   (not (freevar2 exp var2)))
 
diff --git a/src/maxima.system b/src/maxima.system
index ed37d7663..1914d4c14 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -749,6 +749,11 @@
 	     (:file "compar")
 	     (:file "askp"))		;does this belong here?
 	    )
+   (:module variable-predicates :source-pathname ""
+            ;; Variable predicates like FREEVAR, VARP.
+            :depends-on ("simp-utilities")
+            :components
+            ((:file "var-predicate")))
    (:module hypergeometric :source-pathname ""
             ;; Simplification and evaluation of hypergeometric functions.
             :depends-on ("compatibility-macros1" "declarations" "defmfun" "errset" "globals"
@@ -766,15 +771,16 @@
                                    "compatibility-macros" "declarations"
                                    "destructuring-let" "errset" "fundamental-macros"
                                    "prerequisites" "rat-macros" "utility-macros"
-                                   "hypergeometric"
-                                   "m2-pattern-matcher")
+                                   "m2-pattern-matcher"
+                                   "variable-predicates")
 	    :components
-	    ((:file "sinint")
-	     (:file "sin")
+	    ((:file "sin-util")
+             (:file "sinint")
 	     (:file "risch")
-	     (:file "irinte")
-	     (:file "laplac")
-             (:file "hypgeo")))
+	     (:file "irinte"
+                    :depends-on ("sin-util"))
+             (:file "sin"
+                    :depends-on ("sin-util" "irinte"))))
    (:module taylor-series :source-pathname ""
 	    :depends-on ("globals" "defmfun" "compatibility-macros"
                                    "compatibility-macros1" "declarations"
@@ -786,10 +792,14 @@
 	    :depends-on ("globals" "defmfun" "declarations" "destructuring-let"
                                    "fundamental-macros" "other-macros"
                                    "prerequisites"
-                                   "m2-pattern-matcher")
+                                   "hypergeometric"
+                                   "m2-pattern-matcher"
+                                   "variable-predicates")
 	    :components
 	    ((:file "defint")
-	     (:file "residu")))
+	     (:file "residu")
+	     (:file "laplac")
+             (:file "hypgeo")))
    (:module trigonometry :source-pathname ""
 	    :depends-on ("globals" "defmfun"
                                    "compatibility-macros" "declarations"
diff --git a/src/sin-util.lisp b/src/sin-util.lisp
new file mode 100644
index 000000000..330141a7d
--- /dev/null
+++ b/src/sin-util.lisp
@@ -0,0 +1,23 @@
+;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+
+(in-package :maxima)
+
+;;; Predicate functions
+
+(defun integerp2 (x)
+  "Returns x if x is an integer, else false"
+  (let (u)
+    (cond ((not (numberp x)) nil)
+	  ((not (floatp x)) x)
+	  ((prog2 (setq u (maxima-rationalize x))
+	       (equal (cdr u) 1))
+           (car u)))))
+
+(defun integerp1 (x)
+  "Returns 2*x if 2*x is an integer, else nil"
+  (integerp2 (mul2* 2 x)))
+
+(defun zerp (a) (equal a 0))
+
+(defun nonzerp (a) (not (equal a 0)))
+
diff --git a/src/sin.lisp b/src/sin.lisp
index f1e3c1b20..5f3e262e1 100644
--- a/src/sin.lisp
+++ b/src/sin.lisp
@@ -31,53 +31,6 @@
 
 ;;; Predicate functions
 
-;; Note: varp and freevarp are not used in this file anymore.  But
-;; they are used in other files.  Someday, varp and freevarp should be
-;; moved elsewhere.
-(declaim (inline varp))
-(defun varp (x)
-  (declare (special var))
-  (alike1 x var))
-
-(defun freevar (a)
-  (declare (special var))
-  (cond ((atom a) (not (eq a var)))
-	((varp a) nil)
-	((and (not (atom (car a)))
-	      (member 'array (cdar a) :test #'eq))
-	 (cond ((freevar (cdr a)) t)
-	       (t (merror "~&FREEVAR: variable of integration appeared in subscript."))))
-	(t (and (freevar (car a)) (freevar (cdr a))))))
-
-;; Same as varp, but the second arg specifies the variable to be
-;; tested instead of using the special variable VAR.
-(defun varp2 (x var2)
-  (alike1 x var2))
-
-;; Like freevar but the second arg specifies the variable to be tested
-;; instead of using the special variable VAR.
-(defun freevar2 (a var2)
-  (cond ((atom a) (not (eq a var2)))
-	((varp2 a var2) nil)
-	((and (not (atom (car a)))
-	      (member 'array (cdar a) :test #'eq))
-	 (cond ((freevar2 (cdr a) var2) t)
-	       (t (merror "~&FREEVAR: variable of integration appeared in subscript."))))
-	(t (and (freevar2 (car a) var2) (freevar2 (cdr a) var2)))))
-
-(defun integerp1 (x)
-  "Returns 2*x if 2*x is an integer, else nil"
-  (integerp2 (mul2* 2 x)))
-
-(defun integerp2 (x)
-  "Returns x if x is an integer, else false"
-  (let (u)
-    (cond ((not (numberp x)) nil)
-	  ((not (floatp x)) x)
-	  ((prog2 (setq u (maxima-rationalize x))
-	       (equal (cdr u) 1))
-           (car u)))))
-
 ;; This predicate is used with m2 pattern matcher.
 ;; A rational expression in var2.
 (defun rat8 (ex var2)
diff --git a/src/var-predicate.lisp b/src/var-predicate.lisp
new file mode 100644
index 000000000..20666184a
--- /dev/null
+++ b/src/var-predicate.lisp
@@ -0,0 +1,42 @@
+;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+
+(in-package :maxima)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Predicate functions
+
+;; Note: varp and freevarp are not used in this file anymore.  But
+;; they are used in other files.  Someday, varp and freevarp should be
+;; moved elsewhere.
+(declaim (inline varp))
+(defun varp (x)
+  (declare (special var))
+  (alike1 x var))
+
+(defun freevar (a)
+  (declare (special var))
+  (cond ((atom a) (not (eq a var)))
+	((varp a) nil)
+	((and (not (atom (car a)))
+	      (member 'array (cdar a) :test #'eq))
+	 (cond ((freevar (cdr a)) t)
+	       (t (merror "~&FREEVAR: variable of integration appeared in subscript."))))
+	(t (and (freevar (car a)) (freevar (cdr a))))))
+
+;; Same as varp, but the second arg specifies the variable to be
+;; tested instead of using the special variable VAR.
+(defun varp2 (x var2)
+  (alike1 x var2))
+
+;; Like freevar but the second arg specifies the variable to be tested
+;; instead of using the special variable VAR.
+(defun freevar2 (a var2)
+  (cond ((atom a) (not (eq a var2)))
+	((varp2 a var2) nil)
+	((and (not (atom (car a)))
+	      (member 'array (cdar a) :test #'eq))
+	 (cond ((freevar2 (cdr a) var2) t)
+	       (t (merror "~&FREEVAR: variable of integration appeared in subscript."))))
+	(t (and (freevar2 (car a) var2) (freevar2 (cdr a) var2)))))
+

-----------------------------------------------------------------------

Summary of changes:
 src/irinte.lisp        |  4 ----
 src/maxima.system      | 31 +++++++++++++++++++++----------
 src/sin-util.lisp      | 23 +++++++++++++++++++++++
 src/sin.lisp           | 47 -----------------------------------------------
 src/var-predicate.lisp | 42 ++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 86 insertions(+), 61 deletions(-)
 create mode 100644 src/sin-util.lisp
 create mode 100644 src/var-predicate.lisp


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles updated. branch-5_49-base-424-g00ddbe5b5

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles has been updated
       via  00ddbe5b5dbf5db2de48caadc8bf590c3771392b (commit)
      from  a2060858c4b91934c04275436f8aa6b0d0eb5021 (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 00ddbe5b5dbf5db2de48caadc8bf590c3771392b
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 12:42:21 2026 -0700

    Move cdras from irinte to new file schatc-util
    
    cdras caused a circular dependency between irinte and defint and other
    integration routines.  Moving it to schatc-util breaks at least that
    dependency.  Plus cdras is intimately related to schatc.

diff --git a/src/irinte.lisp b/src/irinte.lisp
index 27eba22a6..06d454516 100644
--- a/src/irinte.lisp
+++ b/src/irinte.lisp
@@ -219,9 +219,6 @@
   (declare (ignore xx ee fff gg dd pp r0 e0))
   nil)
 
-(defun cdras (a b)
-  (cdr (assoc a b :test #'equal)))
-
 (defun intir (funct x)
   (inti funct x (jmaug (specrepcheck funct) x)))
 
diff --git a/src/maxima.system b/src/maxima.system
index f95a29876..ed37d7663 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -263,7 +263,8 @@
    (:module m2-pattern-matcher :source-pathname ""
             :depends-on ("simp-utilities")
             :components
-            ((:file "schatc")))
+            ((:file "schatc")
+             (:file "schatc-util")))
    ;; This contains the reader macro #$...$ so we want io compile this
    ;; as early as possible before anything uses it.
    (:module reader :source-pathname ""
diff --git a/src/schatc-util.lisp b/src/schatc-util.lisp
new file mode 100644
index 000000000..e9e194d95
--- /dev/null
+++ b/src/schatc-util.lisp
@@ -0,0 +1,10 @@
+;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+
+(in-package :maxima)
+
+;; Utility functions for working with M2 pattern matching results
+
+(defun cdras (a b)
+  "Extract the value associated with key A from association list B.
+   This is commonly used to extract matched variables from M2 pattern matching results."
+  (cdr (assoc a b :test #'equal)))

-----------------------------------------------------------------------

Summary of changes:
 src/irinte.lisp      |  3 ---
 src/maxima.system    |  3 ++-
 src/schatc-util.lisp | 10 ++++++++++
 3 files changed, 12 insertions(+), 4 deletions(-)
 create mode 100644 src/schatc-util.lisp


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles updated. branch-5_49-base-423-ga2060858c

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles has been updated
       via  a2060858c4b91934c04275436f8aa6b0d0eb5021 (commit)
       via  424e55b3d4ba49c2337a85e6d76bb955005b837c (commit)
      from  777848aa6455934fca7f46c88aa7f3d8c584abb0 (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 a2060858c4b91934c04275436f8aa6b0d0eb5021
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 12:32:28 2026 -0700

    Remove pattern-matching dependency
    
    The integration, trigonometry, and miscellaneous modules don't depend
    on the pattern-matching module.  They only need m2-pattern-matcher.

diff --git a/src/maxima.system b/src/maxima.system
index 6f7bbe279..f95a29876 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -761,7 +761,7 @@
 		    ;; be loaded first.
 		    :depends-on ("hypergeometric"))))
    (:module integration :source-pathname ""
-	    :depends-on ("globals" "defmfun" "pattern-matching" 
+	    :depends-on ("globals" "defmfun"
                                    "compatibility-macros" "declarations"
                                    "destructuring-let" "errset" "fundamental-macros"
                                    "prerequisites" "rat-macros" "utility-macros"
@@ -790,7 +790,7 @@
 	    ((:file "defint")
 	     (:file "residu")))
    (:module trigonometry :source-pathname ""
-	    :depends-on ("globals" "pattern-matching" "defmfun"
+	    :depends-on ("globals" "defmfun"
                                    "compatibility-macros" "declarations"
                                    "errset" "fundamental-macros" "other-macros"
                                    "prerequisites" "utility-macros"
@@ -868,7 +868,7 @@
     ((:file "expintegral")
      (:file "gamma")))
    (:module miscellaneous :source-pathname ""
-	    :depends-on ("globals" "defmfun" "pattern-matching" "compatibility-macros1"
+	    :depends-on ("globals" "defmfun" "compatibility-macros1"
                                    "reader" "utility-macros" "commands"
                                    "destructuring-let" "errset" "other-macros"
                                    "rat-macros" "declarations"  "fundamental-macros"

commit 424e55b3d4ba49c2337a85e6d76bb955005b837c
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 12:28:17 2026 -0700

    Move schatc to new module m2-pattern-matcher
    
    This doesn't break any cycles but should make changes easier to
    manage.  Update other modules that now depend on schatc.

diff --git a/src/maxima.system b/src/maxima.system
index 02d5acd4f..6f7bbe279 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -260,6 +260,10 @@
                     :depends-on ("simp-utils"))
              (:file "simp"
                     :depends-on ("simp-utils" "opers" "mopers" "mutils"))))
+   (:module m2-pattern-matcher :source-pathname ""
+            :depends-on ("simp-utilities")
+            :components
+            ((:file "schatc")))
    ;; This contains the reader macro #$...$ so we want io compile this
    ;; as early as possible before anything uses it.
    (:module reader :source-pathname ""
@@ -747,7 +751,8 @@
    (:module hypergeometric :source-pathname ""
             ;; Simplification and evaluation of hypergeometric functions.
             :depends-on ("compatibility-macros1" "declarations" "defmfun" "errset" "globals"
-                         "miscellaneous" "other-macros" "prerequisites" "utility-macros")
+                         "miscellaneous" "other-macros" "prerequisites" "utility-macros"
+                         "m2-pattern-matcher")
             :components
             ((:file "hyp")
 	     (:file "hypergeometric")
@@ -760,7 +765,8 @@
                                    "compatibility-macros" "declarations"
                                    "destructuring-let" "errset" "fundamental-macros"
                                    "prerequisites" "rat-macros" "utility-macros"
-                                   "hypergeometric")
+                                   "hypergeometric"
+                                   "m2-pattern-matcher")
 	    :components
 	    ((:file "sinint")
 	     (:file "sin")
@@ -778,7 +784,8 @@
    (:module definite-integration :source-pathname ""
 	    :depends-on ("globals" "defmfun" "declarations" "destructuring-let"
                                    "fundamental-macros" "other-macros"
-                                   "prerequisites")
+                                   "prerequisites"
+                                   "m2-pattern-matcher")
 	    :components
 	    ((:file "defint")
 	     (:file "residu")))
@@ -787,7 +794,8 @@
                                    "compatibility-macros" "declarations"
                                    "errset" "fundamental-macros" "other-macros"
                                    "prerequisites" "utility-macros"
-                                   "taylor-series")
+                                   "taylor-series"
+                                   "m2-pattern-matcher")
 	    :components
 	    ((:file "trigi")
 	     (:file "trigo")
@@ -824,8 +832,7 @@
                                    "rat-macros"
                                    "simp-utilities")
 	    :components
-	    ((:file "schatc")
-	     (:file "matcom")
+	    ((:file "matcom")
 	     (:file "matrun")
 	     (:file "nisimp")))
    (:module limits :source-pathname ""
@@ -856,7 +863,7 @@
 	    ((:file "mtrace")
 	     (:file "mdebug")))
    (:module gamma-expint :source-pathname ""
-    :depends-on ("numerical-utilities")
+    :depends-on ("numerical-utilities" "m2-pattern-matcher")
     :components
     ((:file "expintegral")
      (:file "gamma")))
@@ -865,7 +872,8 @@
                                    "reader" "utility-macros" "commands"
                                    "destructuring-let" "errset" "other-macros"
                                    "rat-macros" "declarations"  "fundamental-macros"
-                                   "numerical-utilities")
+                                   "numerical-utilities"
+                                   "m2-pattern-matcher")
 	    :components
 	    ((:file "scs")
 	     (:file "asum")

-----------------------------------------------------------------------

Summary of changes:
 src/maxima.system | 30 +++++++++++++++++++-----------
 1 file changed, 19 insertions(+), 11 deletions(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch master updated. branch-5_49-base-414-gdee576008

[rtoy <rt...@us...>]

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  dee5760083240743043639aece795d3fcaaa94c3 (commit)
       via  0a57cfb13b91ba1bef7fe3c1e26d402a0fc63807 (commit)
       via  f36e38d8992cac971f50a80074fae4072def7f2d (commit)
      from  b123029a18cb75e53d48d7be968f99a78ba688bb (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 dee5760083240743043639aece795d3fcaaa94c3
Merge: b123029a1 0a57cfb13
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 11:46:44 2026 -0700

    Merge branch 'bug-4720-part1-move-atan2-to-trigi'


-----------------------------------------------------------------------

Summary of changes:
 src/comm2.lisp    | 212 ------------------------------------------------------
 src/limit.lisp    |   3 -
 src/maxima.system |   3 +-
 src/mutils.lisp   |   9 +++
 src/trigi.lisp    | 208 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 219 insertions(+), 216 deletions(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles updated. branch-5_49-base-421-g777848aa6

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles has been updated
       via  777848aa6455934fca7f46c88aa7f3d8c584abb0 (commit)
       via  2313b77146f9e596450957bf5442c918465d204b (commit)
       via  292dd91d1c6da8e1755b306f892f84147a3cad86 (commit)
      from  1afa87ef875f87e688702cb365b0ba1b204853b0 (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 777848aa6455934fca7f46c88aa7f3d8c584abb0
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 11:11:08 2026 -0700

    Update dependencies for hayat and trigi
    
    hayat.lisp needs multiplep, so taylor-series module depends on
    simp-utilities module.
    
    And since the circular dependency between hayat and trigi has been
    broken, the trigonometry module can depend on taylor-series because
    trigi uses $taylorinfo.

diff --git a/src/maxima.system b/src/maxima.system
index 45f7ea1d9..02d5acd4f 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -772,7 +772,8 @@
 	    :depends-on ("globals" "defmfun" "compatibility-macros"
                                    "compatibility-macros1" "declarations"
                                    "destructuring-let" "fundamental-macros"
-                                   "other-macros" "prerequisites" "rat-macros" "errset")
+                                   "other-macros" "prerequisites" "rat-macros" "errset"
+                                   "simp-utilities")
 	    :components ((:file "hayat")))
    (:module definite-integration :source-pathname ""
 	    :depends-on ("globals" "defmfun" "declarations" "destructuring-let"
@@ -785,7 +786,8 @@
 	    :depends-on ("globals" "pattern-matching" "defmfun"
                                    "compatibility-macros" "declarations"
                                    "errset" "fundamental-macros" "other-macros"
-                                   "prerequisites" "utility-macros")
+                                   "prerequisites" "utility-macros"
+                                   "taylor-series")
 	    :components
 	    ((:file "trigi")
 	     (:file "trigo")

commit 2313b77146f9e596450957bf5442c918465d204b
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 11:00:51 2026 -0700

    Move multiplep from trigi to simp-util
    
    This breaks the circular dependency between trigi (which defined it)
    and hayat which used it.  But trigi calls $taylorinfo from hayat.
    Hence, the circular dependency.
    
    By moving multiplep out of trigi, hayat no longer depends on trigi.

diff --git a/src/simp-utils.lisp b/src/simp-utils.lisp
index b61e3dacb..a40ed0d5e 100644
--- a/src/simp-utils.lisp
+++ b/src/simp-utils.lisp
@@ -125,3 +125,9 @@
 	   (return nil)))))
 
 
+;; Check if EXP is a multiple of VAR.
+(defun multiplep (exp var)
+  (and (not (zerop1 exp))
+       (zerop1 (sub exp
+                    (mul var (coeff exp var 1))))))
+
diff --git a/src/trigi.lisp b/src/trigi.lisp
index b4d81f7c0..ea65bf54e 100644
--- a/src/trigi.lisp
+++ b/src/trigi.lisp
@@ -903,9 +903,6 @@
 	   (div (mod x mod) d)))
 	(t nil)))
 
-(defun multiplep (exp var)
-  (and (not (zerop1 exp)) (zerop1 (sub exp (mul var (coeff exp var 1))))))
-
 (defun linearp (exp var)
   (and (setq exp (islinear exp var)) (not (equal (car exp) 0))))
 

commit 292dd91d1c6da8e1755b306f892f84147a3cad86
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 10:49:10 2026 -0700

    simp-utilities depends on defmfun
    
    There are a few defmfun's in this module.

diff --git a/src/maxima.system b/src/maxima.system
index 5c9ea7a57..45f7ea1d9 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -250,7 +250,7 @@
             ;; function calls.  Can't really do anything about that.
             ;; and can't depend on those modules because that causes a
             ;; circular dependency.
-            :depends-on ("prerequisites")
+            :depends-on ("prerequisites" "defmfun")
             :components
             ((:file "simp-utils")
              (:file "mopers")

-----------------------------------------------------------------------

Summary of changes:
 src/maxima.system   | 8 +++++---
 src/simp-utils.lisp | 6 ++++++
 src/trigi.lisp      | 3 ---
 3 files changed, 11 insertions(+), 6 deletions(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles updated. branch-5_49-base-418-g1afa87ef8

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles has been updated
       via  1afa87ef875f87e688702cb365b0ba1b204853b0 (commit)
      from  5cb2f3ca9dbfd0621e38e3de9ed452a750abc9ee (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 1afa87ef875f87e688702cb365b0ba1b204853b0
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 10:36:59 2026 -0700

    More fixes for circular dependencies
    
    Moved more items to simp-utils:
    
    * ratdisrep from simp.lisp
    * like from compar.lisp
    * alike from simp.lisp
    
    I believe this breaks any circular dependency between the files in
    simp-utilities.
    
    There are still dependencies to other functions like $ratdisrep and
    $outofpois in other modules.  Can't really do anything about that
    right now.  Those functions naturally should stay where they are.
    
    Maxima builds and testsuite passes.

diff --git a/src/compar.lisp b/src/compar.lisp
index 31adb47a9..a63cbf2ba 100644
--- a/src/compar.lisp
+++ b/src/compar.lisp
@@ -975,9 +975,6 @@ TDNEG TDZERO TDPN) to store it, and also sets SIGN."
           ((eq '$nz sgn) (daddgq nil (neg x))))))
     (setf *local-signs* nil)))
 
-(defun like (x y)
-  (alike1 (specrepcheck x) (specrepcheck y)))
-
 (setf (get '$und 'sysconst) t)
 (setf (get '$ind 'sysconst) t)
 (setf (get '$zeroa 'sysconst) t)
diff --git a/src/maxima.system b/src/maxima.system
index 9efde8b83..5c9ea7a57 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -245,6 +245,11 @@
              (:file "mopers")
 	     (:file "mforma")))
    (:module simp-utilities :source-pathname ""
+            ;; There are other dependencies.  We call $ratdisrep,
+            ;; $outofpois, $ratsimp and others.  These are all
+            ;; function calls.  Can't really do anything about that.
+            ;; and can't depend on those modules because that causes a
+            ;; circular dependency.
             :depends-on ("prerequisites")
             :components
             ((:file "simp-utils")
@@ -252,7 +257,7 @@
              (:file "opers"
                     :depends-on ("mopers"))
              (:file "mutils"
-                    :depends-on "simp-utils")
+                    :depends-on ("simp-utils"))
              (:file "simp"
                     :depends-on ("simp-utils" "opers" "mopers" "mutils"))))
    ;; This contains the reader macro #$...$ so we want io compile this
diff --git a/src/simp-utils.lisp b/src/simp-utils.lisp
index 5b446311a..b61e3dacb 100644
--- a/src/simp-utils.lisp
+++ b/src/simp-utils.lisp
@@ -21,9 +21,32 @@
     ((numberp x) (zerop x))
     (($bfloatp x) (= 0 (cadr x)))))
 
+(defun ratdisrep (e)
+  (simplifya (locally 
+                 (declare (notinline $ratdisrep))
+               ($ratdisrep e))
+             nil))
+
+(defun specdisrep (e)
+  (cond ((eq (caar e) 'mrat)
+         (ratdisrep e))
+	(t
+         (locally
+             (declare (notinline $outofpois))
+           ($outofpois e)))))
+
+(defun specrepcheck (e)
+  (if (specrepp e)
+      (specdisrep e)
+      e))
+
+
 ;; Compares two Macsyma expressions ignoring SIMP flags and all other
 ;; items in the header except for the ARRAY flag.
 
+(defun like (x y)
+  (alike1 (specrepcheck x) (specrepcheck y)))
+
 ;; Trivial function used only in ALIKE1.
 ;; Should be defined as an open-codable subr.
 
@@ -94,9 +117,11 @@
         (t nil)
         ))
 
-(defun specrepcheck (e) (if (specrepp e) (specdisrep e) e))
+;; Maps ALIKE1 down two lists.
+
+(defun alike (x y)
+  (do ((x x (cdr x)) (y y (cdr y))) ((atom x) (equal x y))
+    (cond ((or (atom y) (not (alike1 (car x) (car y))))
+	   (return nil)))))
 
-(defun specdisrep (e)
-  (cond ((eq (caar e) 'mrat) (ratdisrep e))
-	(t ($outofpois e))))
 
diff --git a/src/simp.lisp b/src/simp.lisp
index 42daa02e6..2a8415eb4 100644
--- a/src/simp.lisp
+++ b/src/simp.lisp
@@ -102,8 +102,6 @@
 (defprop $equal t binary)
 (defprop $notequal t binary)
 
-(defun ratdisrep (e) (simplifya ($ratdisrep e) nil))
-
 (defun sratsimp (e) (simplifya ($ratsimp e) nil))
 
 (defun simpcheck (e flag)
@@ -2817,13 +2815,6 @@
     (alike1 (mfuncall '$arrayinfo x) (mfuncall '$arrayinfo y))
     (alike1 ($listarray x) ($listarray y))))
 
-;; Maps ALIKE1 down two lists.
-
-(defun alike (x y)
-  (do ((x x (cdr x)) (y y (cdr y))) ((atom x) (equal x y))
-    (cond ((or (atom y) (not (alike1 (car x) (car y))))
-	   (return nil)))))
-
 (defun ordfna (e a)			; A is an atom
   (cond ((numberp a)
 	 (or (not (eq (caar e) 'rat))

-----------------------------------------------------------------------

Summary of changes:
 src/compar.lisp     |  3 ---
 src/maxima.system   |  7 ++++++-
 src/simp-utils.lisp | 33 +++++++++++++++++++++++++++++----
 src/simp.lisp       |  9 ---------
 4 files changed, 35 insertions(+), 17 deletions(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles updated. branch-5_49-base-417-g5cb2f3ca9

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles has been updated
       via  5cb2f3ca9dbfd0621e38e3de9ed452a750abc9ee (commit)
      from  a4b6ce46dd8df13abdafd0b467535a18ef5c6704 (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 5cb2f3ca9dbfd0621e38e3de9ed452a750abc9ee
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 09:57:43 2026 -0700

    Break circular dependency between simp and mutils
    
    The functions that were causing a circular dependency between simp and
    mutils have been moved to simp-utils.lisp.  This includes zerop1,
    memqarr, alike1 and support functions, specrepcheck, and specdisrep.
    
    Also moved $bfloatp from mutils-fn to simp-utils because zerop1 uses
    $bfloatp.
    
    Update dependencies in maxima.system and remove comment about circular
    dependency.  (I think all the circular dependencies are gone.)

diff --git a/src/maxima.system b/src/maxima.system
index 07d3382cc..9efde8b83 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -251,14 +251,10 @@
              (:file "mopers")
              (:file "opers"
                     :depends-on ("mopers"))
-             ;; NOTE: There is a circular dependency between mutils
-             ;; and simp.  mutils calls ALIKE1 from simp, and simp
-             ;; calls AMONG, ZEROP1 from mutils.  These should be
-             ;; fixed, but since this is all in this module, it
-             ;; doesn't matter too much right now.
-             (:file "mutils")
+             (:file "mutils"
+                    :depends-on "simp-utils")
              (:file "simp"
-                    :depends-on ("opers" "mopers" "mutils"))))
+                    :depends-on ("simp-utils" "opers" "mopers" "mutils"))))
    ;; This contains the reader macro #$...$ so we want io compile this
    ;; as early as possible before anything uses it.
    (:module reader :source-pathname ""
diff --git a/src/mutils-fn.lisp b/src/mutils-fn.lisp
index 4cd375efe..acc8badbc 100644
--- a/src/mutils-fn.lisp
+++ b/src/mutils-fn.lisp
@@ -66,12 +66,6 @@
 	   (integerp (cadr x))
 	   (integerp (cddr x)))))
 
-(defmfun ($bfloatp :inline-impl t) (x)
-  "Returns true if X is a bigfloat"
-  (and (consp x)
-       (consp (car x))
-       (eq (caar x) 'bigfloat)))
-
 (defmfun $floatnump (x)
   (or (floatp x)
       (and ($ratp x) (floatp (cadr x)) (onep1 (cddr x)))))
diff --git a/src/mutils.lisp b/src/mutils.lisp
index c0e1badff..2a11c50ba 100644
--- a/src/mutils.lisp
+++ b/src/mutils.lisp
@@ -190,13 +190,6 @@
       (and (not (atom x)) (not (atom (car x)))
 	   (member (caar x) '(rat bigfloat)) t)))
 
-(declaim (inline zerop1))
-(defun zerop1 (x)
-  "Returns non-NIL if X is Lisp number or bfloat that is equal to 0"
-  (cond
-    ((numberp x) (zerop x))
-    (($bfloatp x) (= 0 (cadr x)))))
-
 (defun bigfloat-one-p (x)
   "Returns T if X, assumed to be a bigfloat, represents the value 1."
   ;; Binary bigfloat ones are of the form '((BIGFLOAT [SIMP] <P>) 2^(<P>-1) 1).
diff --git a/src/simp-utils.lisp b/src/simp-utils.lisp
index b4d6dcdc8..5b446311a 100644
--- a/src/simp-utils.lisp
+++ b/src/simp-utils.lisp
@@ -3,6 +3,100 @@
 
 (in-package :maxima)
 
+;; These are common utililites needed by both simp.lisp and mutils.lisp.
+
 (defun delsimp (e)
   (remove 'simp e))
 
+(defmfun ($bfloatp :inline-impl t) (x)
+  "Returns true if X is a bigfloat"
+  (and (consp x)
+       (consp (car x))
+       (eq (caar x) 'bigfloat)))
+
+(declaim (inline zerop1))
+(defun zerop1 (x)
+  "Returns non-NIL if X is Lisp number or bfloat that is equal to 0"
+  (cond
+    ((numberp x) (zerop x))
+    (($bfloatp x) (= 0 (cadr x)))))
+
+;; Compares two Macsyma expressions ignoring SIMP flags and all other
+;; items in the header except for the ARRAY flag.
+
+;; Trivial function used only in ALIKE1.
+;; Should be defined as an open-codable subr.
+
+(defmacro memqarr (l)
+  `(if (member-eq 'array ,l) t))
+
+(defun lisp-vector-alike1 (x y)
+  (let ((lx (length x)))
+    (when (eql lx (length y))
+      (lisp-array-elements-alike1 x y lx))))
+
+(defun lisp-array-alike1 (x y)
+  (when (equal (array-dimensions x) (array-dimensions y))
+    (lisp-array-elements-alike1 x y (array-total-size x))))
+
+(defun lisp-array-elements-alike1 (x y n)
+  (dotimes (i n t)
+    (unless (alike1 (row-major-aref x i) (row-major-aref y i))
+      (return-from lisp-array-elements-alike1 nil))))
+
+(defun alike1 (x y)
+  ;; Clauses are ordered based on frequency of the case
+  ;; cons, integer, and symbol are very common
+  ;; everything else is rare
+  (cond ((eq x y) t)
+        ((consp x)
+         (let (car-x car-y op)
+         (if (and (consp y)
+                  (not (atom (setq car-x (car x))))
+                  (not (atom (setq car-y (car y))))
+                  (eq (setq op (car car-x)) (car car-y)))
+             (cond
+              ((eq op 'mrat) (like x y))
+              ((eq op 'mpois) (equal (cdr x) (cdr y)))
+              ((eq op 'bigfloat)
+                ;; Bigfloats need special treatment because their precision
+                ;; and an optional DECIMAL flag are stored in the CAR,
+                ;; which would otherwise be ignored.
+                ;; A bigfloat looks like this, [...] means optional:
+                ;; ((BIGFLOAT [SIMP] <PRECISION> [DECIMAL]) <MANTISSA> <EXPONENT>)
+                ;; Compare mantissas and exponents first.
+                (when (and (= (cadr x) (cadr y)) (= (caddr x) (caddr y)))
+                  ;; Mantissas and exponents are the same.
+                  ;; If the CARs are EQ (see BCONS), we're done. Otherwise, we
+                  ;; still need to compare precision and maybe radix (binary/decimal).
+                  ;; If there's a SIMP flag, it must be ignored.
+                  (if (eq car-x car-y)
+                  t
+                  (let ((rest-x (if (eq 'simp (cadar x)) (cddar x) (cdar x)))
+                        (rest-y (if (eq 'simp (cadar y)) (cddar y) (cdar y))))
+                    (and (= (car rest-x) (car rest-y))
+                         (eq (cadr rest-x) (cadr rest-y)))))))
+              ;; General case: First check for CARs being EQ (see EQTEST).
+              ;; If not, just check whether both have or don't have the ARRAY flag.
+              ((or (eq car-x car-y) (eq (memqarr (cdar x)) (memqarr (cdar y))))
+               (alike (cdr x) (cdr y)))
+              (t nil))
+           ;; (foo) and (foo) test non-alike because the car's aren't standard
+           nil)))
+        ((consp y) nil)
+        ((or (symbolp x) (symbolp y)) nil)
+        ((integerp x) (and (integerp y) (= x y)))
+        ;; uncommon cases from here down
+        ((floatp x) (and (floatp y) (= x y)))
+        ((stringp x) (and (stringp y) (string= x y)))
+        ((vectorp x) (and (vectorp y) (lisp-vector-alike1 x y)))
+        ((arrayp x) (and (arrayp y) (lisp-array-alike1 x y)))
+        (t nil)
+        ))
+
+(defun specrepcheck (e) (if (specrepp e) (specdisrep e) e))
+
+(defun specdisrep (e)
+  (cond ((eq (caar e) 'mrat) (ratdisrep e))
+	(t ($outofpois e))))
+
diff --git a/src/simp.lisp b/src/simp.lisp
index 08863ffdd..42daa02e6 100644
--- a/src/simp.lisp
+++ b/src/simp.lisp
@@ -116,18 +116,12 @@
 
 (defun mratcheck (e) (if ($ratp e) (ratdisrep e) e))
 
-(defun specrepcheck (e) (if (specrepp e) (specdisrep e) e))
-
 ;; Note that the following two functions are carefully coupled.
 
 (defun specrepp (e)
   (and (not (atom e))
        (member (caar e) '(mrat mpois)) t))
 
-(defun specdisrep (e)
-  (cond ((eq (caar e) 'mrat) (ratdisrep e))
-	(t ($outofpois e))))
-
 (defun constant (x)
   (cond ((symbolp x) (kindp x '$constant))
 	(($subvarp x)
@@ -2806,79 +2800,6 @@
 		   ((not (alike1 (car x1) (car y1)))
 		    (return (great (car x1) (car y1)))))))))
 
-;; Trivial function used only in ALIKE1.
-;; Should be defined as an open-codable subr.
-
-(defmacro memqarr (l)
-  `(if (member-eq 'array ,l) t))
-
-;; Compares two Macsyma expressions ignoring SIMP flags and all other
-;; items in the header except for the ARRAY flag.
-
-(defun alike1 (x y)
-  ;; Clauses are ordered based on frequency of the case
-  ;; cons, integer, and symbol are very common
-  ;; everything else is rare
-  (cond ((eq x y) t)
-        ((consp x)
-         (let (car-x car-y op)
-         (if (and (consp y)
-                  (not (atom (setq car-x (car x))))
-                  (not (atom (setq car-y (car y))))
-                  (eq (setq op (car car-x)) (car car-y)))
-             (cond
-              ((eq op 'mrat) (like x y))
-              ((eq op 'mpois) (equal (cdr x) (cdr y)))
-              ((eq op 'bigfloat)
-                ;; Bigfloats need special treatment because their precision
-                ;; and an optional DECIMAL flag are stored in the CAR,
-                ;; which would otherwise be ignored.
-                ;; A bigfloat looks like this, [...] means optional:
-                ;; ((BIGFLOAT [SIMP] <PRECISION> [DECIMAL]) <MANTISSA> <EXPONENT>)
-                ;; Compare mantissas and exponents first.
-                (when (and (= (cadr x) (cadr y)) (= (caddr x) (caddr y)))
-                  ;; Mantissas and exponents are the same.
-                  ;; If the CARs are EQ (see BCONS), we're done. Otherwise, we
-                  ;; still need to compare precision and maybe radix (binary/decimal).
-                  ;; If there's a SIMP flag, it must be ignored.
-                  (if (eq car-x car-y)
-                  t
-                  (let ((rest-x (if (eq 'simp (cadar x)) (cddar x) (cdar x)))
-                        (rest-y (if (eq 'simp (cadar y)) (cddar y) (cdar y))))
-                    (and (= (car rest-x) (car rest-y))
-                         (eq (cadr rest-x) (cadr rest-y)))))))
-              ;; General case: First check for CARs being EQ (see EQTEST).
-              ;; If not, just check whether both have or don't have the ARRAY flag.
-              ((or (eq car-x car-y) (eq (memqarr (cdar x)) (memqarr (cdar y))))
-               (alike (cdr x) (cdr y)))
-              (t nil))
-           ;; (foo) and (foo) test non-alike because the car's aren't standard
-           nil)))
-        ((consp y) nil)
-        ((or (symbolp x) (symbolp y)) nil)
-        ((integerp x) (and (integerp y) (= x y)))
-        ;; uncommon cases from here down
-        ((floatp x) (and (floatp y) (= x y)))
-        ((stringp x) (and (stringp y) (string= x y)))
-        ((vectorp x) (and (vectorp y) (lisp-vector-alike1 x y)))
-        ((arrayp x) (and (arrayp y) (lisp-array-alike1 x y)))
-        (t nil)
-        ))
-
-(defun lisp-vector-alike1 (x y)
-  (let ((lx (length x)))
-    (when (eql lx (length y))
-      (lisp-array-elements-alike1 x y lx))))
-
-(defun lisp-array-alike1 (x y)
-  (when (equal (array-dimensions x) (array-dimensions y))
-    (lisp-array-elements-alike1 x y (array-total-size x))))
-
-(defun lisp-array-elements-alike1 (x y n)
-  (dotimes (i n t)
-    (unless (alike1 (row-major-aref x i) (row-major-aref y i))
-      (return-from lisp-array-elements-alike1 nil))))
-
 ;; Not sure if we want to enable comparison of maxima arrays.
 ;; Aside from that, add2lnc calls alike1 (via memalike) and that causes trouble.
 ;; Possible code for ALIKE1 to enable such comparisons should we choose to do so:

-----------------------------------------------------------------------

Summary of changes:
 src/maxima.system   | 10 ++----
 src/mutils-fn.lisp  |  6 ----
 src/mutils.lisp     |  7 ----
 src/simp-utils.lisp | 94 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/simp.lisp       | 79 --------------------------------------------
 5 files changed, 97 insertions(+), 99 deletions(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles updated. branch-5_49-base-416-ga4b6ce46d

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles has been updated
       via  a4b6ce46dd8df13abdafd0b467535a18ef5c6704 (commit)
       via  0f0ec31b52b863d211e119d66e8539c0117c97a2 (commit)
      from  f10fe1f89564e15a990bae3c39b447da51c0633e (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 a4b6ce46dd8df13abdafd0b467535a18ef5c6704
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 09:37:30 2026 -0700

    Comment about circular dependency between mutils and simp
    
    Maxima builds from scratch fine.

diff --git a/src/maxima.system b/src/maxima.system
index b7bdc4777..07d3382cc 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -251,6 +251,11 @@
              (:file "mopers")
              (:file "opers"
                     :depends-on ("mopers"))
+             ;; NOTE: There is a circular dependency between mutils
+             ;; and simp.  mutils calls ALIKE1 from simp, and simp
+             ;; calls AMONG, ZEROP1 from mutils.  These should be
+             ;; fixed, but since this is all in this module, it
+             ;; doesn't matter too much right now.
              (:file "mutils")
              (:file "simp"
                     :depends-on ("opers" "mopers" "mutils"))))

commit 0f0ec31b52b863d211e119d66e8539c0117c97a2
Author: Raymond Toy <toy...@gm...>
Date:   Wed Apr 22 09:23:56 2026 -0700

    Move more things into simp-utilities module
    
    We move files into the simp-utilities module to get them defined early
    because we need them.  This means opers, mopers, and mutils.
    
    However, simp and mutils have defmfun's in them.  That makes things
    even more circular, so move all the defmfuns from simp and mutils to
    simp-fn and mutils-fn.  These files are in the original modules that
    previously had simp and mutils.
    
    But that's not enough to get a working build.
    
    * simp uses member-eq so move that from mutils to simp.
    * Move while from utils to simp because member-eq needs the while
      macro.
    * simp also uses coeff so move that from comm.lisp.
    * simp also uses among so put that in mutils which seems like the
      natural place assol and assolike live ther. Since simp depends on
      mutils this works out.
    
    Update maxima.system for the new files and dependencies.
    
    There are still circular dependencies between simp and mutils
    including
    
    * simp uses zerop1, among, while from mutils.lisp
    * mutils uses alike1 from simp.
    
    We're leaving this for now since these are all self-contained in the
    module.  These should be fixed someday.

diff --git a/src/comm.lisp b/src/comm.lisp
index d1955d7de..61d526a71 100644
--- a/src/comm.lisp
+++ b/src/comm.lisp
@@ -1294,6 +1294,7 @@
       (coeff e x 0)
       (coeff e (power x n) 1)))
 
+#+nil
 (defun coeff (e var pow)
   (simplify
    (cond ((alike1 e var) (if (equal pow 1) 1 0))
diff --git a/src/maxima.system b/src/maxima.system
index 63189d2e6..b7bdc4777 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -241,14 +241,26 @@
 	    :depends-on ("defmfun" "compatibility-macros" "compatibility-macros1"
                                    "prerequisites" "errset")
 	    :components
-	    ((:file "mopers")
+	    (#+nil
+             (:file "mopers")
 	     (:file "mforma")))
+   (:module simp-utilities :source-pathname ""
+            :depends-on ("prerequisites")
+            :components
+            ((:file "simp-utils")
+             (:file "mopers")
+             (:file "opers"
+                    :depends-on ("mopers"))
+             (:file "mutils")
+             (:file "simp"
+                    :depends-on ("opers" "mopers" "mutils"))))
    ;; This contains the reader macro #$...$ so we want io compile this
    ;; as early as possible before anything uses it.
    (:module reader :source-pathname ""
 	    :depends-on ("globals" "defmfun" "compatibility-macros" "compatibility-macros1"
                                    "declarations" "fundamental-macros" "prerequisites"
-                                   "utility-macros")
+                                   "utility-macros"
+                                   "simp-utilities")
 	    :components
 	    ((:file "nparse")))
    (:module other-macros :source-pathname ""
@@ -272,18 +284,18 @@
                                    "compatibility-macros1" "declarations" "fundamental-macros"
                                    "prerequisites")
 	    :components
-	    ((:file "opers")
-	     (:file "utils")
+	    (#+nil
+             (:file "opers")
+             (:file "utils")
 	     (:file "sumcon")
 	     (:file "sublis")
 	     (:file "merror")
 	     (:file "mformt")
-	     (:file "mutils")
+	     #+nil
+             (:file "mutils")
+             (:file "mutils-fn")
 	     (:file "outmis")
 	     (:file "ar")))
-   (:module simp-utilities :source-pathname ""
-            :components
-            ((:file "simp-utils")))
    (:module commands :source-pathname ""
 	    :depends-on ("globals" "defmfun" "compatibility-macros" "compatibility-macros1"
                                    "declarations" "fundamental-macros" "prerequisites"
@@ -590,7 +602,9 @@
                                    "numerical-utilities"
                                    "simp-utilities")
 	    :components
-	    ((:file "simp")
+	    (#+nil
+             (:file "simp")
+             (:file "simp-fn")
 	     (:file "float")
 	     (:file "csimp")
 	     (:file "csimp2")
diff --git a/src/mutils-fn.lisp b/src/mutils-fn.lisp
new file mode 100644
index 000000000..4cd375efe
--- /dev/null
+++ b/src/mutils-fn.lisp
@@ -0,0 +1,107 @@
+;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package :maxima)
+
+;;; This function searches for the key in the left hand side of the input list
+;;; of the form [x,y,z...] where each of the list elements is a expression of
+;;; a binary operand and 2 elements.  For example x=1, 2^3, [a,b] etc.
+;;; The key checked against the first operand and and returns the second
+;;; operand if the key is found.
+;;; If the key is not found it either returns the default value if supplied or
+;;; false.
+;;; Author Dan Stanger 12/1/02
+
+(defmfun $assoc (key ielist &optional default)
+  (let ((elist (if (listp ielist)
+                   (margs ielist)
+                   (merror 
+                     (intl:gettext "assoc: second argument must be a nonatomic expression; found: ~:M") 
+                     ielist)))
+        found)
+    (dolist (i elist)
+      (unless (and (listp i) (= 3 (length i)))
+        (merror (intl:gettext "assoc: elements of the second argument must be an expression of two parts; found: ~:M") i))
+      (when (alike1 key (second i))
+        (setq found i)
+        (return)))
+    (if found (third found) default)))
+
+;;; Return a Maxima gensym.
+;;;
+;;; N.B. Maxima gensyms are interned, so they are not Lisp gensyms.
+;;; This function can return the same symbol multiple times, it can
+;;; return a symbol that was created and used elsewhere, etc.  I (kjak)
+;;; do not think any of this is correct for a function named gensym.
+;;;
+;;; Maxima produces some expressions that contain Maxima gensyms, so
+;;; the use of uninterned symbols instead can cause confusion since
+;;; these print like any other symbol when lispdisp=false (the default).
+(defmfun $gensym (&optional x)
+  (typecase x
+    (null
+     (intern (symbol-name (gensym "$G")) :maxima))
+    (string
+     (intern
+       (symbol-name (gensym (format nil "$~a" (maybe-invert-string-case x))))
+       :maxima))
+    ((integer 0)
+     (let ((*gensym-counter* x))
+       (intern (symbol-name (gensym "$G")) :maxima)))
+    (t
+     (merror
+       (intl:gettext
+         "gensym: Argument must be a nonnegative integer or a string. Found: ~M") x))))
+
+(defmfun ($ratp :inline-impl t) (x)
+  (and (not (atom x))
+       (consp (car x))
+       (eq (caar x) 'mrat)))
+
+(defmfun $ratnump (x)
+  (or (integerp x)
+      (ratnump x)
+      (and ($ratp x)
+	   (not (member-eq 'trunc (car x)))
+	   (integerp (cadr x))
+	   (integerp (cddr x)))))
+
+(defmfun ($bfloatp :inline-impl t) (x)
+  "Returns true if X is a bigfloat"
+  (and (consp x)
+       (consp (car x))
+       (eq (caar x) 'bigfloat)))
+
+(defmfun $floatnump (x)
+  (or (floatp x)
+      (and ($ratp x) (floatp (cadr x)) (onep1 (cddr x)))))
+
+(defmfun $numberp (x)
+  "Returns true if X is a Maxima rational, a float, or a bigfloat number"
+  (or ($ratnump x) ($floatnump x) ($bfloatp x)))
+
+(defmfun $integerp (x)
+  (or (integerp x)
+      (and ($ratp x)
+	   (not (member-eq 'trunc (car x)))
+	   (integerp (cadr x))
+	   (equal (cddr x) 1))))
+
+;; The call to $INTEGERP in the following two functions checks for a CRE
+;; rational number with an integral numerator and a unity denominator.
+
+(defmfun ($oddp :inline-impl t) (x)
+  (cond ((integerp x) (oddp x))
+	((atom x) nil)
+	(($integerp x) (oddp (cadr x)))))
+
+(defmfun ($evenp :inline-impl t) (x)
+  (cond ((integerp x) (evenp x))
+	((atom x) nil)
+	(($integerp x) (not (oddp (cadr x))))))
+
+(defmfun $taylorp (x)
+  (and (not (atom x))
+       (eq (caar x) 'mrat)
+       (member-eq 'trunc (cdar x)) t))
+
diff --git a/src/mutils.lisp b/src/mutils.lisp
index edb03c0ce..c0e1badff 100644
--- a/src/mutils.lisp
+++ b/src/mutils.lisp
@@ -18,29 +18,16 @@
 ;;;
 ;;; Every function in this file is known about externally.
 
-;;; This function searches for the key in the left hand side of the input list
-;;; of the form [x,y,z...] where each of the list elements is a expression of
-;;; a binary operand and 2 elements.  For example x=1, 2^3, [a,b] etc.
-;;; The key checked against the first operand and and returns the second
-;;; operand if the key is found.
-;;; If the key is not found it either returns the default value if supplied or
-;;; false.
-;;; Author Dan Stanger 12/1/02
-
-(defmfun $assoc (key ielist &optional default)
-  (let ((elist (if (listp ielist)
-                   (margs ielist)
-                   (merror 
-                     (intl:gettext "assoc: second argument must be a nonatomic expression; found: ~:M") 
-                     ielist)))
-        found)
-    (dolist (i elist)
-      (unless (and (listp i) (= 3 (length i)))
-        (merror (intl:gettext "assoc: elements of the second argument must be an expression of two parts; found: ~:M") i))
-      (when (alike1 key (second i))
-        (setq found i)
-        (return)))
-    (if found (third found) default)))
+;;; A MEMQ which works at all levels of a piece of list structure.
+;;;
+;;; Note that (AMONG NIL '(A B C)) is T, however.  This could cause bugs.
+;;; > This is false. (AMONG NIL anything) returns NIL always. -kmp
+
+(defun among (x l) 
+  (cond ((null l) nil)
+	((atom l) (eq x l))
+	(t (or (among x (car l)) (among x (cdr l)))))) 
+
 
 ;;; (ASSOL item A-list)
 ;;;
@@ -78,17 +65,6 @@
       ((null l))
     (when (alike1 x (car l)) (return l)))))
 
-(declaim (inline member-eq))
-(defun member-eq (m l)
-  "This function behaves like (MEMBER M L :TEST #'EQ).
-  When inlined, this function is so small that there is almost no code size
-  overhead compared to a MEMBER call, but it is faster because no CALL
-  instruction is required."
-  (while l
-    (when (eq m (car l))
-      (return l))
-    (setq l (cdr l))))
-
 ;;; Return the first duplicate element of the list LIST, or NIL if there
 ;;; are no duplicates present in LIST.  The function KEY is applied to
 ;;; each element of the list before comparison (or uses the element itself
@@ -107,32 +83,6 @@
           (return-from find-duplicate e))
         (push i seen)))))
 
-;;; Return a Maxima gensym.
-;;;
-;;; N.B. Maxima gensyms are interned, so they are not Lisp gensyms.
-;;; This function can return the same symbol multiple times, it can
-;;; return a symbol that was created and used elsewhere, etc.  I (kjak)
-;;; do not think any of this is correct for a function named gensym.
-;;;
-;;; Maxima produces some expressions that contain Maxima gensyms, so
-;;; the use of uninterned symbols instead can cause confusion since
-;;; these print like any other symbol when lispdisp=false (the default).
-(defmfun $gensym (&optional x)
-  (typecase x
-    (null
-     (intern (symbol-name (gensym "$G")) :maxima))
-    (string
-     (intern
-       (symbol-name (gensym (format nil "$~a" (maybe-invert-string-case x))))
-       :maxima))
-    ((integer 0)
-     (let ((*gensym-counter* x))
-       (intern (symbol-name (gensym "$G")) :maxima)))
-    (t
-     (merror
-       (intl:gettext
-         "gensym: Argument must be a nonnegative integer or a string. Found: ~M") x))))
-
 ;; Does X or a subexpression match PREDICATE?
 ;;
 ;; If X is a tree then we recurse depth-first down its arguments. The specrep
@@ -240,25 +190,6 @@
       (and (not (atom x)) (not (atom (car x)))
 	   (member (caar x) '(rat bigfloat)) t)))
 
-(defmfun ($ratp :inline-impl t) (x)
-  (and (not (atom x))
-       (consp (car x))
-       (eq (caar x) 'mrat)))
-
-(defmfun $ratnump (x)
-  (or (integerp x)
-      (ratnump x)
-      (and ($ratp x)
-	   (not (member-eq 'trunc (car x)))
-	   (integerp (cadr x))
-	   (integerp (cddr x)))))
-
-(defmfun ($bfloatp :inline-impl t) (x)
-  "Returns true if X is a bigfloat"
-  (and (consp x)
-       (consp (car x))
-       (eq (caar x) 'bigfloat)))
-
 (declaim (inline zerop1))
 (defun zerop1 (x)
   "Returns non-NIL if X is Lisp number or bfloat that is equal to 0"
@@ -283,34 +214,6 @@
     ((numberp x) (= 1 x))
     (($bfloatp x) (bigfloat-one-p x))))
 
-(defmfun $floatnump (x)
-  (or (floatp x)
-      (and ($ratp x) (floatp (cadr x)) (onep1 (cddr x)))))
-
-(defmfun $numberp (x)
-  "Returns true if X is a Maxima rational, a float, or a bigfloat number"
-  (or ($ratnump x) ($floatnump x) ($bfloatp x)))
-
-(defmfun $integerp (x)
-  (or (integerp x)
-      (and ($ratp x)
-	   (not (member-eq 'trunc (car x)))
-	   (integerp (cadr x))
-	   (equal (cddr x) 1))))
-
-;; The call to $INTEGERP in the following two functions checks for a CRE
-;; rational number with an integral numerator and a unity denominator.
-
-(defmfun ($oddp :inline-impl t) (x)
-  (cond ((integerp x) (oddp x))
-	((atom x) nil)
-	(($integerp x) (oddp (cadr x)))))
-
-(defmfun ($evenp :inline-impl t) (x)
-  (cond ((integerp x) (evenp x))
-	((atom x) nil)
-	(($integerp x) (not (oddp (cadr x))))))
-
 ;; EVEN works for any arbitrary lisp object since it does an integer
 ;; check first.  In other cases, you may want the Lisp EVENP function
 ;; which only works for integers.
@@ -319,11 +222,6 @@
 (defun even (x)
   (and (integerp x) (not (oddp x))))
 
-(defmfun $taylorp (x)
-  (and (not (atom x))
-       (eq (caar x) 'mrat)
-       (member-eq 'trunc (cdar x)) t))
-
 ;; Is there a bfloat anywhere in X?
 (defun some-bfloatp (x)
   (subexpression-matches-p '$bfloatp x))
diff --git a/src/simp-fn.lisp b/src/simp-fn.lisp
new file mode 100644
index 000000000..b16ec5711
--- /dev/null
+++ b/src/simp-fn.lisp
@@ -0,0 +1,139 @@
+;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+
+(in-package :maxima)
+
+(defmfun $polysign (x)
+  (setq x (cadr (ratf x)))
+  (cond ((equal x 0) 0) ((pminusp x) -1) (t 1)))
+
+(defmfun $numfactor (x)
+  (setq x (specrepcheck x))
+  (cond ((mnump x) x)
+	((atom x) 1)
+	((not (eq (caar x) 'mtimes)) 1)
+	((mnump (cadr x)) (cadr x))
+	(t 1)))
+
+(defmfun $constantp (x)
+  (cond ((atom x) (or ($numberp x) (kindp x '$constant)))
+	((member (caar x) '(rat bigfloat)) t)
+	((specrepp x) ($constantp (specdisrep x)))
+	((or (mopp (caar x)) (kindp (caar x) '$constant))
+	 (do ((x (cdr x) (cdr x))) ((null x) t)
+	   (if (not ($constantp (car x))) (return nil))))))
+
+
+(defmfun $scalarp (x) (or (consttermp x) (eq (scalarclass x) '$scalar)))
+
+(defmfun $nonscalarp (x) (eq (scalarclass x) '$nonscalar))
+
+(defmfun ($resimplify :inline-impl t) (expr)
+  "Resimplifies the expression EXPR based on the current environment.
+  This function is useful when the fact database, option variables,
+  or tellsimp rules have changed since the expression was last simplified."
+  (resimplify expr))
+
+(defmfun $sqrt (z)
+  (simplify (list '(%sqrt) z)))
+
+;; Define a verb function $abs
+(defmfun $abs (x)
+  (simplify (list '(mabs) x)))
+
+(defmfun $exp (z)
+  (simplify (list '(%exp) z)))
+
+;; Support a function for code,
+;; which depends on an unsimplified noun form. 
+(defmfun $exp-form (z)
+  (list '(mexpt) '$%e z))
+
+(defmfun $orderlessp (a b)
+  (setq a ($totaldisrep (specrepcheck a))
+        b ($totaldisrep (specrepcheck b)))
+  (and (not (alike1 a b)) (great b a) t))
+
+(defmfun $ordergreatp (a b)
+  (setq a ($totaldisrep (specrepcheck a))
+        b ($totaldisrep (specrepcheck b)))
+  (and (not (alike1 a b)) (great a b) t))
+
+;; Test function to order a and b by magnitude. If it is not possible to
+;; order a and b by magnitude they are ordered by great. This function
+;; can be used by sort, e.g. sort([3,1,7,x,sin(1),minf],ordermagnitudep)
+(defmfun $ordermagnitudep (a b)
+  (let (sgn)
+    (setq a ($totaldisrep (specrepcheck a))
+          b ($totaldisrep (specrepcheck b)))
+    (cond ((and (or (constp a) (member a '($inf $minf)))
+                (or (constp b) (member b '($inf $minf)))
+                (member (setq sgn ($csign (sub b a))) '($pos $neg $zero)))
+           (cond ((eq sgn '$pos) t)
+                 ((eq sgn '$zero) (and (not (alike1 a b)) (great b a)))
+                 (t nil)))
+          ((or (constp a) (member a '($inf $minf))) t)
+          ((or (constp b) (member b '($inf $minf))) nil)
+          (t (and (not (alike1 a b)) (great b a))))))
+
+(defmfun $multthru (e1 &optional e2)
+  (let (arg1 arg2)
+    (cond (e2				;called with two args
+	   (setq arg1 (specrepcheck e1)
+		 arg2 (specrepcheck e2))
+           (cond ((or (atom arg2)
+                      (not (member (caar arg2) '(mplus mequal))))
+		  (mul2 arg1 arg2))
+		 ((eq (caar arg2) 'mequal)
+		  (list (car arg2) ($multthru arg1 (cadr arg2))
+			($multthru arg1 (caddr arg2))))
+		 (t (expandterms arg1 (cdr arg2)))))
+	  (t 				;called with only one arg
+	   (prog (l1)
+	      (setq arg1 (setq arg2 (specrepcheck e1)))
+	      (cond ((atom arg1) (return arg1))
+		    ((eq (caar arg1) 'mnctimes)
+		     (setq arg1 (cdr arg1)) (go nct))
+		    ((not (eq (caar arg1) 'mtimes)) (return arg1)))
+	      (setq arg1 (reverse (cdr arg1)))
+	      times (when (mplusp (car arg1))
+		      (setq l1 (nconc l1 (cdr arg1)))
+		      (return (expandterms (muln l1 t) (cdar arg1))))
+	      (setq l1 (cons (car arg1) l1))
+	      (setq arg1 (cdr arg1))
+	      (if (null arg1) (return arg2))
+	      (go times)
+	      nct  (when (mplusp (car arg1))
+		     (setq l1 (nreverse l1))
+		     (return (addn (mapcar
+				    #'(lambda (u)
+					(simplifya
+					 (cons '(mnctimes) 
+					       (append l1 (ncons u) (cdr arg1)))
+					 t))
+				    (cdar arg1))
+				   t)))
+	      (setq l1 (cons (car arg1) l1))
+	      (setq arg1 (cdr arg1))
+	      (if (null arg1) (return arg2))
+	      (go nct))))))
+
+(defmfun $expand (exp &optional (expop $maxposex) (expon $maxnegex))
+  (expand1 exp expop expon))
+
+;; The following was formerly in SININT.  This code was placed here because
+;; SININT is now an out-of-core file on MC, and this code is needed in-core
+;; because of the various calls to it. - BMT & JPG
+
+(defmfun $integrate (expr x &optional lo hi)
+  (declare (special *in-risch-p* context))
+  (let ($ratfac)
+    (if (not hi)
+	(with-new-context (context)
+	  (if (member '%risch *nounl*)
+	      (if *in-risch-p*
+            ;; Give up; we're being called from RISCHINT by some path.
+            (list '(%integrate) expr x)
+            (rischint expr x))
+	      (sinint expr x)))
+	($defint expr x lo hi))))
+
diff --git a/src/simp.lisp b/src/simp.lisp
index 760e8f679..08863ffdd 100644
--- a/src/simp.lisp
+++ b/src/simp.lisp
@@ -50,6 +50,22 @@
 (defvar *exptrlsw* nil)
 (defvar *expandflag* nil)
 
+(defmacro while (cond &rest body)
+  `(do ()
+       ((not ,cond))
+     ,@body))
+
+(declaim (inline member-eq))
+(defun member-eq (m l)
+  "This function behaves like (MEMBER M L :TEST #'EQ).
+  When inlined, this function is so small that there is almost no code size
+  overhead compared to a MEMBER call, but it is faster because no CALL
+  instruction is required."
+  (while l
+    (when (eq m (car l))
+      (return l))
+    (setq l (cdr l))))
+
 (defprop mnctimes t associative)
 (defprop lambda t lisp-no-simp)
 
@@ -112,26 +128,6 @@
   (cond ((eq (caar e) 'mrat) (ratdisrep e))
 	(t ($outofpois e))))
 
-(defmfun $polysign (x)
-  (setq x (cadr (ratf x)))
-  (cond ((equal x 0) 0) ((pminusp x) -1) (t 1)))
-
-(defmfun $numfactor (x)
-  (setq x (specrepcheck x))
-  (cond ((mnump x) x)
-	((atom x) 1)
-	((not (eq (caar x) 'mtimes)) 1)
-	((mnump (cadr x)) (cadr x))
-	(t 1)))
-
-(defmfun $constantp (x)
-  (cond ((atom x) (or ($numberp x) (kindp x '$constant)))
-	((member (caar x) '(rat bigfloat)) t)
-	((specrepp x) ($constantp (specdisrep x)))
-	((or (mopp (caar x)) (kindp (caar x) '$constant))
-	 (do ((x (cdr x) (cdr x))) ((null x) t)
-	   (if (not ($constantp (car x))) (return nil))))))
-
 (defun constant (x)
   (cond ((symbolp x) (kindp x '$constant))
 	(($subvarp x)
@@ -143,10 +139,6 @@
   (or (numberp x)
       (and (symbolp x) (kindp x '$constant))))
 
-(defmfun $scalarp (x) (or (consttermp x) (eq (scalarclass x) '$scalar)))
-
-(defmfun $nonscalarp (x) (eq (scalarclass x) '$nonscalar))
-
 (defun scalar-or-constant-p (x flag)
   (if flag (not ($nonscalarp x)) ($scalarp x)))
 
@@ -388,12 +380,6 @@
 
 (defun resimplify (x) (let ((dosimp t)) (simplifya x nil)))
 
-(defmfun ($resimplify :inline-impl t) (expr)
-  "Resimplifies the expression EXPR based on the current environment.
-  This function is useful when the fact database, option variables,
-  or tellsimp rules have changed since the expression was last simplified."
-  (resimplify expr))
-
 (defun unsimplify (x)
   (if (or (atom x) (specrepp x))
       x
@@ -1249,9 +1235,6 @@
 
 (defprop %sqrt simp-sqrt operators)
 
-(defmfun $sqrt (z)
-  (simplify (list '(%sqrt) z)))
-
 (defun simp-sqrt (x y z)
   (oneargcheck x)
   (setq y (list '(mexpt) (cadr x) '((rat simp) 1 2)))
@@ -1290,10 +1273,6 @@
 ;; The abs function distributes over bags.
 (defprop mabs (mlist $matrix mequal) distribute_over)
 
-;; Define a verb function $abs
-(defmfun $abs (x)
-  (simplify (list '(mabs) x)))
-
 ;; The abs function is a simplifying function.
 (defprop mabs simpabs operators)
 
@@ -1664,14 +1643,6 @@
 
 (defprop %exp simp-exp operators)
 
-(defmfun $exp (z)
-  (simplify (list '(%exp) z)))
-
-;; Support a function for code,
-;; which depends on an unsimplified noun form. 
-(defmfun $exp-form (z)
-  (list '(mexpt) '$%e z))
-
 (defun simp-exp (x y z)
   (oneargcheck x)
   (setq y (list '(mexpt) '$%e (cadr x)))
@@ -2746,33 +2717,6 @@
 	((or (floatp r1) (floatp r2)) 0.0)
 	(t 0)))
 
-(defmfun $orderlessp (a b)
-  (setq a ($totaldisrep (specrepcheck a))
-        b ($totaldisrep (specrepcheck b)))
-  (and (not (alike1 a b)) (great b a) t))
-
-(defmfun $ordergreatp (a b)
-  (setq a ($totaldisrep (specrepcheck a))
-        b ($totaldisrep (specrepcheck b)))
-  (and (not (alike1 a b)) (great a b) t))
-
-;; Test function to order a and b by magnitude. If it is not possible to
-;; order a and b by magnitude they are ordered by great. This function
-;; can be used by sort, e.g. sort([3,1,7,x,sin(1),minf],ordermagnitudep)
-(defmfun $ordermagnitudep (a b)
-  (let (sgn)
-    (setq a ($totaldisrep (specrepcheck a))
-          b ($totaldisrep (specrepcheck b)))
-    (cond ((and (or (constp a) (member a '($inf $minf)))
-                (or (constp b) (member b '($inf $minf)))
-                (member (setq sgn ($csign (sub b a))) '($pos $neg $zero)))
-           (cond ((eq sgn '$pos) t)
-                 ((eq sgn '$zero) (and (not (alike1 a b)) (great b a)))
-                 (t nil)))
-          ((or (constp a) (member a '($inf $minf))) t)
-          ((or (constp b) (member b '($inf $minf))) nil)
-          (t (and (not (alike1 a b)) (great b a))))))
-
 (defun evnump (n) (or (even n) (and (ratnump n) (even (cadr n)))))
 (defun odnump (n) (or (and (integerp n) (oddp n))
 		      (and (ratnump n) (oddp (cadr n)))))
@@ -3097,48 +3041,6 @@
         ;; Different mantissa signs, directly compare.
         (> sgn-mant-x sgn-mant-y)))))
 
-(defmfun $multthru (e1 &optional e2)
-  (let (arg1 arg2)
-    (cond (e2				;called with two args
-	   (setq arg1 (specrepcheck e1)
-		 arg2 (specrepcheck e2))
-           (cond ((or (atom arg2)
-                      (not (member (caar arg2) '(mplus mequal))))
-		  (mul2 arg1 arg2))
-		 ((eq (caar arg2) 'mequal)
-		  (list (car arg2) ($multthru arg1 (cadr arg2))
-			($multthru arg1 (caddr arg2))))
-		 (t (expandterms arg1 (cdr arg2)))))
-	  (t 				;called with only one arg
-	   (prog (l1)
-	      (setq arg1 (setq arg2 (specrepcheck e1)))
-	      (cond ((atom arg1) (return arg1))
-		    ((eq (caar arg1) 'mnctimes)
-		     (setq arg1 (cdr arg1)) (go nct))
-		    ((not (eq (caar arg1) 'mtimes)) (return arg1)))
-	      (setq arg1 (reverse (cdr arg1)))
-	      times (when (mplusp (car arg1))
-		      (setq l1 (nconc l1 (cdr arg1)))
-		      (return (expandterms (muln l1 t) (cdar arg1))))
-	      (setq l1 (cons (car arg1) l1))
-	      (setq arg1 (cdr arg1))
-	      (if (null arg1) (return arg2))
-	      (go times)
-	      nct  (when (mplusp (car arg1))
-		     (setq l1 (nreverse l1))
-		     (return (addn (mapcar
-				    #'(lambda (u)
-					(simplifya
-					 (cons '(mnctimes) 
-					       (append l1 (ncons u) (cdr arg1)))
-					 t))
-				    (cdar arg1))
-				   t)))
-	      (setq l1 (cons (car arg1) l1))
-	      (setq arg1 (cdr arg1))
-	      (if (null arg1) (return arg2))
-	      (go nct))))))
-
 ;;  EXPANDEXPT computes the expansion of (x1 + x2 + ... + xm)^n
 ;;  taking a sum and integer power as arguments.
 ;;  Its theory is to recurse down the binomial expansion of
@@ -3290,9 +3192,6 @@
     (merror (intl:gettext "expand: expon must be a nonnegative integer; found: ~M") $expon))
   (resimplify (specrepcheck exp)))
 
-(defmfun $expand (exp &optional (expop $maxposex) (expon $maxnegex))
-  (expand1 exp expop expon))
-
 (defun fixexpand (a)
   (if (not (mplusp a))
       (ncons a)
@@ -3364,23 +3263,6 @@
 				     (atom (cadr simp-in))
 				     (member (caaadr simp-in) '(mplus mtimes rat))))))))))
 
-;; The following was formerly in SININT.  This code was placed here because
-;; SININT is now an out-of-core file on MC, and this code is needed in-core
-;; because of the various calls to it. - BMT & JPG
-
-(defmfun $integrate (expr x &optional lo hi)
-  (declare (special *in-risch-p* context))
-  (let ($ratfac)
-    (if (not hi)
-	(with-new-context (context)
-	  (if (member '%risch *nounl*)
-	      (if *in-risch-p*
-            ;; Give up; we're being called from RISCHINT by some path.
-            (list '(%integrate) expr x)
-            (rischint expr x))
-	      (sinint expr x)))
-	($defint expr x lo hi))))
-
 (defun ratp (a ratp-var)
   (cond ((atom a) t)
 	((member (caar a) '(mplus mtimes))
@@ -3497,3 +3379,21 @@
   (cons '(mlist simp)
 	(mapcar #'(lambda (z) (list '(mequal simp) z (meval z))) l)))
 
+(defun coeff (e var pow)
+  (simplify
+   (cond ((alike1 e var) (if (equal pow 1) 1 0))
+	 ((atom e) (if (equal pow 0) e 0))
+	 ((eq (caar e) 'mexpt)
+	  (cond ((alike1 (cadr e) var)
+		 (if (or (equal pow 0) (not (alike1 (caddr e) pow))) 0 1))
+		((equal pow 0) e)
+		(t 0)))
+	 ((or (eq (caar e) 'mplus) (mbagp e))
+	  (cons (if (eq (caar e) 'mplus) '(mplus) (car e))
+		(mapcar #'(lambda (e) (coeff e var pow)) (cdr e))))
+	 ((eq (caar e) 'mrat) (ratcoeff e var pow))
+         ((equal pow 0) (if (coeff-contains-powers e var) 0 e))
+	 ((eq (caar e) 'mtimes)
+	  (let ((term (if (equal pow 1) var (power var pow))))
+	    (if (memalike term (cdr e)) ($delete term e 1) 0)))
+	 (t 0))))
diff --git a/src/utils.lisp b/src/utils.lisp
index 742632355..46ef11a69 100644
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -20,11 +20,6 @@
 ;;;
 ;;; Every function in this file is known about externally.
 
-(defmacro while (cond &rest body)
-  `(do ()
-       ((not ,cond))
-     ,@body))
-
 (defun maxima-getenv (envvar)
   #+gcl     (si::getenv envvar)
   #+ecl     (si::getenv envvar)
@@ -83,16 +78,6 @@
 (defun xor (a b)
   (or (and (not a) b) (and (not b) a)))
   
-;;; A MEMQ which works at all levels of a piece of list structure.
-;;;
-;;; Note that (AMONG NIL '(A B C)) is T, however.  This could cause bugs.
-;;; > This is false. (AMONG NIL anything) returns NIL always. -kmp
-
-(defun among (x l) 
-  (cond ((null l) nil)
-	((atom l) (eq x l))
-	(t (or (among x (car l)) (among x (cdr l)))))) 
-
 ;;; Similar to AMONG, but takes a list of objects to look for.  If any
 ;;; are found in L, returns T.
 

-----------------------------------------------------------------------

Summary of changes:
 src/comm.lisp      |   1 +
 src/maxima.system  |  37 +++++++++---
 src/mutils-fn.lisp | 107 ++++++++++++++++++++++++++++++++++
 src/mutils.lisp    | 122 ++++----------------------------------
 src/simp-fn.lisp   | 139 ++++++++++++++++++++++++++++++++++++++++++++
 src/simp.lisp      | 168 +++++++++++------------------------------------------
 src/utils.lisp     |  15 -----
 7 files changed, 319 insertions(+), 270 deletions(-)
 create mode 100644 src/mutils-fn.lisp
 create mode 100644 src/simp-fn.lisp


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles updated. branch-5_49-base-414-gf10fe1f89

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles has been updated
       via  f10fe1f89564e15a990bae3c39b447da51c0633e (commit)
      from  6cb9305041dc6fb7f14e2cd064ab4e467c3101d4 (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 f10fe1f89564e15a990bae3c39b447da51c0633e
Author: Raymond Toy <toy...@gm...>
Date:   Tue Apr 21 14:32:54 2026 -0700

    Move delsimp from comm.lisp to simp-utils.lisp
    
    This breaks the circular dependency between nforma.lisp and comm.lisp.
    comm.lisp used nformat-all (via nformat) and that uses delsimp.
    
    A new file simp-utils.lisp holds this function now.  It's placed in
    the new module simp-utilities.  Updated dependencies for all modules
    that used delsimp.

diff --git a/src/comm.lisp b/src/comm.lisp
index 392a2891a..d1955d7de 100644
--- a/src/comm.lisp
+++ b/src/comm.lisp
@@ -726,8 +726,6 @@
 (defun nthelem (n e)
   (car (nthcdr (1- n) e)))
 
-(defun delsimp (e) (remove 'simp e))
-
 (defun remsimp (e)
   (if (atom e) e (cons (delsimp (car e)) (mapcar #'remsimp (cdr e)))))
 
diff --git a/src/maxima.system b/src/maxima.system
index 5e6915042..63189d2e6 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -281,17 +281,22 @@
 	     (:file "mutils")
 	     (:file "outmis")
 	     (:file "ar")))
+   (:module simp-utilities :source-pathname ""
+            :components
+            ((:file "simp-utils")))
    (:module commands :source-pathname ""
 	    :depends-on ("globals" "defmfun" "compatibility-macros" "compatibility-macros1"
                                    "declarations" "fundamental-macros" "prerequisites"
-                                   "utility-macros")
+                                   "utility-macros"
+                                   "simp-utilities")
 	    :components
 	    ((:file "comm")
 	     (:file "comm2")))
    (:module evaluator :source-pathname ""
 	    :depends-on ("globals" "defmfun" "utility-macros" "compatibility-macros"
                                    "compatibility-macros1" "declarations" "destructuring-let"
-                                   "fundamental-macros" "prerequisites" "utilities" "commands")
+                                   "fundamental-macros" "prerequisites" "utilities" "commands"
+                                   "simp-utilities")
 	    :components
 	    ((:file "mlisp")
 	     (:file "mmacro")
@@ -582,7 +587,8 @@
 	    :depends-on ("globals" "defmfun" "reader" "utility-macros" "compatibility-macros"
                                    "compatibility-macros1" "declarations" "destructuring-let"
                                    "fundamental-macros" "i-o" "other-macros" "prerequisites"
-                                   "numerical-utilities")
+                                   "numerical-utilities"
+                                   "simp-utilities")
 	    :components
 	    ((:file "simp")
 	     (:file "float")
@@ -630,7 +636,8 @@
 	    :depends-on ("globals" "defmfun" "rat-macros" "other-macros" 
 			 "compatibility-macros1" "ifactor" "factoring"
                                    "compatibility-macros" "declarations" "destructuring-let"
-                                   "fundamental-macros" "prerequisites" "utilities")
+                                   "fundamental-macros" "prerequisites" "utilities"
+                                   "simp-utilities")
 	    :components
 	    ((:file "rat3a")
 	     (:file "rat3b")
@@ -689,7 +696,8 @@
 	     (:file "intpol")))
    (:module display :source-pathname ""
 	    :depends-on ("globals" "defmfun" "compatibility-macros1" "declarations"
-                                   "fundamental-macros" "prerequisites")
+                                   "fundamental-macros" "prerequisites"
+                                   "simp-utilities")
 	    :components
 	    ((:file "displa")
 	     (:file "nforma")
@@ -791,7 +799,8 @@
 	    :depends-on ("globals" "defmfun" "compatibility-macros1"
                                    "declarations" "evaluator"
                                    "fundamental-macros" "prerequisites"
-                                   "rat-macros")
+                                   "rat-macros"
+                                   "simp-utilities")
 	    :components
 	    ((:file "schatc")
 	     (:file "matcom")
diff --git a/src/simp-utils.lisp b/src/simp-utils.lisp
new file mode 100644
index 000000000..b4d6dcdc8
--- /dev/null
+++ b/src/simp-utils.lisp
@@ -0,0 +1,8 @@
+;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package :maxima)
+
+(defun delsimp (e)
+  (remove 'simp e))
+

-----------------------------------------------------------------------

Summary of changes:
 src/comm.lisp       |  2 --
 src/maxima.system   | 21 +++++++++++++++------
 src/simp-utils.lisp |  8 ++++++++
 3 files changed, 23 insertions(+), 8 deletions(-)
 create mode 100644 src/simp-utils.lisp


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles updated. branch-5_49-base-413-g6cb930504

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles has been updated
       via  6cb9305041dc6fb7f14e2cd064ab4e467c3101d4 (commit)
       via  93c79c8d11b4531b5553133e415745cbc59fc6c5 (commit)
      from  529be2a2bc43fde31d809999ddd3611bee6fffad (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 6cb9305041dc6fb7f14e2cd064ab4e467c3101d4
Author: Raymond Toy <toy...@gm...>
Date:   Tue Apr 21 14:12:02 2026 -0700

    Update dependency:  bessel.lisp needs numeric-utilities

diff --git a/src/maxima.system b/src/maxima.system
index 3fe221eda..5e6915042 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -678,7 +678,8 @@
    (:module numerical-functions :source-pathname ""
 	    :depends-on ("globals" "defmfun" "trigonometry" "algebraic-database" 
                                    "utility-macros" "reader"
-                                   "fundamental-macros" "other-macros" "prerequisites")
+                                   "fundamental-macros" "other-macros" "prerequisites"
+                                   "numerical-utilities")
 	    :components
 	    ((:file "bessel")
 	     (:file "ellipt")

commit 93c79c8d11b4531b5553133e415745cbc59fc6c5
Author: Raymond Toy <toy...@gm...>
Date:   Tue Apr 21 14:08:31 2026 -0700

    Move simp-domain-error to numerical-utilities
    
    That's used all over so numerical-utilities seems to be a good place
    for it.  Also changed how $erf and $erfc are called in
    expintegral.lisp.  We used `ftake` instead.

diff --git a/src/expintegral.lisp b/src/expintegral.lisp
index aa5d80225..aae55b342 100644
--- a/src/expintegral.lisp
+++ b/src/expintegral.lisp
@@ -124,15 +124,6 @@
                                   *expintflag*)))))))
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Global to this file
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun simp-domain-error (&rest args)
-  (if errorsw
-      (throw 'errorsw t)
-      (apply #'merror args)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Part 1: The implementation of the Exponential Integral En
@@ -363,9 +354,9 @@
        ;; We have a half integral order and $expintexpand is not NIL. 
        ;; We expand in a series in terms of the Erfc or Erf function.
        (let ((func (cond ((eq $expintexpand '%erf)
-                          (sub 1 ($erf (power arg '((rat simp) 1 2)))))
+                          (sub 1 (ftake '%erf (power arg '((rat simp) 1 2)))))
                          (t
-                          ($erfc (power arg '((rat simp) 1 2)))))))
+                          (ftake '%erfc (power arg '((rat simp) 1 2)))))))
          (cond
            ((= ratorder 1/2)
             (mul (power '$%pi '((rat simp) 1 2))
diff --git a/src/numerical-utils.lisp b/src/numerical-utils.lisp
index af136ee31..80594b1e9 100644
--- a/src/numerical-utils.lisp
+++ b/src/numerical-utils.lisp
@@ -118,4 +118,13 @@
 
 (defun cpower (x y) ($rectform (power x y)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Utilitye function to signal an error denoting a domain error for
+;; the special functions.  ARGS should be appropriate for MERROR.
+(defun simp-domain-error (&rest args)
+  (if errorsw
+      (throw 'errorsw t)
+      (apply #'merror args)))
+
 

-----------------------------------------------------------------------

Summary of changes:
 src/expintegral.lisp     | 13 ++-----------
 src/maxima.system        |  3 ++-
 src/numerical-utils.lisp |  9 +++++++++
 3 files changed, 13 insertions(+), 12 deletions(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch rtoy-break-dependency-cycles created. branch-5_49-base-411-g529be2a2b

[rtoy <rt...@us...>]

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, rtoy-break-dependency-cycles has been created
        at  529be2a2bc43fde31d809999ddd3611bee6fffad (commit)

- Log -----------------------------------------------------------------
commit 529be2a2bc43fde31d809999ddd3611bee6fffad
Author: Raymond Toy <toy...@gm...>
Date:   Tue Apr 21 12:50:16 2026 -0700

    Move numerical-eval stuff to new file numerical-utils.lisp.
    
    The numerical-eval-p functions from gamma.lisp along with the cmul
    functions from expintegral.lisp have been moved to the new file
    numerical-utils.lisp in the new module numerical-utilities.  This
    breaks the cycle of dependency between gamma.lisp and
    expintegral.lisp.
    
    With the new module, we also move gamma.lisp and expintegral.lisp to a
    new module gamma-expint.  A quick grep for numerical-eval-p shows what
    modules now depend on numerical-utilities so update those dependencies
    too.

diff --git a/src/expintegral.lisp b/src/expintegral.lisp
index 491e49bb3..aa5d80225 100644
--- a/src/expintegral.lisp
+++ b/src/expintegral.lisp
@@ -656,16 +656,6 @@
                (setq *debug-expint-fracmaxit* (max *debug-expint-fracmaxit* i)))
              (return r))))))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Helper functions for Bigfloat numerical evaluation.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun cmul (x y) ($rectform (mul x y)))
-
-(defun cdiv (x y) ($rectform (div x y)))
-
-(defun cpower (x y) ($rectform (power x y)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; We have not changed the above algorithm, but generalized it to handle
 ;;; complex and real Bigfloat numbers. By carefully examination of the
diff --git a/src/gamma.lisp b/src/gamma.lisp
index 68aba8c28..680fc5f4b 100644
--- a/src/gamma.lisp
+++ b/src/gamma.lisp
@@ -84,106 +84,6 @@
 (defmvar $erf_%iargs nil
   "When T erf and erfi simplifies for an imaginary argument.")
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; The following functions test if numerical evaluation has to be done.
-;;; The functions should help to test for numerical evaluation more consistent
-;;; and without complicated conditional tests including more than one or two
-;;; arguments.
-;;;
-;;; The functions take a list of arguments. All arguments have to be a CL or
-;;; Maxima number. If all arguments are numbers we have two cases:
-;;; 1. $numer is T we return T. The function has to be evaluated numerically.
-;;; 2. One of the args is a float or a bigfloat. Evaluate numerically.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Test for numerically evaluation in float precision
-
-(defun float-numerical-eval-p (&rest args)
-  (let ((flag nil))
-    (dolist (ll args)
-      (when (not (float-or-rational-p ll)) 
-        (return-from float-numerical-eval-p nil))
-      (when (floatp ll) (setq flag t)))
-    (if (or $numer flag) t nil)))
-
-;;; Test for numerically evaluation in complex float precision
-
-(defun complex-float-numerical-eval-p (&rest args)
-  "Determine if ARGS consists of numerical values by determining if
-  the real and imaginary parts of each arg are nuemrical (but not
-  bigfloats).  A non-NIL result is returned if at least one of args is
-  a floating-point value or if numer is true.  If the result is
-  non-NIL, it is a list of the arguments reduced via COMPLEX-NUMBER-P"
-  (let (flag values)
-    (dolist (ll args)
-      (multiple-value-bind (bool rll ill)
-          (complex-number-p ll 'float-or-rational-p)
-        (unless bool
-          (return-from complex-float-numerical-eval-p nil))
-        ;; Always save the result from complex-number-p.  But for backward
-        ;; compatibility, only set the flag if any item is a float.
-        (push (add rll (mul ill '$%i)) values)
-        (setf flag (or flag (or (floatp rll) (floatp ill))))))
-    (when (or $numer flag)
-      ;; Return the values in the same order as the args!
-      (nreverse values))))
-
-;;; Test for numerically evaluation in bigfloat precision
-
-(defun bigfloat-numerical-eval-p (&rest args)
-  (let ((flag nil))
-    (dolist (ll args)
-      (when (not (bigfloat-or-number-p ll)) 
-        (return-from bigfloat-numerical-eval-p nil))
-      (when ($bfloatp ll)
-	(setq flag t)))
-    (if (or $numer flag) t nil)))
-
-;;; Test for numerically evaluation in complex bigfloat precision
-
-(defun complex-bigfloat-numerical-eval-p (&rest args)
-  "Determine if ARGS consists of numerical values by determining if
-  the real and imaginary parts of each arg are nuemrical (including
-  bigfloats). A non-NIL result is returned if at least one of args is
-  a floating-point value or if numer is true. If the result is
-  non-NIL, it is a list of the arguments reduced via COMPLEX-NUMBER-P."
-
-  (let (flag values)
-    (dolist (ll args)
-      (multiple-value-bind (bool rll ill)
-          (complex-number-p ll 'bigfloat-or-number-p)
-        (unless bool
-          (return-from complex-bigfloat-numerical-eval-p nil))
-	;; Always save the result from complex-number-p.  But for backward
-	;; compatibility, only set the flag if any item is a bfloat.
-	(push (add rll (mul ill '$%i)) values)
-	(when (or ($bfloatp rll) ($bfloatp ill))
-          (setf flag t))))
-    (when (or $numer flag)
-      ;; Return the values in the same order as the args!
-      (nreverse values))))
-
-;;; Test for numerical evaluation in any precision, real or complex.
-(defun numerical-eval-p (&rest args)
-  (or (apply 'float-numerical-eval-p args)
-      (apply 'complex-float-numerical-eval-p args)
-      (apply 'bigfloat-numerical-eval-p args)
-      (apply 'complex-bigfloat-numerical-eval-p args)))
-
-;;; Check for an integer or a float or bigfloat representation. When we
-;;; have a float or bigfloat representation return the integer value.
-
-(defun integer-representation-p (x)
-  (let ((val nil))
-    (cond ((integerp x) x)
-          ((and (floatp x) (= 0 (nth-value 1 (truncate x))))
-           (nth-value 0 (truncate x)))
-          ((and ($bfloatp x) 
-                (eq ($sign (sub (setq val ($truncate x)) x)) '$zero))
-           val)
-          (t nil))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;;; The changes to the parser to connect the operator !! to double_factorial(z)
 
diff --git a/src/hyp.lisp b/src/hyp.lisp
index 2d3103383..73fae974e 100644
--- a/src/hyp.lisp
+++ b/src/hyp.lisp
@@ -1,6 +1,5 @@
 ;;;  -*- LISP -*-
 ;;;	** (c) Copyright 1979 Massachusetts Institute of Technology **
-
 (in-package :maxima)
 
 ;;; References:
diff --git a/src/maxima.system b/src/maxima.system
index a7228b244..3fe221eda 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -581,7 +581,8 @@
    (:module simplification :source-pathname ""
 	    :depends-on ("globals" "defmfun" "reader" "utility-macros" "compatibility-macros"
                                    "compatibility-macros1" "declarations" "destructuring-let"
-                                   "fundamental-macros" "i-o" "other-macros" "prerequisites")
+                                   "fundamental-macros" "i-o" "other-macros" "prerequisites"
+                                   "numerical-utilities")
 	    :components
 	    ((:file "simp")
 	     (:file "float")
@@ -671,6 +672,9 @@
 	     (:file "evalw")
 	     (:file "trprop")
 	     (:file "mdefun")))
+   (:module numerical-utilities :source-pathname ""
+    :components
+    ((:file "numerical-utils")))
    (:module numerical-functions :source-pathname ""
 	    :depends-on ("globals" "defmfun" "trigonometry" "algebraic-database" 
                                    "utility-macros" "reader"
@@ -759,7 +763,8 @@
 	     (:file "trgred")))
    (:module special-functions :source-pathname ""
 	    :depends-on ("globals" "defmfun" "reader" "utility-macros"
-                                   "other-macros" "rat-macros")
+                                   "other-macros" "rat-macros"
+                                   "numerical-utilities")
 	    :components
 	    ((:file "specfn")))
    (:module matrix-algebra :source-pathname ""
@@ -818,11 +823,17 @@
 	    :components
 	    ((:file "mtrace")
 	     (:file "mdebug")))
+   (:module gamma-expint :source-pathname ""
+    :depends-on ("numerical-utilities")
+    :components
+    ((:file "expintegral")
+     (:file "gamma")))
    (:module miscellaneous :source-pathname ""
 	    :depends-on ("globals" "defmfun" "pattern-matching" "compatibility-macros1"
                                    "reader" "utility-macros" "commands"
                                    "destructuring-let" "errset" "other-macros"
-                                   "rat-macros" "declarations"  "fundamental-macros")
+                                   "rat-macros" "declarations"  "fundamental-macros"
+                                   "numerical-utilities")
 	    :components
 	    ((:file "scs")
 	     (:file "asum")
@@ -840,10 +851,8 @@
 	     (:file "maxmin")
 	     (:file "nummod")
 	     (:file "conjugate")
-	     (:file "expintegral")
-	     (:file "gamma")
-		 (:file "hstep")
-		 (:file "sinc")
+             (:file "hstep")
+             (:file "sinc")
 	     (:file "mstuff")))
    (:module polynomial :source-pathname ""
 	    :depends-on ("defmfun")
diff --git a/src/numerical-utils.lisp b/src/numerical-utils.lisp
new file mode 100644
index 000000000..af136ee31
--- /dev/null
+++ b/src/numerical-utils.lisp
@@ -0,0 +1,121 @@
+;;;;  -*- LISP -*-
+
+;;;; This software has NO WARRANTY, not even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+(in-package :maxima)
+
+;;; Utilities for determining if numerical evaluation should be done.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; The following functions test if numerical evaluation has to be done.
+;;; The functions should help to test for numerical evaluation more consistent
+;;; and without complicated conditional tests including more than one or two
+;;; arguments.
+;;;
+;;; The functions take a list of arguments. All arguments have to be a CL or
+;;; Maxima number. If all arguments are numbers we have two cases:
+;;; 1. $numer is T we return T. The function has to be evaluated numerically.
+;;; 2. One of the args is a float or a bigfloat. Evaluate numerically.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Test for numerically evaluation in float precision
+
+(defun float-numerical-eval-p (&rest args)
+  (let ((flag nil))
+    (dolist (ll args)
+      (when (not (float-or-rational-p ll)) 
+        (return-from float-numerical-eval-p nil))
+      (when (floatp ll) (setq flag t)))
+    (if (or $numer flag) t nil)))
+
+;;; Test for numerically evaluation in complex float precision
+
+(defun complex-float-numerical-eval-p (&rest args)
+  "Determine if ARGS consists of numerical values by determining if
+  the real and imaginary parts of each arg are nuemrical (but not
+  bigfloats).  A non-NIL result is returned if at least one of args is
+  a floating-point value or if numer is true.  If the result is
+  non-NIL, it is a list of the arguments reduced via COMPLEX-NUMBER-P"
+  (let (flag values)
+    (dolist (ll args)
+      (multiple-value-bind (bool rll ill)
+          (complex-number-p ll 'float-or-rational-p)
+        (unless bool
+          (return-from complex-float-numerical-eval-p nil))
+        ;; Always save the result from complex-number-p.  But for backward
+        ;; compatibility, only set the flag if any item is a float.
+        (push (add rll (mul ill '$%i)) values)
+        (setf flag (or flag (or (floatp rll) (floatp ill))))))
+    (when (or $numer flag)
+      ;; Return the values in the same order as the args!
+      (nreverse values))))
+
+;;; Test for numerically evaluation in bigfloat precision
+
+(defun bigfloat-numerical-eval-p (&rest args)
+  (let ((flag nil))
+    (dolist (ll args)
+      (when (not (bigfloat-or-number-p ll)) 
+        (return-from bigfloat-numerical-eval-p nil))
+      (when ($bfloatp ll)
+	(setq flag t)))
+    (if (or $numer flag) t nil)))
+
+;;; Test for numerically evaluation in complex bigfloat precision
+
+(defun complex-bigfloat-numerical-eval-p (&rest args)
+  "Determine if ARGS consists of numerical values by determining if
+  the real and imaginary parts of each arg are nuemrical (including
+  bigfloats). A non-NIL result is returned if at least one of args is
+  a floating-point value or if numer is true. If the result is
+  non-NIL, it is a list of the arguments reduced via COMPLEX-NUMBER-P."
+
+  (let (flag values)
+    (dolist (ll args)
+      (multiple-value-bind (bool rll ill)
+          (complex-number-p ll 'bigfloat-or-number-p)
+        (unless bool
+          (return-from complex-bigfloat-numerical-eval-p nil))
+	;; Always save the result from complex-number-p.  But for backward
+	;; compatibility, only set the flag if any item is a bfloat.
+	(push (add rll (mul ill '$%i)) values)
+	(when (or ($bfloatp rll) ($bfloatp ill))
+          (setf flag t))))
+    (when (or $numer flag)
+      ;; Return the values in the same order as the args!
+      (nreverse values))))
+
+;;; Test for numerical evaluation in any precision, real or complex.
+(defun numerical-eval-p (&rest args)
+  (or (apply 'float-numerical-eval-p args)
+      (apply 'complex-float-numerical-eval-p args)
+      (apply 'bigfloat-numerical-eval-p args)
+      (apply 'complex-bigfloat-numerical-eval-p args)))
+
+;;; Check for an integer or a float or bigfloat representation. When we
+;;; have a float or bigfloat representation return the integer value.
+
+(defun integer-representation-p (x)
+  (let ((val nil))
+    (cond ((integerp x) x)
+          ((and (floatp x) (= 0 (nth-value 1 (truncate x))))
+           (nth-value 0 (truncate x)))
+          ((and ($bfloatp x) 
+                (eq ($sign (sub (setq val ($truncate x)) x)) '$zero))
+           val)
+          (t nil))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Helper functions for Bigfloat numerical evaluation.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun cmul (x y) ($rectform (mul x y)))
+
+(defun cdiv (x y) ($rectform (div x y)))
+
+(defun cpower (x y) ($rectform (power x y)))
+
+

-----------------------------------------------------------------------


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch master updated. branch-5_49-base-411-gb123029a1

[dauti <da...@us...>]

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  b123029a18cb75e53d48d7be968f99a78ba688bb (commit)
      from  bf60af06a6798e0f416d49836407fa667697eb8b (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 b123029a18cb75e53d48d7be968f99a78ba688bb
Author: Wolfgang Dautermann <da...@us...>
Date:   Tue Apr 21 19:04:01 2026 +0200

    Fixes for Maxima/ECL/Windows.
    
    ECL is installed in %maxima_prefix%/ecl, set the
    path to ecl correctly.

diff --git a/crosscompile-windows/CMakeLists.txt b/crosscompile-windows/CMakeLists.txt
index df14c7add..f67fe7815 100644
--- a/crosscompile-windows/CMakeLists.txt
+++ b/crosscompile-windows/CMakeLists.txt
@@ -313,7 +313,7 @@ externalproject_add(maxima
         COMMAND sed -i s+^.*wine-clisp.sh+clisp.exe+g src/maxima.bat
         COMMAND sed -i s+^.*wine-sbcl.sh+sbcl.exe+g src/maxima.bat
         COMMAND sed -i s+^.*wine-ccl.sh+wx86cl64.exe+g src/maxima.bat
-        COMMAND sed -i s+^.*wine-ecl.sh+ecl/ecl.exe+g src/maxima.bat
+        COMMAND sed -i s+^.*wine-ecl.sh+ecl.exe+g src/maxima.bat
   INSTALL_COMMAND PATH=${CMAKE_BINARY_DIR}/texinfo-installroot/bin:$ENV{PATH} LANG=C $(MAKE) install DESTDIR=${CMAKE_BINARY_DIR}/maxima-installroot/
           COMMAND PATH=${CMAKE_BINARY_DIR}/texinfo-installroot/bin:$ENV{PATH} LANG=C $(MAKE) extradocinstall DESTDIR=${CMAKE_BINARY_DIR}/maxima-installroot/
 )
diff --git a/crosscompile-windows/ecl/CMakeLists.txt b/crosscompile-windows/ecl/CMakeLists.txt
index df4fdf3a9..da804edb6 100644
--- a/crosscompile-windows/ecl/CMakeLists.txt
+++ b/crosscompile-windows/ecl/CMakeLists.txt
@@ -32,4 +32,4 @@ ExternalProject_Add(ecl
           COMMAND ${CMAKE_COMMAND} -E copy "${MINGW_LIBGCC}" "${CMAKE_BINARY_DIR}/ecl-cross-root"
           COMMAND ${CMAKE_COMMAND} -E copy "${MINGW_LIBWINPTHREAD}" "${CMAKE_BINARY_DIR}/ecl-cross-root"
 )
-install(DIRECTORY ${CMAKE_BINARY_DIR}/ecl-cross-root/ DESTINATION bin/ecl COMPONENT ECL)
+install(DIRECTORY ${CMAKE_BINARY_DIR}/ecl-cross-root/ DESTINATION ecl COMPONENT ECL)
diff --git a/src/maxima.bat.in b/src/maxima.bat.in
index fd535039f..d37527e1f 100755
--- a/src/maxima.bat.in
+++ b/src/maxima.bat.in
@@ -184,7 +184,7 @@ goto :EOF
 

 :doecl

 chcp 65001 >nul

-set "path=%maxima_prefix%/winlibs/bin;%path%"

+set "path=%maxima_prefix%/ecl;%maxima_prefix%/winlibs/bin;%path%"

 set "MAXIMA_IMAGESDIR_BIN=%maxima_imagesdir%/binary-%lisp%"

 @ECL_NAME@  --eval "(load \"%MAXIMA_IMAGESDIR_BIN%/defsystem.lisp\")" --eval "(mk:add-registry-location \"%MAXIMA_IMAGESDIR_BIN%\")" --eval "(funcall (intern (symbol-name :operate-on-system) :mk) \"maxima\" :load :verbose nil)" --eval "(cl-user::run)" -- %*

 goto :EOF


-----------------------------------------------------------------------

Summary of changes:
 crosscompile-windows/CMakeLists.txt     | 2 +-
 crosscompile-windows/ecl/CMakeLists.txt | 2 +-
 src/maxima.bat.in                       | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch bug-4720-part1-move-atan2-to-trigi created. branch-5_49-base-408-g0a57cfb13

[rtoy <rt...@us...>]

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, bug-4720-part1-move-atan2-to-trigi has been created
        at  0a57cfb13b91ba1bef7fe3c1e26d402a0fc63807 (commit)

- Log -----------------------------------------------------------------
commit 0a57cfb13b91ba1bef7fe3c1e26d402a0fc63807
Author: Raymond Toy <toy...@gm...>
Date:   Mon Apr 20 10:56:08 2026 -0700

    Update dependencies for trigonometry module
    
    Moving atan2 from comm2 to trigi means some dependencies need
    updating.  Add the following to the trigonometry module:
    
    * "simplification"
      * `alike1` and `free` from simp.lisp
    * "algebraic-database"
      * `mnqp` and `mgrp` from compar.lisp

diff --git a/src/maxima.system b/src/maxima.system
index a7228b244..98f6547e1 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -752,7 +752,8 @@
 	    :depends-on ("globals" "pattern-matching" "defmfun"
                                    "compatibility-macros" "declarations"
                                    "errset" "fundamental-macros" "other-macros"
-                                   "prerequisites" "utility-macros")
+                                   "prerequisites" "utility-macros"
+                                   "simplification" "algebraic-database")
 	    :components
 	    ((:file "trigi")
 	     (:file "trigo")

commit f36e38d8992cac971f50a80074fae4072def7f2d
Author: Raymond Toy <toy...@gm...>
Date:   Mon Apr 20 10:52:25 2026 -0700

    Move atan2 simplifier from comm2 to trigi
    
    For some reason comm2.lisp had the simplifier for atan2.  It makes a
    lot more sense to have it in trigi where all the other inverse trig
    functions live.  Now comm2 has no def-simplifier in it.
    
    Since cosp is used by atan2 and sinp from limits is very simple, we're
    moving them to mutils where other simple predicates live.

diff --git a/src/comm2.lisp b/src/comm2.lisp
index e1da8ba48..51701f33f 100644
--- a/src/comm2.lisp
+++ b/src/comm2.lisp
@@ -485,218 +485,6 @@
 	((specrepp e) ($nterms (specdisrep e)))
 	(t 1)))
 
-;;;; ATAN2
-
-;; The function sinp is defined in `limit.lisp'. Here we define `cosp`.
-(defun cosp (e)
-"Return true iff the expression `e` is in general form and its operator is `%cos`."
-   (and (consp e) (eq '%cos (caar e))))
-
-;; Checks: 
-;;   (i) pi - 2 pi ceiling((pi - pi)/(2 pi)) = pi - 0 = pi, and
-;;   (ii) -pi - 2 pi ceiling((-pi - pi)/(2 pi)) = -pi - 2 pi ceiling(-1) = -pi + 2pi = pi, as required.
-(defun reduce-angle-mod-2pi (theta)
-  "Reduce the input `mod 2 pi` to a value in the interval `(-pi, pi]`.
-   Thus -pi reduces to pi, and pi reduces to pi."
-  (cond
-    ;; The range of both atan2 and carg is `(-pi,pi]`, so give a free pass for such expressions.
-    ((and (consp theta) (or (eq (caar theta) '%atan2) (eq (caar theta) '%carg)))
-     theta)
-    (t
-     (let ((n (ftake '$ceiling (div (sub theta '$%pi) (mul 2 '$%pi)))))
-       ;; If you want to do the reduction only when `n` is an explicit integer,
-       ;; put in a conditional and return nil when `n` is not an explicit integer.
-       (sub theta (mul 2 '$%pi n))))))
-
-(defun nonvanishing-common-factor (p q)
- "Return the product of the absolute values of the nonvanishing factors that are common to p and q. This code
-  doesn't factor p or q, so it only considers factors that are explict. When there are no
-  such factors, return one, that is, the empty product."
-  (let* ((pp (fapply '$set (if (mtimesp p) (cdr p) (list p))))
-         (qq (fapply '$set (if (mtimesp q) (cdr q) (list q))))
-         (ss (cdr ($intersection pp qq)))
-         (ll nil))
-      (dolist (sx ss)
-        (when (eq t (mnqp sx 0))
-          (push (ftake 'mabs sx) ll)))
-      (fapply 'mtimes ll)))
-
-;; Outside the one call to this function in the atan2 simplifier, this code likely isn't particulary useful.
-(defun polar-angle-if-sinusoids (x y)
-  "When both `x` and `y` have the form `(+/-) sin(X)` or `(+/-) cos(X)` and the point (x,y) is on the unit circle, 
-  return the principal polar angle of the point `(x,y)`. Otherwise, return nil. The principal polar angle is a 
-  member of the interval `(-pi,pi]`."
-  (flet ((sinusoid-p (x)
-           (or (cosp x) (cosp (neg x)) (sinp x) (sinp (neg x)))))
-    (when (and (sinusoid-p x) (sinusoid-p y))
-      (let ((z ($expand ($exponentialize (add x (mul '$%i y))))))
-        (flet ((fn (x)
-                 (cond ((eql x -1) '$%pi)
-                       ((eq x '$%i) (div '$%pi 2))
-                       ((and (mexptp x) (eq (cadr x) '$%e)) (div (caddr x) '$%i))
-                       (t nil))))
-          ;; When `(x,y)` isn't on the unit circle (say `x = sin(p)` and `y = cos(q)`) `z` will not
-          ;; be a product of terms that are on the unit circle, and the `every` check will fail.
-          (let ((theta (mapcar #'fn (if (mtimesp z) (cdr z) (list z)))))
-            (if (every #'identity theta)
-                (reduce-angle-mod-2pi (fapply 'mplus theta))
-                nil)))))))
-
-(defvar *atan2-extended-real-hashtable* (make-hash-table :test #'equal)
-"Hashtable giving the value of atan2(extended real, extended real) when the value
-is unambiguous. Ambiguous cases, for example atan2(inf,inf), are not included in 
-the hashtable.")
-
-;; At compile time, the functions `div` and `mul` are not available, so we 
-;; cannot build `atan2-extended-real-hashtable*` here. To workaround this, we define 
-;; a function `initialize-atan2-hashtable` that hash table *atan2-extended-real-hashtable*, 
-;; we and call this function in `init-cl.lisp`. 
-(defun initialize-atan2-hashtable ()
-  (let ((pi-over-two (div '$%pi 2)) (neg-pi-over-two (div '$%pi -2)) (minus-pi (mul -1 '$%pi)))
-    (mapcar #'(lambda (z) (setf (gethash (list (first z) (second z))  *atan2-extended-real-hashtable*) (third z)))
-     (list
-      (list '$minf '$zerob neg-pi-over-two)
-      (list '$minf '$zeroa neg-pi-over-two)
-      (list '$minf '$ind neg-pi-over-two)
-
-      (list '$zerob '$minf minus-pi)
-      (list '$zerob '$inf 0)
-
-      (list '$zeroa '$minf '$%pi)
-      (list '$zeroa '$inf  0)
-
-      (list '$ind '$inf  0)
-
-      (list '$inf '$zerob pi-over-two)
-      (list '$inf '$zeroa pi-over-two)
-      (list '$inf '$ind pi-over-two)))))
-
-(defvar *extended-reals* '($minf $zerob $zeroa $ind $und $inf $infinity)
-"Common Lisp list of all of Maxima's extended real numbers")
-
-;; atan2 distributes over lists, matrices, and equations
-(defprop %atan2 (mlist $matrix mequal) distribute_over)
-
-;; I have locally set `limitp` to `nil` in two calls to `$sign`. This change
-;; resolves bug #4529: `atan2` limit issue with `radexpand: false`.
-;; Specifically, it resolves the bug when computing the limit:
-;; `block([radexpand: false], limit(atan2(x^2 - 2, x^3 - 3*x), x, sqrt(2), minus))`.
-;; Arguably, this fix is inelegant and should be revisited. (Barton Willis, April 2025)
-(def-simplifier atan2 (y x)
-  ;; for both x & y, convert -inf to minf.
-  (when (alike1 y (mul -1 '$inf))
-    (setq y '$minf))
-  (when (alike1 x (mul -1 '$inf))
-    (setq x '$minf))  
-  ;; for both x & y, convert -minf to inf.
-  (when (alike1 y (mul -1 '$minf))
-    (setq y '$inf))
-  (when (alike1 x (mul -1 '$minf))
-    (setq x '$inf)) 
-
-  ;; Divide both x & y by the absolute value of common factors that are
-  ;; nonvanishing. Skip this when either x or y depend on an extended real.
-  (when (and (freeofl y *extended-reals*) (freeofl x *extended-reals*))
-       (let ((w (nonvanishing-common-factor y x)))
-        (setq y (div y w))
-        (setq x (div x w))))
-
-  (let ((signy) (signx))
-
-    (cond ((and (zerop1 y) (zerop1 x))
-           (merror (intl:gettext "atan2: atan2(0,0) is undefined.")))
-          (;; float contagion
-           (and (or (numberp x) (ratnump x)) ; both numbers
-                (or (numberp y) (ratnump y)) ; ... but not bigfloats
-                (or $numer (floatp x) (floatp y))) ; at least one float
-           (atan ($float y) ($float x)))
-          (;; bfloat contagion
-           (and (mnump x)
-                (mnump y)
-                (or ($bfloatp x) ($bfloatp y)))	; at least one bfloat
-           (setq x ($bfloat x)
-                 y ($bfloat y))
-           (*fpatan y (list x)))
-           ;; Look up atan(extended real, extended real) in a hashtable. When the value
-           ;; isn't found in the hashtable, return a nounform.
-           ((and (member x *extended-reals*) (member y *extended-reals*))
-            (gethash (list y x) *atan2-extended-real-hashtable* (give-up)))
-
-           ;;When either `x` or `y` is in ($und infinity $ind), give up
-           ((or (member x '($und $infinity $ind)) (member y '($und $infinity $ind)))
-            (give-up))
-
-          ;; Simplify infinities--the hashtable lookup catches atan2(inf,inf),atan2(minf,inf), ..., so
-          ;; we should be able to safely do atan2(y,inf) = 0 here.
-          ((eq x '$inf)
-           ;; Simplify atan2(y,inf) -> 0
-           0)
-          ((eq x '$minf)
-           ;; Simplify atan2(y,minf) -> %pi for realpart(y)>=0 or -%pi
-           ;; for realpart(y)<0. When sign of y unknown, return noun
-           ;; form.  We are basically making atan2 on the branch cut
-           ;; be continuous with quadrant II.
-           (let ((sgn ($sign ($realpart y))))
-             (cond ((member sgn '($pos $pz $zero)) 
-                    '$%pi)
-                   ((eq sgn '$neg) (mul -1 '$%pi))
-                    (t (give-up)))))
-          ;; We have already taken care of atan2(extended real, extended real), so we can 
-          ;; safely simplify atan2(inf, X) to %pi/2 and atan2(minf, X) to -%pi/2. The case
-          ;; atan2(inf, %i) = %pi/2 is likely OK.
-          ((eq y '$inf)
-            (div '$%pi 2))
-          ((eq y '$minf)
-           (div '$%pi -2))
-          ((and (free x '$%i) (setq signx (let ((limitp nil)) ($sign x)))
-                (free y '$%i) (setq signy (let ((limitp nil)) ($sign y)))
-                (cond ((eq signy '$zero)
-                       ;; Handle atan2(0, x) which is %pi or -%pi
-                       ;; depending on the sign of x.  We assume that
-                       ;; x is never actually zero since atan2(0,0) is
-                       ;; undefined.
-                       (cond ((member signx '($neg $nz)) '$%pi)
-                             ((member signx '($pos $pz)) 0)
-                             ((eq signx '$zero)  (merror (intl:gettext "atan2: atan2(0,0) is undefined.")))))
-
-                      ((eq signx '$zero)
-                       ;; Handle atan2(y, 0) which is %pi/2 or -%pi/2,
-                       ;; depending on the sign of y.
-                       (cond ((eq signy '$neg) (div '$%pi -2))
-                             ((member signy '($pos $pz)) (div '$%pi 2))))
-                      ((alike1 y x)
-                       ;; Handle atan2(x,x) which is %pi/4 or -3*%pi/4
-                       ;; depending on the sign of x.
-                       (cond ((eq signx '$neg) (mul -3 (div '$%pi 4)))
-                             ((member signx '($pos $pz)) (div '$%pi 4))))
-                      ((alike1 y (mul -1 x))
-                       ;; Handle atan2(-x,x) which is 3*%pi/4 or
-                       ;; -%pi/4 depending on the sign of x.
-                       (cond ((eq signx '$neg) (mul 3 (div '$%pi 4)))
-                             ((member signx '($pos $pz)) (div '$%pi -4)))))))
-
-          ;; atan2((+/-)sin(angle),(+/-)cos(angle)) = angle reduced to (-pi,pi] mod 2 pi. 
-          ;; and similarly for atan2((+/-)cos(angle),(+/-)sin(angle))
-          ((polar-angle-if-sinusoids x y))
-          ($logarc
-           (logarc '%atan2 (list ($logarc y) ($logarc x))))
-          ;; atan2(-y,x) = -atan2(y,x) provided (a) trigsign is true, (b) (great (neg y) y), and        
-          ;; (c) (x,y) is off the negative real axis. 
-          ((and $trigsign 
-                (eq t (mminusp y))
-                (or (eq t (mnqp y 0)) (eq t (mgrp x 0))))
-           (neg (ftake '%atan2 (neg y) x)))
-          ((eq signx '$pos)
-           ;; atan2(y,x) = atan(y/x) when x is positive.
-           (take '(%atan) (div y x)))
-
-          ((and (eq signx '$neg) (member signy '($pos $neg $pz $zero) :test #'eq))
-           (cond ((eq signy '$neg) (sub (ftake '%atan (div y x)) '$%pi))
-                 ((member signy '($pos $pz $zero)) (add (ftake '%atan (div y x)) '$%pi))
-                 (t (give-up))))
-
-          (t (give-up)))))
-
 ;;;; ARITHF
 
 (defmfun $fibtophi (e &optional (lnorecurse nil))
diff --git a/src/limit.lisp b/src/limit.lisp
index d1468fedc..bb1d44e7a 100644
--- a/src/limit.lisp
+++ b/src/limit.lisp
@@ -4322,9 +4322,6 @@ ignoring dummy variables and array indices."
 	   	  ((or (eql 2 sgn) (eql 1 sgn)) 1) ; atan(> 0) = 1
 		  (t (throw 'taylor-catch nil)))))
 
-(defun sinp (e)
-	(and (consp e) (eq '%sin (caar e))))
-
 (defun mrv-sign-sin (e x)
 	(let ((sgn (mrv-sign-helper (div 1 (cadr e)) x)))
 		(cond ((eql sgn 2) 1) ;sin(zeroa) = 1
diff --git a/src/mutils.lisp b/src/mutils.lisp
index edb03c0ce..da3aa21a1 100644
--- a/src/mutils.lisp
+++ b/src/mutils.lisp
@@ -398,3 +398,12 @@
   (and (not (atom x))
        (or (eq (caar x) '$matrix)
 	   (and $listarith (eq (caar x) 'mlist)))))
+
+(defun sinp (e)
+  (and (consp e) (eq '%sin (caar e))))
+
+(defun cosp (e)
+  "Return true iff the expression `e` is in general form and its operator is `%cos`."
+  (and (consp e) (eq '%cos (caar e))))
+
+
diff --git a/src/trigi.lisp b/src/trigi.lisp
index b4d81f7c0..901cb28b1 100644
--- a/src/trigi.lisp
+++ b/src/trigi.lisp
@@ -927,3 +927,211 @@
 (defun dbz-err1 (func)
   (cond ((not errorsw) (merror (intl:gettext "~A: division by zero attempted.") func))
 	(t (throw 'errorsw t))))
+
+;;;; ATAN2
+
+;; Checks: 
+;;   (i) pi - 2 pi ceiling((pi - pi)/(2 pi)) = pi - 0 = pi, and
+;;   (ii) -pi - 2 pi ceiling((-pi - pi)/(2 pi)) = -pi - 2 pi ceiling(-1) = -pi + 2pi = pi, as required.
+(defun reduce-angle-mod-2pi (theta)
+  "Reduce the input `mod 2 pi` to a value in the interval `(-pi, pi]`.
+   Thus -pi reduces to pi, and pi reduces to pi."
+  (cond
+    ;; The range of both atan2 and carg is `(-pi,pi]`, so give a free pass for such expressions.
+    ((and (consp theta) (or (eq (caar theta) '%atan2) (eq (caar theta) '%carg)))
+     theta)
+    (t
+     (let ((n (ftake '$ceiling (div (sub theta '$%pi) (mul 2 '$%pi)))))
+       ;; If you want to do the reduction only when `n` is an explicit integer,
+       ;; put in a conditional and return nil when `n` is not an explicit integer.
+       (sub theta (mul 2 '$%pi n))))))
+
+(defun nonvanishing-common-factor (p q)
+ "Return the product of the absolute values of the nonvanishing factors that are common to p and q. This code
+  doesn't factor p or q, so it only considers factors that are explict. When there are no
+  such factors, return one, that is, the empty product."
+  (let* ((pp (fapply '$set (if (mtimesp p) (cdr p) (list p))))
+         (qq (fapply '$set (if (mtimesp q) (cdr q) (list q))))
+         (ss (cdr ($intersection pp qq)))
+         (ll nil))
+      (dolist (sx ss)
+        (when (eq t (mnqp sx 0))
+          (push (ftake 'mabs sx) ll)))
+      (fapply 'mtimes ll)))
+
+;; Outside the one call to this function in the atan2 simplifier, this code likely isn't particulary useful.
+(defun polar-angle-if-sinusoids (x y)
+  "When both `x` and `y` have the form `(+/-) sin(X)` or `(+/-) cos(X)` and the point (x,y) is on the unit circle, 
+  return the principal polar angle of the point `(x,y)`. Otherwise, return nil. The principal polar angle is a 
+  member of the interval `(-pi,pi]`."
+  (flet ((sinusoid-p (x)
+           (or (cosp x) (cosp (neg x)) (sinp x) (sinp (neg x)))))
+    (when (and (sinusoid-p x) (sinusoid-p y))
+      (let ((z ($expand ($exponentialize (add x (mul '$%i y))))))
+        (flet ((fn (x)
+                 (cond ((eql x -1) '$%pi)
+                       ((eq x '$%i) (div '$%pi 2))
+                       ((and (mexptp x) (eq (cadr x) '$%e)) (div (caddr x) '$%i))
+                       (t nil))))
+          ;; When `(x,y)` isn't on the unit circle (say `x = sin(p)` and `y = cos(q)`) `z` will not
+          ;; be a product of terms that are on the unit circle, and the `every` check will fail.
+          (let ((theta (mapcar #'fn (if (mtimesp z) (cdr z) (list z)))))
+            (if (every #'identity theta)
+                (reduce-angle-mod-2pi (fapply 'mplus theta))
+                nil)))))))
+
+(defvar *atan2-extended-real-hashtable* (make-hash-table :test #'equal)
+"Hashtable giving the value of atan2(extended real, extended real) when the value
+is unambiguous. Ambiguous cases, for example atan2(inf,inf), are not included in 
+the hashtable.")
+
+;; At compile time, the functions `div` and `mul` are not available, so we 
+;; cannot build `atan2-extended-real-hashtable*` here. To workaround this, we define 
+;; a function `initialize-atan2-hashtable` that hash table *atan2-extended-real-hashtable*, 
+;; we and call this function in `init-cl.lisp`. 
+(defun initialize-atan2-hashtable ()
+  (let ((pi-over-two (div '$%pi 2)) (neg-pi-over-two (div '$%pi -2)) (minus-pi (mul -1 '$%pi)))
+    (mapcar #'(lambda (z) (setf (gethash (list (first z) (second z))  *atan2-extended-real-hashtable*) (third z)))
+     (list
+      (list '$minf '$zerob neg-pi-over-two)
+      (list '$minf '$zeroa neg-pi-over-two)
+      (list '$minf '$ind neg-pi-over-two)
+
+      (list '$zerob '$minf minus-pi)
+      (list '$zerob '$inf 0)
+
+      (list '$zeroa '$minf '$%pi)
+      (list '$zeroa '$inf  0)
+
+      (list '$ind '$inf  0)
+
+      (list '$inf '$zerob pi-over-two)
+      (list '$inf '$zeroa pi-over-two)
+      (list '$inf '$ind pi-over-two)))))
+
+(defvar *extended-reals* '($minf $zerob $zeroa $ind $und $inf $infinity)
+"Common Lisp list of all of Maxima's extended real numbers")
+
+;; atan2 distributes over lists, matrices, and equations
+(defprop %atan2 (mlist $matrix mequal) distribute_over)
+
+;; I have locally set `limitp` to `nil` in two calls to `$sign`. This change
+;; resolves bug #4529: `atan2` limit issue with `radexpand: false`.
+;; Specifically, it resolves the bug when computing the limit:
+;; `block([radexpand: false], limit(atan2(x^2 - 2, x^3 - 3*x), x, sqrt(2), minus))`.
+;; Arguably, this fix is inelegant and should be revisited. (Barton Willis, April 2025)
+(def-simplifier atan2 (y x)
+  ;; for both x & y, convert -inf to minf.
+  (when (alike1 y (mul -1 '$inf))
+    (setq y '$minf))
+  (when (alike1 x (mul -1 '$inf))
+    (setq x '$minf))  
+  ;; for both x & y, convert -minf to inf.
+  (when (alike1 y (mul -1 '$minf))
+    (setq y '$inf))
+  (when (alike1 x (mul -1 '$minf))
+    (setq x '$inf)) 
+
+  ;; Divide both x & y by the absolute value of common factors that are
+  ;; nonvanishing. Skip this when either x or y depend on an extended real.
+  (when (and (freeofl y *extended-reals*) (freeofl x *extended-reals*))
+       (let ((w (nonvanishing-common-factor y x)))
+        (setq y (div y w))
+        (setq x (div x w))))
+
+  (let ((signy) (signx))
+
+    (cond ((and (zerop1 y) (zerop1 x))
+           (merror (intl:gettext "atan2: atan2(0,0) is undefined.")))
+          (;; float contagion
+           (and (or (numberp x) (ratnump x)) ; both numbers
+                (or (numberp y) (ratnump y)) ; ... but not bigfloats
+                (or $numer (floatp x) (floatp y))) ; at least one float
+           (atan ($float y) ($float x)))
+          (;; bfloat contagion
+           (and (mnump x)
+                (mnump y)
+                (or ($bfloatp x) ($bfloatp y)))	; at least one bfloat
+           (setq x ($bfloat x)
+                 y ($bfloat y))
+           (*fpatan y (list x)))
+           ;; Look up atan(extended real, extended real) in a hashtable. When the value
+           ;; isn't found in the hashtable, return a nounform.
+           ((and (member x *extended-reals*) (member y *extended-reals*))
+            (gethash (list y x) *atan2-extended-real-hashtable* (give-up)))
+
+           ;;When either `x` or `y` is in ($und infinity $ind), give up
+           ((or (member x '($und $infinity $ind)) (member y '($und $infinity $ind)))
+            (give-up))
+
+          ;; Simplify infinities--the hashtable lookup catches atan2(inf,inf),atan2(minf,inf), ..., so
+          ;; we should be able to safely do atan2(y,inf) = 0 here.
+          ((eq x '$inf)
+           ;; Simplify atan2(y,inf) -> 0
+           0)
+          ((eq x '$minf)
+           ;; Simplify atan2(y,minf) -> %pi for realpart(y)>=0 or -%pi
+           ;; for realpart(y)<0. When sign of y unknown, return noun
+           ;; form.  We are basically making atan2 on the branch cut
+           ;; be continuous with quadrant II.
+           (let ((sgn ($sign ($realpart y))))
+             (cond ((member sgn '($pos $pz $zero)) 
+                    '$%pi)
+                   ((eq sgn '$neg) (mul -1 '$%pi))
+                    (t (give-up)))))
+          ;; We have already taken care of atan2(extended real, extended real), so we can 
+          ;; safely simplify atan2(inf, X) to %pi/2 and atan2(minf, X) to -%pi/2. The case
+          ;; atan2(inf, %i) = %pi/2 is likely OK.
+          ((eq y '$inf)
+            (div '$%pi 2))
+          ((eq y '$minf)
+           (div '$%pi -2))
+          ((and (free x '$%i) (setq signx (let ((limitp nil)) ($sign x)))
+                (free y '$%i) (setq signy (let ((limitp nil)) ($sign y)))
+                (cond ((eq signy '$zero)
+                       ;; Handle atan2(0, x) which is %pi or -%pi
+                       ;; depending on the sign of x.  We assume that
+                       ;; x is never actually zero since atan2(0,0) is
+                       ;; undefined.
+                       (cond ((member signx '($neg $nz)) '$%pi)
+                             ((member signx '($pos $pz)) 0)
+                             ((eq signx '$zero)  (merror (intl:gettext "atan2: atan2(0,0) is undefined.")))))
+
+                      ((eq signx '$zero)
+                       ;; Handle atan2(y, 0) which is %pi/2 or -%pi/2,
+                       ;; depending on the sign of y.
+                       (cond ((eq signy '$neg) (div '$%pi -2))
+                             ((member signy '($pos $pz)) (div '$%pi 2))))
+                      ((alike1 y x)
+                       ;; Handle atan2(x,x) which is %pi/4 or -3*%pi/4
+                       ;; depending on the sign of x.
+                       (cond ((eq signx '$neg) (mul -3 (div '$%pi 4)))
+                             ((member signx '($pos $pz)) (div '$%pi 4))))
+                      ((alike1 y (mul -1 x))
+                       ;; Handle atan2(-x,x) which is 3*%pi/4 or
+                       ;; -%pi/4 depending on the sign of x.
+                       (cond ((eq signx '$neg) (mul 3 (div '$%pi 4)))
+                             ((member signx '($pos $pz)) (div '$%pi -4)))))))
+
+          ;; atan2((+/-)sin(angle),(+/-)cos(angle)) = angle reduced to (-pi,pi] mod 2 pi. 
+          ;; and similarly for atan2((+/-)cos(angle),(+/-)sin(angle))
+          ((polar-angle-if-sinusoids x y))
+          ($logarc
+           (logarc '%atan2 (list ($logarc y) ($logarc x))))
+          ;; atan2(-y,x) = -atan2(y,x) provided (a) trigsign is true, (b) (great (neg y) y), and        
+          ;; (c) (x,y) is off the negative real axis. 
+          ((and $trigsign 
+                (eq t (mminusp y))
+                (or (eq t (mnqp y 0)) (eq t (mgrp x 0))))
+           (neg (ftake '%atan2 (neg y) x)))
+          ((eq signx '$pos)
+           ;; atan2(y,x) = atan(y/x) when x is positive.
+           (take '(%atan) (div y x)))
+
+          ((and (eq signx '$neg) (member signy '($pos $neg $pz $zero) :test #'eq))
+           (cond ((eq signy '$neg) (sub (ftake '%atan (div y x)) '$%pi))
+                 ((member signy '($pos $pz $zero)) (add (ftake '%atan (div y x)) '$%pi))
+                 (t (give-up))))
+
+          (t (give-up)))))
+

-----------------------------------------------------------------------


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch master updated. branch-5_49-base-410-gbf60af06a

[willisbl <wil...@us...>]

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  bf60af06a6798e0f416d49836407fa667697eb8b (commit)
      from  afa88b539ca88b9748701824e7c7b44601e8f174 (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 bf60af06a6798e0f416d49836407fa667697eb8b
Author: Barton Willis <wi...@un...>
Date:   Mon Apr 20 13:55:50 2026 -0500

    Declare `preserve-direction` at top of nummod.lisp
    
    This eliminates one SBCL compiler message.
    
    No unexpected testsuite or share testsuite failures.

diff --git a/src/nummod.lisp b/src/nummod.lisp
index 46affc85a..197009563 100644
--- a/src/nummod.lisp
+++ b/src/nummod.lisp
@@ -26,6 +26,8 @@
 
 (in-package :maxima)
 
+(declare-top (special preserve-direction))
+		
 (macsyma-module nummod)
 
 ;; Let's have version numbers 1,2,3,...

-----------------------------------------------------------------------

Summary of changes:
 src/nummod.lisp | 2 ++
 1 file changed, 2 insertions(+)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch master updated. branch-5_49-base-409-gafa88b539

[willisbl <wil...@us...>]

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  afa88b539ca88b9748701824e7c7b44601e8f174 (commit)
      from  5b7282e42965cc12351323d2c900745f0f133b23 (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 afa88b539ca88b9748701824e7c7b44601e8f174
Author: Barton Willis <wi...@un...>
Date:   Mon Apr 20 12:54:43 2026 -0500

    Fixes #4085, #4717, #3826, and several unnumbered testsuite failures.
    
    Summary of changes:
    - Introduce `limit-by-methods` (in tlimit) to forlimit method dispatch.
    - Rename `limit-assumptions` to `*limit-assumptions*`.
    - Revise `coef-sign` (in hayat) so that it updates `*limit-assumptions*`.
    - Adjust `simplim%signum` so that `limit(signum(und))` returns `und`.
    - Remove one line of dead code in `simplimplus1`.
    - Update testsuite files and correct several expected results.
    
    The fix for #3826 is a better fix (no longer a limit nounform).
    
    No unexpected testsuite or share testsuite failures with either SBCL 2.4.7 or Clozure CL 1.13.1.

diff --git a/src/hayat.lisp b/src/hayat.lisp
index 5f76aa3ac..ca8b1be87 100644
--- a/src/hayat.lisp
+++ b/src/hayat.lisp
@@ -139,6 +139,7 @@
 	  trunclist		;
 	  *within-srf?*		;flag for in srf
 	  mainvar-datum		;
+	  *limit-assumptions*
 	  least_term?		; If non-null then the addition routines
 				; are adding or subtracting coeff's of the
 				; least term of a sum so they should do
@@ -1401,9 +1402,24 @@
 	  lim)))))
 
 (defun coef-sign (coef)
-   (if (not ($freeof '$%i ($rectform coef)))
-       '$im
-     ($asksign coef)))
+  "Determine the sign of `coef`.
+
+  First, find the sign using `$csign`. If `$csign` returns `$complex` or `$imaginary`, 
+  return `$im`; if the sign is`$neg` or `$pos`, return those values.
+
+  Second, call `asksign`. If `$asksign` returns `$zero` and `*limit-assumptions*` 
+  is non-nil, push `coef = 0` onto `*limit-assumptions*` before returning the sign
+  determined by asksign."
+  (let ((sgn ($csign coef)))
+	(cond ((or (eq sgn '$complex) (eq sgn '$imaginary)) '$im)
+	      ((member sgn '($neg $zero $pos)) sgn)
+		  (t 
+		     (let ((asgn ($asksign coef)))
+                ;; When sgn is zero and limit is active, record this fact as a noun equality
+				;; in *limit-assumptions*.
+             (when (and *limit-assumptions* (eq asgn '$zero))
+               (push (ftake '$equal coef 0) *limit-assumptions*))
+            asgn)))))
 
 (defun gvar-lim (gvar)
    (or (cdr (assoc gvar tvar-limits :test #'eq))
diff --git a/src/limit.lisp b/src/limit.lisp
index d1468fedc..c64c60c40 100644
--- a/src/limit.lisp
+++ b/src/limit.lisp
@@ -31,13 +31,14 @@
 		      *indicator numer denom exp var val
 		      taylored logcombed
 		      $exponentialize lhp? lhcount
-		      loginprod? context limit-assumptions
+		      loginprod? context *limit-assumptions*
 		      limit-top))
 
 (defconstant +behavior-count+ 4)
 (defvar *behavior-count-now*)
 (defvar *getsignl-asksign-ok* nil)
 (defvar *old-integer-info* nil)
+(defvar *limit-assumptions* nil)
 
 (load-macsyma-macros rzmac)
 
@@ -117,7 +118,7 @@
 		    (some #'(lambda (q) (indefinite-integral-p q x)) (cdr e)))))
 
 (defun toplevel-$limit (&rest args)
-  (let ((limit-assumptions ())
+  (let ((*limit-assumptions* ())
 	(*old-integer-info* ())
 	($keepfloat t)
 	($numer nil)
@@ -125,7 +126,7 @@
 	($%emode t) 
 	($%e_to_numlog nil)
 	(limit-top t))
-    (declare (special limit-assumptions limit-top))
+    (declare (special *limit-assumptions* limit-top))
     (unless limitp
       (setq *old-integer-info* *integer-info*)
       (setq *integer-info* ()))
@@ -279,10 +280,10 @@
   (cond (limit-top
 	 (assume '((mgreaterp) lim-epsilon 0))
 	 (assume '((mgreaterp) prin-inf 100000000))
-	 (setq limit-assumptions (make-limit-assumptions var val direction))
+	 (setq *limit-assumptions* (make-limit-assumptions var val direction))
 	 (setq limit-top ()))
 	(t ()))
-  limit-assumptions)
+  *limit-assumptions*)
 
 (defun make-limit-assumptions (var val direction)
   (let ((new-assumptions))
@@ -304,7 +305,7 @@
 (defun restore-assumptions ()
 ;;;Hackery until assume and forget take reliable args. Nov. 9 1979.
 ;;;JIM.
-  (do ((assumption-list limit-assumptions (cdr assumption-list)))
+  (do ((assumption-list *limit-assumptions* (cdr assumption-list)))
       ((null assumption-list) t)
     (forget (car assumption-list)))
   (forget '((mgreaterp) lim-epsilon 0))
@@ -1332,7 +1333,7 @@ ignoring dummy variables and array indices."
  (let ((lim (limit (cadr e) x pt 'think)))
 	(cond ((or (eq lim '$zeroa) (eql lim 0) (eq lim '$ind)) lim)
 	      ((eq lim '$zerob) '$zeroa)
-		  ((eq lim '$und) (throw 'limit nil))
+		  ((eq lim '$und) '$und)
 		  ((or (eq lim '$minf) (eq lim '$inf) (eq lim '$infinity)) '$inf)
 		  (t (ftake 'mabs lim)))))
 (setf (get 'mabs 'simplim%function) 'simplim%mabs)
@@ -2461,7 +2462,6 @@ ignoring dummy variables and array indices."
 				(push ans undl))
 			  ((or (eq r '$minf) (eq r '$inf) (eq r '$infinity))
 			    (throw 'limit t))
-			  ((eq r nil))
 			  (t (push r sum))))
 	 ;; Add the members of the list sum.
 	 (setq sum (fapply 'mplus sum))
@@ -3833,7 +3833,7 @@ ignoring dummy variables and array indices."
   (let ((e (limit (cadr e) x pt 'think)) (sgn))
     (cond ((eq '$minf e) -1)
 		  ((eq '$inf e) 1)
-		  ((eq '$infinity e) '$und)
+		  ((eq '$infinity e) '$ind)
 		  ((eq '$ind e) '$ind)
 		  ((eq '$und e) e)
 		  ((eq '$zerob e) -1)
diff --git a/src/testsuite.lisp b/src/testsuite.lisp
index 84f971b1e..d4102c990 100644
--- a/src/testsuite.lisp
+++ b/src/testsuite.lisp
@@ -138,12 +138,12 @@
           ((mlist simp)  42 59 61 82 83 84 89 
                          96 104 
                          124 125 126 127 132 133 135 136 137
-                         224 238 
-                         239 240 241 242 243 244 245 246 249
-                         261 262 267 268 269 270 272
+                         224 
+                         240 243 244 245 246 249
+                         262 267 268 269 270 272
                          281 282 357 358))
          ((mlist simp) "rtest_limit_gruntz"
-          ((mlist simp) 20 25 28 29 30 36 37 39 86 96))
+          ((mlist simp) 20 25 28 29 30 37 39 86 96))
 
          ((mlist simp) "rtest_limit_wester"
           ((mlist simp) 12 13))
diff --git a/src/tlimit.lisp b/src/tlimit.lisp
index 1c5bf916c..1be08976e 100644
--- a/src/tlimit.lisp
+++ b/src/tlimit.lisp
@@ -10,19 +10,48 @@
 
 (in-package :maxima)
 
-(declare-top (special taylored *getsignl-asksign-ok*))
+(declare-top (special taylored *limit-assumptions* preserve-direction *getsignl-asksign-ok*))
+
+(declaim (special *limit-method-depth* *already-processed-limits*))
 
 (macsyma-module tlimit)
 
 (load-macsyma-macros rzmac)
 
+;; The function `limit-by-methods` iterates over a list of limit methods and stops when a 
+;; method is successful. A method is considered successful when it returns a value that is 
+;; neither a boolean (often produced by a non‑local exit) nor a limit nounform.
+
+;; To prevent unbounded recursion or repeated evaluation, `limit-by-methods`
+;; uses two safeguards:
+
+;; (a) The special variable `*limit-method-depth*` tracks the current recursion
+;; depth. The depth is incremented upon entry to each method and compared
+;; against `*max-limit-depth*` (default 16). If the limit computation exceeds
+;; this bound, processing stops.
+
+;; (b) Each attempted limit produces a "fingerprint." The fingerprint is a list of 
+;; the method and the limit data (function, limit variable, and limit point). 
+;; These fingerprints are stored in the special variable `*already-processed-limits*`. 
+;; If a newly generated fingerprint matches one already present, the computation ends.
+
+;; To ensure alikeness of each fingerprint, the limit variable is normalized to
+;; `*universal-limit-variable*`. This allows expressions such as limit(f(x), x, a) 
+;; and limit(f(y), y, a) to test as `alike1`, preventing redundant evaluation.
+
+(defvar *limit-method-depth* 0)
+(defvar *universal-limit-variable* (gensym))
+(defvar *already-processed-limits* nil)
+(defmvar *max-limit-depth* 8) ; magic number = 8 for no particular reason
+
 ;; For limits toward `inf`, assume that the limit variable exceeds `*large-positive-number*`
 (defmvar *large-positive-number* 4398046511104) ; 2^42 for no particular reason
 ;; TOP LEVEL FUNCTION(S): $TLIMIT $TLDEFINT
 
+(declaim (special limit-using-taylor))
+
 (defmfun $tlimit (&rest args)
   (let ((limit-using-taylor t))
-    (declare (special limit-using-taylor))
     (apply #'$limit args)))
 
 (defmfun $tldefint (exp var ll ul)
@@ -35,7 +64,7 @@
 ;; expressions containing $ind.
 
 ;; We have subst([h=0,x=0], taylor(asin(x+h)-asin(x),h,0,1)) = %pi (see
-;; bug #4416 limit of Newton quotient involving asin). This bug causes
+;; bug \#4416 limit of Newton quotient involving asin). This bug causes
 ;; trouble for tlimit((asin(x+h) - asin(x))/h,h,0). Until such bugs are
 ;; sorted, we will disallow tlimit from attempting limits involving 
 ;; acos and asin.
@@ -111,15 +140,16 @@
 	(let ((ee) 
 	      (silent-taylor-flag t) 
 	      ($taylordepth 8)
-		  ($radexpand nil)
-		  ($taylor_logexpand t)
-		  ($logexpand nil))
+		    ($radexpand nil)
+        ($taylor_logexpand t)
+		    ($logexpand nil))
     
     (cond
-      ((eq pt '$infinity) nil)
+      ((eq pt '$infinity) nil) ; infinity is an illegitimate limit point
       (t
        (setq e (atan2-to-atan e))
-       (setq ee (catch 'taylor-catch ($totaldisrep ($taylor e x pt n))))
+       (setq ee ($totaldisrep (catch 'taylor-catch ($taylor e x pt n))))
+
        (cond
          ((and ee (not (eql ee 0))) ee)
          ;; Retry if Taylor returns zero and depth is less than 16
@@ -130,22 +160,143 @@
 ;; Previously, when the Taylor series failed, there was code to decide
 ;; whether to call limit1 or simplimit. The choice depended on the last
 ;; argument to taylim (previously named *i*) and the main operator of the 
-;; expression. This updated code eliminates that logic and always dispatches
-;; limit1 when Maxima is unable to find the Taylor polynomial. As a result, 
-;; the last argument of taylim is now unused (orphaned).
-(defun taylim (e var val flag)
-  "Attempt to compute the limit of `e` as `var` approaches `val` using a Taylor expansion.
-  When the Taylor expansion fails, fall back to using `limit1`. The `flag` argument is unused."
+;; expression. This updated code eliminates that logic and now uses the
+;; new limit-by-methods scheme. As a result, the last argument of taylim 
+;; is now unused (orphaned).
+
+;; Occasionally, the taylor code does an asksign (see function coef-sign). When
+;; that happens and asksign determines that the sign is zero, the taylor code
+;; appends this fact to *limit-assumptions*. Often this fact is rather crucial, so after
+;; the first effort to determine the taylor series, the code loops through
+;; *limit-assumptions* and looks for facts of the form equal(XXX,0); when it
+;; finds such a fact, it substitutes 0 for XXX in the expression and tries again
+;; to find the taylor series.
+
+(defun taylim (e var val &optional (flag nil))
+  "Attempt to compute the limit of `e` as `var` approaches `val` using a
+   Taylor expansion. If the Taylor expansion succeeds, apply limit
+   methods to the resulting series. If it fails—or if Taylor-based
+   assumptions require rewriting the expression—fall back to `limit1`
+   and related methods."
   (declare (ignore flag))
-  (let ((et nil))
+
+  ;; Establish recursion‑protection for limit-by-methods.  If these specials
+  ;; are already dynamically bound, preserve their bindings; otherwise start
+  ;; with the default values. The function taylim is currently the only entry point that
+  ;; invokes limit-by-methods, so we set up the guard context here.
+  (let ((*already-processed-limits* *already-processed-limits*)
+        (*limit-method-depth*       *limit-method-depth*)
+        (*getsignl-asksign-ok*      nil)
+        (et nil))
+
     (when (tlimp e var)
-      (setq e (stirling0 e))
-      (setq et (tlimit-taylor e var (ridofab val) $lhospitallim 0)))
+      (let* ((e1  (stirling0 e))
+             (pt  (ridofab val))
+             (redo nil))
+
+        ;; First Taylor attempt
+        (setq et (tlimit-taylor e1 var pt $lhospitallim 0))
+
+        ;; Examine any assumptions recorded during Taylor
+        (dolist (fct *limit-assumptions*)
+          (when (and (consp fct) (eq '$equal (caar fct)))
+            (setq redo t)
+            (setq e1 (maxima-substitute (third fct) (second fct) e1))))
+
+        ;; Retry Taylor after rewriting, if needed
+        (when redo
+          (setq et (tlimit-taylor e1 var pt $lhospitallim 0)))))
+
+    ;; If Taylor succeeded, set taylored to true and dispatch methods on et; otherwise
+    ;; dispatch methods on e.
     (if et
-        (let ((taylored t)) ; the special variable `taylored` prevents infinite looping
-          (or (limit-sum-of-powers et var val)
-              (limit et var val 'think)))
-        (limit1 e var val))))
+        (let ((taylored t))
+          (limit-by-methods et var val
+                            (list 'limit-sum-of-powers
+                                  'limit-method-think 
+                                  'limit1
+                                  'limit-method-reciprocal-limit-point)))
+          (limit-by-methods e var val
+                          (list 
+                                'limit-method-think 
+                                'limit1
+                                'limit-method-reciprocal-limit-point)))))
+
+(defun limit-method-think (e x pt)
+  (limit e x pt 'think))
+
+(defun liminv-new-val (val)
+  (cond ((eq val '$zeroa) '$inf)
+        ((eq val '$zerob) '$minf)
+        ((eq val '$inf) '$zeroa)
+        ((eq val '$minf) '$zerob)
+        (t nil)))
+
+(defun limit-method-reciprocal-limit-point (e var val)
+  "Attempt to compute the limit of E as VAR approaches VAL by transforming the
+  limit point via reciprocal substitution."
+  (let* ((ee (maxima-substitute (div 1 var) var e))
+         (new-val   (liminv-new-val val)))
+    (cond
+      (new-val
+       (let ((preserve-direction t))
+         (taylim ee var new-val nil)))
+      (t
+       (throw 'limit t)))))
+
+(defun successful-limit-result-p (ans)
+  ;; A limit method result is successful only if it is:
+  ;;   - non-nil
+  ;;   - not the special inconclusive marker T
+  ;;   - not a %limit nounform
+  (and ans
+       (not (eq ans t))
+       (not (among '%limit ans))))
+
+;; To call this function, the callee must intialize *limit-method-depth* and *already-processed-limits*. The
+;; function taylim shows an expample of how to do this.
+
+;; Although `limit-by-methods` is defined in the file `tlimit`, it is not specific to the tlimit code.
+(defun limit-by-methods (e x pt methods)
+ "Apply a sequence of limit methods to compute limit(e, x, pt).
+
+Each method FN is called as (FN e x pt) and may return a value,
+NIL, or signal (throw 'limit <value>).  The first value satisfying
+successful-limit-result-p is returned.
+
+Recursion guards:
+  (a) *limit-method-depth* is incremented and compared with
+    *max-limit-depth*; exceeding this bound aborts with (throw 'limit NIL).
+
+  (b) A fingerprint of (FN, e, x, pt) is recorded in
+    *already-processed-limits*; repeating a fingerprint aborts the
+    computation to prevent recursive cycles.
+
+Returns the first valid limit result found, or NIL if no method succeeds."
+  ;; Initialize guards if not already bound
+  (let ((*already-processed-limits* (or *already-processed-limits* nil))
+        (*limit-method-depth* (or *limit-method-depth* 0)))
+
+    (when (> *limit-method-depth* *max-limit-depth*)
+      (throw 'limit nil))
+
+    (let ((*limit-method-depth* (1+ *limit-method-depth*)))
+      (catch 'limit-found
+        (dolist (fn methods)
+          ;; recursion guard
+          (let ((fingerprint (ftake 'mlist
+                                    (position fn methods)
+                                    (maxima-substitute *universal-limit-variable* x e)
+                                    *universal-limit-variable*
+                                    pt)))
+            (when (member fingerprint *already-processed-limits* :test #'alike1)
+              (throw 'limit nil))
+            (push fingerprint *already-processed-limits*))
+
+          ;; run method
+          (let ((ans (catch 'limit (funcall fn e x pt))))
+            (when (successful-limit-result-p ans)
+              (throw 'limit-found ans))))))))
 
 (defun power-of-x-p (e x)
  "Return true if `e` is a monomial of the form `x^q`, where `q` is a rational number. Also returns true if `e` is `x`.
diff --git a/tests/rtest3.mac b/tests/rtest3.mac
index b786b2871..9837009be 100644
--- a/tests/rtest3.mac
+++ b/tests/rtest3.mac
@@ -385,7 +385,11 @@ trigsimp (integrate (%e^((-log(x)^2)-1)*log(x),x));
  /(4*abs(2*log(x)-1))$
 
 /* throw away results of integrate, just make sure it runs without crashing */
-block ([foo, bar, ctxt, domain : 'complex],
+
+/* The assignment facsum_combine : 'facsum_combine, prevents some calls to asksign & askinteger. Without
+   this assignment in a fresh Maxima, this test runs with no calls to either asksign or askinteger.  */
+
+block ([foo, bar, ctxt, domain : 'complex, facsum_combine : 'facsum_combine],
   foo : exp(-(log(x) - MU)*(log(x) - MU)/(2*SIGMA*SIGMA))/(x*SIGMA*sqrt(2*%pi)),
   bar : (log(B) - log(x*SIGMA) + ((x-A)*(x-A)/(2*B*B) - (log(x) -MU)*(log(x) -MU)/(2*SIGMA*SIGMA))),
   [foo, bar] : subst ([A=2, MU=3], [foo, bar]),
@@ -1074,3 +1078,9 @@ print_string_2d ("
     \"'My Novel' not found.\"
  
 ";
+
+contexts;
+[initial, global]$
+
+kill(values);
+done$
\ No newline at end of file
diff --git a/tests/rtest_limit.mac b/tests/rtest_limit.mac
index 9656b8ff8..d04881b93 100644
--- a/tests/rtest_limit.mac
+++ b/tests/rtest_limit.mac
@@ -923,10 +923,10 @@ true;
  ctxt: newcontext (),
  assume (q > 0),
  limit(x^q/(a*x^q- 1),x,inf));
-'limit(x^q/(a*x^q- 1),x,inf);
+1/a;
 
 tlimit(x^q/(a*x^q- 1),x,inf);
-'limit(x^q/(a*x^q- 1),x,inf);
+1/a;
 
 (assume (a > 0),
  declare (q, integer),
diff --git a/tests/rtest_limit_extra.mac b/tests/rtest_limit_extra.mac
index 32fe765cb..37d54d1e3 100644
--- a/tests/rtest_limit_extra.mac
+++ b/tests/rtest_limit_extra.mac
@@ -911,8 +911,8 @@ limit(li[3](x)/log(-x)^3,x,inf);
  ind$
 
 /* #4085 limit((2-%i)^a/a!,a,inf) */
- errcatch(limit((2-%i)^a/a!,a,inf));
- [0]$
+ limit((2-%i)^a/a!,a,inf);
+ 0$
 
  /* #4081 limit((2+sin(x))^(-2),x,inf) --> und */
  limit((2+sin(x))^(-2),x,inf);
@@ -1470,6 +1470,13 @@ the other test mentioned in ticket 4634. */
 limit(((-1)^N*(2*N+1))/4-1/4,N,inf);
 und$
 
+/* \#4717 limit(signum(exp(%i*x)*exp(x)),x,inf);*/
+limit(signum(exp(%i*x)*exp(x)),x,inf);
+ind$
+
+limit(signum(exp(%i*x)*exp(x))/x,x,inf);
+0$
+
 /* clean up*/
 (kill(values),0);
 0$

-----------------------------------------------------------------------

Summary of changes:
 src/hayat.lisp              |  22 ++++-
 src/limit.lisp              |  18 ++---
 src/testsuite.lisp          |   8 +-
 src/tlimit.lisp             | 193 +++++++++++++++++++++++++++++++++++++++-----
 tests/rtest3.mac            |  12 ++-
 tests/rtest_limit.mac       |   4 +-
 tests/rtest_limit_extra.mac |  11 ++-
 7 files changed, 226 insertions(+), 42 deletions(-)


hooks/post-receive
-- 
Maxima CAS

[Maxima-commits] [git] Maxima CAS branch master updated. branch-5_49-base-408-g5b7282e42

[<ap...@us...>]

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  5b7282e42965cc12351323d2c900745f0f133b23 (commit)
      from  895081d576bd6b73757b98bea3bb7e470b432379 (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 5b7282e42965cc12351323d2c900745f0f133b23
Author: Robert Dodier <rob...@so...>
Date:   Mon Apr 20 08:03:14 2026 -0700

    Revert 895081 (changes to pretty printer display for product(...) expressions).
    Need to complete the changes before committing again.

diff --git a/src/displa.lisp b/src/displa.lisp
index 390c3401e..97c9d4fac 100644
--- a/src/displa.lisp
+++ b/src/displa.lisp
@@ -531,7 +531,7 @@
 	      (update-heights height depth)
 	      (return result)))))
 
-(defun dsumprod (form result d-form sw sh sd)
+(defun dsumprod (form result d-form symbol-w symbol-h symbol-d)
   (prog (str to dummy (w 0) (h 0) (d 0) dummy2 (lsum (eq (caar form) '%lsum)))
      (setq dummy2 (dimension (caddr form) nil 'mparen 'mequal nil 0)
 	   w width
@@ -548,16 +548,16 @@
      (setq dummy (dimension to nil 'mparen 'mparen nil 0))
      (unless (checkfit (max w width))
        (return (dimension-function form result)))
-     (setq dummy2 (cons (cons (- sw) (cons (- (+ sd h)) dummy2)) (cons d-form result)))
-     (cond ((> width sw)
-	    (setq sw 0))
+     (setq dummy2 (cons (cons (- symbol-w) (cons (- (+ symbol-d h)) dummy2)) (cons d-form result)))
+     (cond ((> width symbol-w)
+	    (setq symbol-w 0))
 	   (t
-	    (setq sw (truncate (- sw width) 2)
-		  width (+ sw width))))
-     (setq dummy (cons (cons (- sw w) (cons (+ sh depth) dummy)) dummy2)
+	    (setq symbol-w (truncate (- symbol-w width) 2)
+		  width (+ symbol-w width))))
+     (setq dummy (cons (cons (- symbol-w w) (cons (+ symbol-h depth) dummy)) dummy2)
 	   w (max w width)
-	   d (+ sd h d)
-	   h (+ sh height depth))
+	   d (+ symbol-d h d)
+	   h (+ symbol-h height depth))
      (update-heights h d)
      (setq dummy (dimension (cadr form) (cons (list (1+ (- w width)) 0) dummy)
 			    (caar form) rop w right)
@@ -604,7 +604,7 @@
 (displa-def %product dim-%product 115.)
 
 (defun dim-%product (form result)
-  (dsumprod form result '(d-prodsign) 6 3 1))
+  (dsumprod form result '(d-prodsign) 5 3 1))
 
 (displa-def rat dim-rat "/")
 (displa-def %rat dim-rat "/")

-----------------------------------------------------------------------

Summary of changes:
 src/displa.lisp | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)


hooks/post-receive
-- 
Maxima CAS