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

Sequences


Sequences are Lists, Strings, or Arrays.


sequencep


The following example demonstrates how a XLISP expression can be tested for being a sequence:

(defun sequencep (x)
  (and (lboundp 'x)                ; not *unbound*
       (or (and (listp x)          ; a list or NIL
                (consp (last x)))  ; but not a dotted list
           (stringp x)             ; or a string
           (arrayp x))))           ; or an array

Depends on lboundp, see also and, arrayp, consp, defun, last, listp, or, stringp.

  Back to top


length


XLISP already knows sequences, even if the manual doesn't explicitely tell you:

(length expr)
expr - expression, evaluating to a list, string, or array
returns - the length of the list, string, or array

  Back to top


identity


(defun identity (x)
  x)

The 'identity' function is handy if a mapping function needs a 'do nothing, just return the value' function.

  Back to top


cl:subseq


XLISP already has a subseq function returning a subsequence of a string:

(subseq string start [end])
string - a string expression
start - the position of the first element, an integer
end - the position following last element, defaults to the end of the sequence
returns - the substring between start and end

The 'cl:subseq' function works like subseq, but returns subsequences of lists, strings, and arrays:

(cl:subseq sequence start [end])
sequence - a list, string, or array
start - the position of the first element, an integer
end - the position following last element, defaults to the end of the sequence
returns - the subsequence in the same type as sequence

The 'cl:subseq' function creates a sequence that is a copy of the subsequence of 'sequence' bounded by 'start' and 'end'. 'cl:subseq' always allocates a new sequence for a result, it never shares storage with an old sequence. The resulting subsequence is always of the same type as the input sequence.

(defun cl:subseq (sequence start &optional (end nil end-p))
  (let ((type (type-of sequence)))
    (if (not (member type '(nil cons string array)))
        (error "not a sequence" sequence)
        (let* ((length (length sequence))
               (end (or end length)))
          (cond ((or (> start length) (minusp start))
                 (error "start index out of bounds" start))
                ((and end-p (or (> end length) (minusp end)))
                 (error "end index out of bounds" end))
                ((> start end)
                 (error (format nil "bad range start ~a end ~a" start end)))
                (t (case type
                     (nil    nil)
                     (cons   (if (not (consp (last sequence)))
                                 ;; a dotted list is not a sequence
                                 (error "not a proper sequence" sequence)
                                 (if (>= start end)
                                     nil
                                     (nthcdr start
                                             (if end-p
                                                 (reverse
                                                   (nthcdr (- length end)
                                                     (reverse sequence)))
                                                 sequence)))))
                     (string (subseq sequence start end))
                     (array  (if (>= start end)
                                 (make-array 0)
                                 (let ((new-array (make-array (- end start))))
                                   (do ((n-index 0 (1+ n-index))
                                        (s-index start (1+ s-index)))
                                       ((>= s-index end))
                                     (setf (aref new-array n-index)
                                           (aref sequence s-index)))
                                   new-array))))))))))

Examples:

(cl:subseq "012345" 2)          => "2345"
(cl:subseq "012345" 3 5)        => "34"

(cl:subseq '(0 1 2 3 4 5) 2)    => (2 3 4 5)
(cl:subseq '(0 1 2 3 4 5) 3 5)  => (3 4)

(cl:subseq #(0 1 2 3 4 5) 2)    => #(2 3 4 5)
(cl:subseq #(0 1 2 3 4 5) 3 5)  => #(3 4)

In XLISP, neither subseq nor 'cl:subseq' can be used as arguments to setf. See cl:replace below how to replace subsequences.

  Back to top


cl:replace


(cl:replace sequence1 sequence2 &key start1 end1 start2 end2)
sequenceN - a list, string, or array
startN - the position of the first element in sequenceN, an integer
endN - the position following last element in sequenceN, defaults to the end of sequenceN
returns - the subsequence in the same type as sequence

  Back to top


map


map result-type function sequence-1 [sequence-2 ...]
result-type - list, string, or array
function - a function, applied to each element of each sequenceN
sequenceN - a list, string, or array
returns - a sequence where each element is the result of applying the function to each element of each sequenceN

The 'sequence:string' function can handle lists and arrays containing not only characters but also strings, because XLISP Unicode characters are represented as strings.

(defun sequence:string (sequence)
  (if (stringp sequence)
      sequence
      (let ((result ""))
        (flet ((strcat-element (element)
                 (let ((string (cond ((stringp element) element)
                                     ((characterp element) (string element))
                                     (t (error "not a character or string"
                                               element)))))
                   (setq result (strcat result string)))))
          (case (type-of sequence)
            (array  (let ((end (length sequence)))
                      (dotimes (index end)
                        (if (eq (aref sequence index) '*unbound*)
                            (error "not a character or string" '*unbound*)
                            (strcat-element (aref sequence index))))))
            (cons   (let ((end (length sequence)))
                      (if (not (consp (last sequence)))
                          (error "not a proper sequence" sequence)
                          (dotimes (index end)
                            (if (eq (nth index sequence) '*unbound*)
                                (error "not a character or string" '*unbound*)
                                (strcat-element (nth index sequence)))))))
            (nil    nil)
            (t      (error "not a sequence" sequence)))
          result))))

(defun list-to-string (list)
  (let ((string ""))
    (dolist (element list string)
      (setq string (strcat string (if (consp element)
                                      (list-to-string element)
                                      (format nil "~a" element)))))))
(defun sequence:vector (sequence)
  (if (not (boundp 'sequence))
      (error "not a sequence" '*unbound*)
      (let ((type (type-of sequence)))
        (if (not (member type '(array cons nil string)))
            (error "not a sequence" sequence)
            (let* ((end (length sequence))
                   (result (make-array end)))
              (unless (zerop end)
                (case type
                  (array  (dotimes (index end)
                            (setf (aref result index)
                                  (if (eq (aref sequence index) '*unbound*)
                                      '*unbound*
                                      (aref sequence index)))))
                  (cons   (if (not (consp (last sequence)))
                              (error "not a proper sequence" sequence)
                              (dotimes (index end)
                                (setf (aref result index)
                                      (if (eq (nth index sequence) '*unbound*)
                                          '*unbound*
                                          (nth index sequence))))))
                  (string (dotimes (index end)
                            (setf (aref result index)
                                  (char sequence index))))))
              result)))))
(defun sequence:array (sequence)
  (let ((type (type-of sequence)))
    (if (not (member type '(array cons nil string)))
        (error "not a sequence" sequence)
        (let* ((end (length sequence))
               (result (make-array end)))
          (if (zerop end)
              result
              (labels ((array-element (element index)
                         (setf (aref result index)
                               (if (or (consp element) (arrayp element))
                                   (sequence:array element)
                                   element))))
                (case type
                  (array  (dotimes (index end)
                            (if (eq (aref sequence index) '*unbound*)
                                (setf (aref result index) '*unbound*)
                                (array-element (aref sequence index) index))))
                  (cons   (if (not (consp (last sequence)))
                              (error "not a proper sequence" sequence)
                              (dotimes (index end)
                                (if (eq (nth index sequence) '*unbound*)
                                    (setf (aref result index) '*unbound*)
                                    (array-element (nth index sequence) index)))))
                  (string (dotimes (index end)
                            (setf (aref result index)
                                  (char sequence index)))))
                result))))))


(defun list-to-array (list)
  (let* ((end (length list))
         (array (make-array end)))
    (dotimes (index end array)
      (let ((element (nth index list)))
        (setf (aref array index) (if (consp element)
                                     (list-to-array element)
                                     element))))))

(defun list-from-input (input)
  (let (result)
    (dolist (element input)  ; input is always a list
      (format t ";; ~s ~s~%" element (type-of element))
      (case (type-of element)
        (nil    (push element result))
        (cons   (if (consp (last element))
                    (push element result)
                    (error "not a proper list" element)))
        (array  (let (local (end (length element)))
                  (dotimes (index end)
                    (push (aref element index) local))
                  (push (reverse local) result)))
        (string (let (local (end (length element)))
                  (dotimes (index end)
                    (push (char element index) local))
                  (push (reverse local) result)))
        (t      (error "not a sequence" element))))
    (reverse result)))

(defun list-from-input* (input &optional recursion-p)
  (let (result)
    (labels ((test (element)
               (if (member (type-of element) '(array cons string))
                   (list-from-input* element t)
                   (if (or recursion-p (null element))
                       element
                       (error "not a sequence" element)))))
      (format t ";; ~s~%" input)
      (case (type-of input)
        (nil     (push input result))
        (cons    (if (consp (last input))
                     (dolist (element input)
                       (push (test element) result))
                     (error "not a proper list" input)))
        (array   (let ((end (length input)))
                   (dotimes (index end)
                     (push (test (aref input index)) result))))
        (string  (let ((end (length input)))
                   (dotimes (index end)
                     (push (test (char input index)) result))))
        (t       (error "not a sequence" input)))
      (reverse result))))

(defun map (result-type function &rest sequences)
  (if (not (member result-type '(list string array)))
      (error "invalid result type" result-type)
      (let* ((input-list (list-from-input sequences))
             (result (if function
                         (apply #'mapcar (cons function input-list))
                         (if (rest sequences)
                             input-list
                             (first input-list)))))
        (case result-type
          (list   result)
          (string (list-to-string result))
          (array  (list-to-array result))))))

(defun mapcar* (function &rest lists)
  (unless (or (null lists)
              (dolist (list lists nil)
                (and (null list) (return t))))
    (let ((end (length lists))
          (result nil))
      (do ((stop nil) (recurse t t)) (stop)
        (let (local)
          (dotimes (index end)
            (let ((first (first (nth index lists)))
                  (rest  (rest  (nth index lists))))
              (push first local)
              (unless (consp first) (setq recurse nil))
              (setf (nth index lists) rest)
              (when (null rest) (setq stop t))))
          (setq local (reverse local))
          (format t ";; local: ~a~%" local)
          (format t ";; lists: ~a~%" lists)
          (format t ";; recurse: ~a~%" recurse)
          (if recurse
              (push (apply #'mapcar* (cons function local)) result)
              (push (apply function local) result))))
      (reverse result))))

(defun map* (result-type function &rest sequences)
  (if (not (member result-type '(list string array)))
      (error "invalid result type" result-type)
      (let* ((input-list (list-from-input* sequences))
             (result (if function
                         (apply #'mapcar* (cons function input-list))
                         (if (rest sequences)
                             input-list
                             (first input-list)))))
        (format t ";; ~s~%" input-list)
        (case result-type
          (list   result)
          (string (list-to-string result))
          (array  (list-to-array result))))))

  Back to top


find item sequence &key from-end test test-not start end keyelement
find-if predicate sequence &key from-end start end key ⇒ element
find-if-not predicate sequence &key from-end start end key ⇒ element

Search for an element of the sequence bounded by start and end that satisfies the predicate or that satisfies the test or test-not, as appropriate.

count item sequence &key from-end start end key test test-not ⇒ n
count-if predicate sequence &key from-end start end key ⇒ n
count-if-not predicate sequence &key from-end start end key ⇒ n

Count and return the number of elements in the sequence bounded by start and end that satisfy the test.

position item sequence &key from-end test test-not start end key ⇒ position
position-if predicate sequence &key from-end start end key ⇒ position
position-if-not predicate sequence &key from-end start end key ⇒ position

Search sequence for an element that satisfies the test. The position returned is the index within sequence of the leftmost (if from-end is true) or of the rightmost (if from-end is false) element that satisfies the test; otherwise nil is returned. The index returned is relative to the left-hand end of the entire sequence, regardless of the value of start, end, or from-end.

(defun list-find (element list &key from-end test test-not start end)
  (when from-end (setq list (reverse-list)))
  (first (cond (test (member element list :test test))
               (test-not (member element list :test-not test-not))
               (t (member element list)))))

  Back to top


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