multiple assignment stuff in src/mlisp.lisp

Hello,

I've merged the multiple-assignment code from share/contrib/defstruct.lisp
into src/mlisp.lisp. (But I did not merge the defstruct stuff itself; I think
that is a separate topic.) The current version compiles and run_testsuite
reports no unexpected errors. Here are some examples. These are
derived from comments in the code and a message from Stavros.

(%i1) [a, b]: [b, 2*a];
(%o1)                       [b, 2 a]
(%i2) [a, b]: [b, 2*a];
(%o2)                      [2 a, 2 b]
(%i3) [a, b]: [b, 2*a];
(%o3)                      [2 b, 4 a]
(%i4) [a, b]: [b, 2*a];
(%o4)                      [4 a, 4 b]
(%i5) [a, b]: [b, 2*a];
(%o5)                      [4 b, 8 a]
(%i6) [a, b, c] : 100;
(%o6)                    [100, 100, 100]
(%i7) [a, b, c];
(%o7)                    [100, 100, 100]
(%i8) (kgcd(a, b) := (while b#0 do [a, b]: [b, remainder(a, b)],
abs(a)), kgcd(11*7*5*3, 17*13*11*7));
(%o8)                          77
(%i9) (i:10, j:20, [i, j] : [j, i]);
(%o9)                       [20, 10]
(%i10) [i, j];
(%o10)                      [20, 10]


So far, so good. For the remainder, I don't know what is the correct
behavior. Anyway I've copied them here to show the behavior of the
current version.

(%i11) [i, i] : [1, 2];
(%o11)                       [1, 2]
(%i12) i;
(%o12)                          2
(%i13) a : [1, 2, 3, 4];
(%o13)                    [1, 2, 3, 4]
(%i14) (i : 2, [i, a[i]] : [4, 11]);
(%o14)                       [4, 11]
(%i15) a;
(%o15)                    [1, 2, 3, 11]
(%i16) [ a[1], a[2] ] : [ a[3], a[4] ];
(%o16)                       [3, 11]
(%i17) a;
(%o17)                   [3, 11, 3, 11]
(%i18) (i:0, [ a[i : i + 1], a[i : i + 1] ] : [ a[i : i + 1], a[i : i + 1] ]);
(%o18)                       [3, 11]
(%i19) a;
(%o19)                   [3, 11, 3, 11]


Comments?

Robert

PS.
Index: src/mlisp.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/mlisp.lisp,v
retrieving revision 1.32
retrieving revision 1.33
diff -r1.32 -r1.33
618a619,645
>
>            ;; ---------- begin code copied & modified from defstruct.lisp
>
>            ;; Check to see if the operator has an mset_extension_operator.
>            ;; If so, this says how to do assignments. Examples, a at b:x. Put mset_extension_operator
>            ;; of $mrecordassign on the atom $@.  To allow [a,b]:[3,4] put op on mlist.
>            ;; arguably we could use mget, mfuncall, and $mset_extension_operator  and
>            ;; allow this to be done at the maxima level instead of lisp.
>
>            ;; X is could be something like (($FOO ARRAY) 42), in which case it is meaningful
>            ;; to look for an assignment operator associated either with $FOO itself or with
>            ;; $FOO's object type, with "object type" = (CAAR (SYMBOL-VALUE '$FOO)).
>
>            ((let*
>               ((x-value (if (boundp (caar x)) (symbol-value (caar x))))
>                (mset-extension-op
>                  (cond
>                    ((get (caar x) 'mset_extension_operator))
>                    ((and
>                       (not (atom x-value))
>                       (get (caar x-value) '$defstruct_template)
>                       (get (caar x-value) 'mset_extension_operator))))))
>               (if mset-extension-op
>                 (return-from mset (funcall mset-extension-op x y)))))
>
>            ;; ---------- end code copied & modified from defstruct.lisp
>
621,622d647
<     ((and $subscrmap (member (caar x) '(mlist $matrix) :test #'eq))
<      (return (outermap1 'mset x y)))
624a650,690
> ;; ---------- begin code copied from defstruct.lisp
>
> ;; The follow code implements PARALLEL LIST assignment.
> ;; it is consistent with commercial macsyma.  [a,b,c]:[x,y,z] means
> ;;  about the same as a:x, b:y, c:z.  Actually it
> ;; evaluates x,y,z  BEFORE any assignments to a,b,c, hence parallel.
> ;; Also implemented is [a,b,c]:x  which evaluates x once and assigns
> ;; to a,b,c.
> ;; value returned is (evaluated x to ex)  [ex,ex,ex].
>
> ;; quiz .  [a,b]:[b,2*a].  produces values a=b, b= 2*a.
> ;; re-execute the statement 4 times. what do you get?  [4b, 8a]
> ;;
> ;; a neat application of parallel assignment is this version of
> ;; a gcd algorithm (for integers)...
> ;; kgcd(a,b):=(while b#0 do [a,b]:[b,remainder(a,b)], abs(a));
> ;; The extended euclidean algorithm looks even better with parallel
> ;; assignment.
>
> ;; add MLIST to possible operators on the left hand side of
> ;; an assignment statement.
>
> (setf (get 'mlist 'mset_extension_operator) '$mlistassign)
>
> (defmfun $mlistassign (tlist vlist)
>   ;;  tlist is  ((mlist..)  var[0]... var[n])  of targets
>   ;; vlist is either((mlist..)  val[0]... val[n]) of values
>   ;; or possibly just one value.
>   ;; should insert some checking code here
>   (if (and (listp vlist)
>     (eq (caar vlist) 'mlist)
>     (not (= (length tlist)(length vlist))))
>       (merror "Illegal list assignment: different lengths of ~M and ~M." tlist vlist))
>   (unless (and (listp vlist)
>     (eq (caar vlist) 'mlist))
>     (setf vlist (cons (car tlist) ;; if [a,b,c]:v  then make a list [v,v,v]
>             (make-sequence 'list (1-(length tlist)) :initial-element vlist))))
>   (map nil #'mset (cdr tlist)(cdr vlist))
>    vlist)
>
> ;; ---------- end code copied from defstruct.lisp