;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
;;;  (c) Copyright 1981, 1983 Massachusetts Institute of Technology      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(macsyma-module array)

;;; Macsyma User array utilities originally due to CFFK.

(defmfun $listarray (ary)
       (Cons '(mlist)
	     (cond ((mget ary 'hashar)
		    (mapcar #'(lambda (subs) ($arrayapply ary subs))
			    (cdddr (meval (list '($arrayinfo) ary)))))
		   ((mget ary 'array) (listarray (mget ary 'array)))
		   (t 
		    (merror "Argument to LISTARRAY must be an array:~%~M" ary)))))

(defmfun $fillarray (ary1 ary2)
       (let ((ary
	      (or
	       (mget ary1 'array)
	       (merror "First argument to FILLARRAY must be a declared array:~%~M" ary1))))
	    (fillarray
	     ary
	     (cond (($listp ary2) (cdr ary2))
		   ((mget ary2 'array))
		   (t
		    (merror
		     "Second argument to FILLARRAY must be an array or list:~%~M" ary2))))
	    ary1))

(defmspec $rearray (l) (setq l (cdr l))
       (cond ((> (length l) 6)
	      (merror "Too many arguments to REARRAY:~%~M" l))
	     ((< (length l) 2)
	      (merror "Too few arguments to REARRAY:~%~M" l)))
       (let ((name (car l))
	     (ary (cond ((mget (car l) 'array))
			(t 
			 (merror "First argument to REARRAY must be a declared array:~%~M"
				 (car l))))))
	    (setq l (cdr l)
		  l (mapcar #'(lambda (x)
				      (setq x (meval x))
				      (cond ((not (eq (typep x) 'fixnum))
					     (merror
					      "Non-integer dimension to REARRAY:~%~M"
					      x)))
				      (1+ x))
			    l))
	    (let ((new-array 
		   (apply '*rearray (cons ary 
					  (cons (car (arraydims ary)) l)))))
	      #+Franz(mputprop name new-array 'array)
	      )
	    name))