mirror of
https://github.com/PDP-10/its.git
synced 2026-03-03 18:26:16 +00:00
58 lines
1.7 KiB
Common Lisp
58 lines
1.7 KiB
Common Lisp
;;;;;;;;;;;;;;;;;;; -*- 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))
|
|
|