/usr/share/maxima/5.32.1/src/marray.lisp is in maxima-src 5.32.1-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | ;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The data in this file contains enhancments. ;;;;;
;;; ;;;;;
;;; Copyright (c) 1984,1987 by William Schelter,University of Texas ;;;;;
;;; All rights reserved ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; (c) Copyright 1981 Massachusetts Institute of Technology ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :maxima)
(macsyma-module array)
;;; Macsyma User array utilities originally due to CFFK.
;;; Note that on the lisp level we regard as an array either
;;; (1) a symbol whose ARRAY property is a common lisp array
;;; [i.e., (symbol-array 'symbol)
;;; == (get 'symbol 'array) => some array] or
;;; (2) a common lisp array.
;;; On the maxima level a declared array not of type HASH or FUNCTIONAL
;;; is either
;;; (1m) a symbol whose ARRAY mproperty is of type (1)
;;; [i.e., (symbol-array (mget 'symbol 'array)) => some array] or
;;; (2m) it is of type (2) (and then called a `fast' array).
;;; Such an array is of type (1m) iff it was created with ARRAY
;;; with USE_FAST_ARRAYS being set to FALSE.
;;;
;;; Curiously enough, ARRAY(...,TYPE,...) (which currently can only be
;;; used for USE_FAST_ARRAYS:FALSE) results in an array which is
;;; simultaneously of type (1) and (1m).
(defun $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)))
((arrayp ary)
(if (eql (array-rank ary) 1)
(coerce ary 'list)
(coerce (make-array (apply '* (array-dimensions ary))
:displaced-to ary
:element-type (array-element-type ary))
'list)))
((hash-table-p ary)
(let (vals (tab ary))
(maphash #'(lambda (x &rest l) l
(unless (eq x 'dim1) (push (gethash x tab) vals)))
ary)
(reverse vals)))
((eq (marray-type ary) '$functional)
(cdr ($listarray (mgenarray-content ary))))
(t
(merror (intl:gettext "listarray: argument must be an array; found: ~M")
ary)))))
(defmfun $fillarray (ary1 ary2)
(let ((ary
(or (mget ary1 'array)
(and (arrayp ary1) ary1)
(merror (intl:gettext "fillarray: first argument must be a declared array; found: ~M") ary1))))
(fillarray ary
(cond (($listp ary2) (cdr ary2))
((get (mget ary2 'array) 'array))
((arrayp ary2) ary2)
(t
(merror (intl:gettext "fillarray: second argument must be an array or list; found: ~M") ary2))))
ary1))
(defun getvalue (sym)
(and (symbolp sym) (boundp sym) (symbol-value sym)))
(defmspec $rearray (l)
(setq l (cdr l))
(let ((ar (car l))
(dims (mapcar #'meval (cdr l))))
(cond ($use_fast_arrays
(setf (symbol-value ar) (rearray-aux ar (getvalue ar) dims)))
(t
(rearray-aux ar (getvalue ar) dims)))))
(defun rearray-aux (ar val dims &aux marray-sym)
(cond ((arrayp val)
(apply 'lispm-rearray val dims))
((arrayp (get ar 'array))
(setf (get ar 'array) (apply 'lispm-rearray (get ar 'array) dims)))
((setq marray-sym (mget ar 'array))
(rearray-aux marray-sym nil dims)
ar)
(t (merror (intl:gettext "rearray: argument is not an array: ~A") ar))))
(defun lispm-rearray (ar &rest dims)
(cond ((eql (array-rank ar) (length dims))
(adjust-array ar (mapcar #'1+ (copy-list dims)) :element-type (array-element-type ar) ))
(t (merror (intl:gettext "rearray: arrays must have the same number of subscripts.")))))
|