Nyquist / XLISP 2.0  -  Contents | Tutorials | Examples | Reference

Arrays


Arrays are also Sequences.


make-array*


XLISP already has the make-array function to create one-dimensional arrays:

(make-array size)
size - the size [integer] of the array to be created
returns - the new array

Here is a function to create multi-dimensional arrays:

(make-array* size-1 [size-2 ...])
sizeN - the size [integer] of the N-th dimension in the array to be created
returns - the new array

(defun make-array* (&rest dimensions-list)
  (cond ((null dimensions-list)
         (error "too few arguments"))
        ((and (null (rest dimensions-list))
              (eql 0 (first dimensions-list)))
         (make-array 0))
        (t (labels ((multi-vector (dimensions-list)
                      (let ((count (first dimensions-list)))
                        (if (not (and (integerp count) (plusp count)))
                            (error "not a positive integer" count)
                            (let ((rest (rest dimensions-list))
                                  (elements-list nil))
                              (dotimes (i count)
                                (push (when rest
                                        (multi-vector rest))
                                      elements-list))
                              (apply #'vector (reverse elements-list)))))))
             (multi-vector dimensions-list)))))

Examples:

(make-array* 2 3)    => #(#(NIL NIL NIL) #(NIL NIL NIL)))
(make-array* 2 2 1)  => #(#(#(NIL) #(NIL)) #(#(NIL) #(NIL)))

Like make-array it is possible to create one-dimensional arrays with zero elements:

(make-array* 0)  => #()
(make-array  0)  => #()

But it is not allowed to create multi-dimensional arrays with zero-size dimensions:

(make-array* 1 0 1)  => error: not a positive integer - 0

Rationale: Multi-dimensional arrays are implemented as nested vectors and a zero-element vector cannot hold the vector for the subsequent dimension. We would need some additional administration overhead to keep the subsequent dimensions accessible, but this would break the compatibility to the build-in XLISP aref function.

More practical examples see 'aref*' below.

  Back to top


aref*


XLISP already has the aref function to access elements in one-dimensional arrays:

(aref array dimension-1)
array - one-dimensional array
dimension-1 - element number in the first dimension
returns - the value of the array element

Here is a macro for accessing elements in multi-dimensional arrays:

(aref* array dimension-1 [dimension-2 ...])
array - any-dimensional array
dimensionN - element number in the N-th dimension
returns - the value of the array element

(defmacro aref* (array &rest index-list)
  (labels ((multi-aref (array-name index-list)
             (let ((index (first index-list)))
               (if (not (integerp index))
                   (error "not an integer" index)
                   (let ((rest (rest index-list))
                         (expansion-list (list 'aref)))
                     (push (if rest
                               (multi-aref array-name rest)
                               array-name)
                           expansion-list)
                     (push index expansion-list)
                     (reverse expansion-list))))))
    (multi-aref `,array (reverse `,index-list))))

The symbols inside the labels form do not leak into the expansion, so 'aref*' also works with array names like 'array', 'array-name' 'index', 'index-list' or 'expansion-list'. Also the values of local or global variables with these names are not changed.

(macroexpand-1 '(aref* a 1 2 3))  => (aref (aref (aref a 1) 2) 3)

Examples:

> (setq a (make-array* 2 3))
#(#(NIL NIL NIL) #(NIL NIL NIL)))

> (setf (aref* a 0 1) "hello")
"hello"

> a
#(#(NIL "hello" NIL) #(NIL NIL NIL))

> (aref* a 0 1)
"hello"

'aref*' with only one 'dimension' argument behaves like aref:

(aref* a 0)            => #(NIL "hello" NIL)
(aref  a 0)            => #(NIL "hello" NIL)

(aref* (aref* a 0) 1)  => "hello"
(aref  (aref  a 0) 1)  => "hello"

(aref* a 0 1)          => "hello"
(aref  a 0 1)          => error: too many arguments

'aref*' like aref also works with setf to store values in multi-dimensional arrays:

(setf (aref* (aref* a 0) 1) "1")  => "1" ; a => #(#(NIL "1" NIL) #(NIL NIL NIL)))
(setf (aref  (aref  a 0) 1) "2")  => "2" ; a => #(#(NIL "2" NIL) #(NIL NIL NIL)))

(setf (aref* 0 1) "3")            => "3" ; a => #(#(NIL "3" NIL) #(NIL NIL NIL)))
(setf (aref  0 1) "4")            => error: too many arguments

  Back to top


vector*


(defun vector* (&rest items)
  (if (null items)
      (make-array 0)
      (let* ((end (length items))
             (result (make-array end)))
        (if (> end 1)
            (dotimes (index end)               ; more than one item
              (setf (aref result index)
                    (if (eq (nth index items) '*unbound*)
                        '*unbound*
                        (nth index items))))
            (if (eq (first items) '*unbound*)  ; one item only
                (setf (aref result 0) '*unbound*)
                (let ((item (first items)))
                  (case (type-of item)
                    (cons   (let ((end (length item)))
                              (setq result (make-array end))
                              (dotimes (index end)
                                (setf (aref result index)
                                      (if (eq (nth index item) '*unbound*)
                                          '*unbound*
                                          (nth index item))))))
                    (array  (let ((end (length item)))
                              (setq result (make-array end))
                              (dotimes (index end)
                                (setf (aref result index)
                                      (if (eq (aref item index) '*unbound*)
                                          '*unbound*
                                          (aref item index))))))
                    (string (let ((end (length item)))
                              (setq result (make-array end))
                              (dotimes (index end)
                                (setf (aref result index)
                                      (char item index)))))
                    (t      (setf (aref result 0) item))))))
        result)))
(defun list* (&rest items)
  (if (null items)
      nil
      (let* ((end (length items))
             (result nil))
        (labels ((push-element (element)
                   (if (member (type-of element) '(array cons string))
                       (setq result (append (reverse (list* element)) result))
                       (push element result))))
          (dotimes (index end)
            (if (eq (nth index items) '*unbound*)
                (push '*unbound* result)
                (let ((item (nth index items)))
                  (case (type-of item)
                    (nil    (push item result))
                    (cons   (let ((end (length item)))
                              (when (not (consp (last item))) (incf end))
                              (dotimes (index end)
                                (if (eq (nth index item) '*unbound*)
                                    (push '*unbound* result)
                                    (push-element (nth index item))))))
                    (array  (let ((end (length item)))
                              (dotimes (index end)
                                (if (eq (aref item index) '*unbound*)
                                    (push '*unbound* result)
                                    (push-element (aref item index))))))
                    (string (let ((end (length item)))
                              (dotimes (index end)
                                (push (char item index) result))))
                    (t      (push item result))))))
          (reverse result)))))
(defun tree* (&rest items)
  (if (null items)
      nil
      (let* ((end (length items))
             (result nil))
        (labels ((push-element (element)
                   (if (member (type-of element) '(array cons string))
                       (push (reverse (list* element)) result)
                       (push element result))))
          (dotimes (index end)
            (if (eq (nth index items) '*unbound*)
                (push '*unbound* result)
                (let ((item (nth index items)))
                  (case (type-of item)
                    (nil    (push item result))
                    (cons   (let ((end (length item)))
                              (when (not (consp (last item))) (incf end))
                              (dotimes (index end)
                                (if (eq (nth index item) '*unbound*)
                                    (push '*unbound* result)
                                    (push-element (nth index item))))))
                    (array  (let ((end (length item)))
                              (dotimes (index end)
                                (if (eq (aref item index) '*unbound*)
                                    (push '*unbound* result)
                                    (push-element (aref item index))))))
                    (string (let ((end (length item)))
                              (dotimes (index end)
                                (push (char item index) result))))
                    (t      (push item result))))))
          (reverse result)))))

  Back to top


array*


(defun array* (&rest items)
  (if (null items)
      (make-array 0)
      (let* ((end (length items))
             (result (make-array end)))
        (labels ((vector-element (element index)
                   (setf (aref result index)
                         (if (member (type-of element) '(cons string array))
                             (array* element)
                             element))))
          (dotimes (index end)
            (if (eq (nth index items) '*unbound*)
                (setf (aref result index) '*unbound*)
                (let ((item (nth index items)))
                  (case (type-of item)
                    (cons  (let ((end (length item)))
                             (dotimes (index end)
                               (if (eq (nth index item) '*unbound*)
                                   (strcat-element "*UNBOUND*")
                                   (strcat-element (nth index item))))))
                    (array (let ((end (length item)))
                             (dotimes (index end)
                               (if (eq (aref item index) '*unbound*)
                                   (strcat-element "*UNBOUND*")
                                   (strcat-element (aref item index))))))
                    (t     (strcat-element item))))))
          result))))

  Back to top


Nyquist / XLISP 2.0  -  Contents | Tutorials | Examples | Reference