[Maxima-commits] CVS: maxima/share/tensor itensor.lisp,1.76,1.77

[Viktor T. <vt...@us...>]

Update of /cvsroot/maxima/maxima/share/tensor
In directory sfp-cvsdas-4.v30.ch3.sourceforge.com:/tmp/cvs-serv1515

Modified Files:
	itensor.lisp 
Log Message:

In itensor, we allow differentiation with respect to an indexed object.
This capability has been broken by a recent change in comm.lisp. Since
itensor already has its private versions of many differentiation
routines, the best course of action seems to be to maintain our private
version of i-$dependencies, too.


Index: itensor.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/share/tensor/itensor.lisp,v
retrieving revision 1.76
retrieving revision 1.77
diff -u -d -r1.76 -r1.77
--- itensor.lisp	13 Sep 2009 01:50:04 -0000	1.76
+++ itensor.lisp	6 Apr 2010 12:41:14 -0000	1.77
@@ -2153,11 +2153,11 @@
 (defun idiffexpt1 (e x)
 ;; RETURN: n*v^n*rename(v'/v) where e=v^n
   (list '(mtimes) (caddr e) e
-    ($rename
+;;    ($rename
       (list '(mtimes) (list '(mexpt) (cadr e) -1)
              (idiff (cadr e) x)
       )
-    )
+;;    )
   )
 )
 
@@ -3048,6 +3048,33 @@
   ($decsym '$levi_civita 0 n '((mlist)) '((mlist) (($anti) $all)))
 )
 
+(defun i-$dependencies (l &aux res)
+  (dolist (z l)
+    (cond
+      ((atom z)
+       (merror
+         (intl:gettext
+           "depends: argument must be a non-atomic expression; found ~M") z))
+      ((or (eq (caar z) 'mqapply)
+           (member 'array (cdar z) :test #'eq))
+       (merror
+         (intl:gettext
+           "depends: argument cannot be a subscripted expression; found ~M") z))
+      (t
+       (do ((zz z (cdr zz))
+            (y nil))
+           ((null zz)
+            (mputprop (caar z) (setq y (reverse y)) 'depends)
+            (setq res (push (cons (ncons (caar z)) y) res))
+            (unless (cdr $dependencies)
+              (setq $dependencies '((mlist simp))))
+            (add2lnc (cons (cons (caar z) nil) y) $dependencies))
+         (cond 
+               ((and (cadr zz)
+                     (not (member (cadr zz) y)))
+                (setq y (push (cadr zz) y))))))))
+  (cons '(mlist simp) (reverse res)))
+
 ($load '$ex_calc)
 ($load '$lckdt)
 ($load '$iframe)