[Maxima-commits] CVS: maxima/src comm2.lisp,1.37,1.38

[Dieter K. <cra...@us...>]

Update of /cvsroot/maxima/maxima/src
In directory sfp-cvsdas-4.v30.ch3.sourceforge.com:/tmp/cvs-serv30710/src

Modified Files:
	comm2.lisp 
Log Message:
Improving the user function AT.

in simp-%at: 
Sort the list of equations, check for an empty list.

in $at: 
Do substitution in parallel.

in atscan: 
Do not simplify away a nested %at-expression.

Related bug reports:
ID: 2556133 - "at" should do parallel substitutions
Id: 2014941 - compositions of 'at'
ID: 1677217 - composistions of 'at'

No problems with the testsuite and share_testsuite.


Index: comm2.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/comm2.lisp,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -d -r1.37 -r1.38
--- comm2.lisp	1 Jun 2010 16:36:52 -0000	1.37
+++ comm2.lisp	19 Jun 2010 18:52:00 -0000	1.38
@@ -171,17 +171,20 @@
   (declare (ignore ignored))
   (twoargcheck expr)
   (let ((arg (simpcheck (cadr expr) simp-flag))
-        (eqn (caddr expr)))
+        (eqn (if ($listp (caddr expr))
+                 (cons '(mlist simp) (cdr ($sort (caddr expr))))
+                 (caddr expr))))
     (cond (($constantp arg) arg)
+          ((alike1 eqn '((mlist))) arg)
           (t (eqtest (list '(%at) arg eqn) expr)))))
 
 (defmfun $at (expr ateqs)
   (if (notloreq ateqs) (improper-arg-err ateqs '$at))
-  (atscan (let ((*atp* t)) ($substitute ateqs expr))))
+  (atscan (let ((*atp* t)) ($psubstitute ateqs expr))))
 
 (defun atscan (expr)
   (cond ((or (atom expr)
-             (member (caar expr) '(%at mrat) :test #'eq)
+             (eq (caar expr) 'mrat)
              (like ateqs '((mlist))))
          expr)
         ((eq (caar expr) '%derivative)
@@ -190,7 +193,7 @@
                     (dolist (v vl)
                       (setq dl (nconc dl (ncons (or (getf (cddr expr) v) 0)))))
                     (atfind (caaadr expr)
-                            (cdr ($substitute ateqs (cons '(mlist) vl)))
+                            (cdr ($psubstitute ateqs (cons '(mlist) vl)))
                             dl)))
              (list '(%at) expr ateqs)))
         ((member (caar expr) dummy-variable-operators :test #'eq)