home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / xl21hos2.zip / MATRIX.LSP < prev    next >
Lisp/Scheme  |  1995-12-27  |  1KB  |  36 lines
  1. ; Matrix functions by Tom Almy
  2. ; Multidimensional arrays are implemented here as arrays of arrays
  3. ; make-array is redefined to mimic common lisp
  4. ; Unfortunately AREF cannot be changed since its operation in setf is
  5. ; "wired in", so we will use a new (macro) function MREF
  6.  
  7.  
  8. (when (eq (type-of (symbol-function 'make-array))
  9.       'subr)
  10.       (setf (symbol-function 'orig-make-array)
  11.         (symbol-function 'make-array)))
  12.  
  13. (defun make-array (dims &key initial)
  14.     (cond ((null dims) initial)
  15.       ((atom dims) (make-array (list dims) :initial initial))
  16.       (t (let ((result (orig-make-array (first dims))))
  17.            (when (or (rest dims) initial)
  18.              (dotimes (i (first dims))
  19.                   (setf (aref result i)
  20.                     (make-array (rest dims) :initial initial))))
  21.            result))))
  22.  
  23. (defun mref (matrix &rest indices)
  24.     (dolist (index indices)
  25.         (setq matrix (aref matrix index)))
  26.     matrix)
  27.  
  28. (setf (get 'mref '*setf*)
  29.       #'(lambda (mat &rest arglist)
  30.       (do ((index (first arglist) (first remainder))
  31.            (remainder (rest arglist) (rest remainder)))
  32.           ((null (rest remainder))
  33.            (setf (aref mat index) (first remainder)))
  34.         (setf mat (aref mat index)))))
  35.  
  36.