Sequences are Lists,
Strings,
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.
XLISP already knows sequences, even if the manual doesn't explicitely
(defun identity (x) x)
The 'identity' function is handy if a mapping function needs a '
XLISP already has a subseq function returning a subsequence of a string:
The 'cl:subseq' function works like subseq, but returns subsequences of lists, strings, and arrays:
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.
(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.
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))))))
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 and return the number of elements in the sequence bounded by start and end that satisfy the test.
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)))))