changeset 698: |
96958d3eb5b0 |
parent: |
16bb4464adcb
|
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Fri, 04 Oct 2024 22:04:59 -0400 |
permissions: |
-rw-r--r-- |
description: |
fixes |
1 ;;; std/seq.lisp --- Standard Sequences 9 (declaim (inline firstn)) 10 (defun firstn (n list) 11 (loop repeat n for x in list collect x)) 14 "Return, at most, the first N elements of SEQ, as a *new* sequence 15 of the same type as SEQ. 17 If N is longer than SEQ, SEQ is simply copied. 19 If N is negative, then |N| elements are taken (in their original 20 order) from the end of SEQ." 21 (declare (type signed-array-length n)) 22 (sb-impl::seq-dispatch seq 27 (subseq seq (max 0 (+ (length seq) n))) 28 (subseq seq 0 (min n (length seq)))))) 30 (defun starts-with-subseq (prefix sequence &rest args 34 "Test whether the first elements of SEQUENCE are the same (as per TEST) as the elements of PREFIX. 36 If RETURN-SUFFIX is T the function returns, as a second value, a 37 sub-sequence or displaced array pointing to the sequence after PREFIX." 38 (declare (dynamic-extent args)) 39 (let ((sequence-length (length sequence)) 40 (prefix-length (length prefix))) 41 (when (< sequence-length prefix-length) 42 (return-from starts-with-subseq (values nil nil))) 43 (flet ((make-suffix (start) 46 ((not (arrayp sequence)) 48 (subseq sequence start) 49 (subseq sequence 0 0))) 52 :element-type (array-element-type sequence) 55 (make-array (- sequence-length start) 56 :element-type (array-element-type sequence) 57 :displaced-to sequence 58 :displaced-index-offset start 60 (remf args :return-suffix) 61 (let ((mismatch (apply #'mismatch prefix sequence 65 (values t (make-suffix nil))) 66 ((= mismatch prefix-length) 67 (values t (make-suffix mismatch))) 69 (values nil nil))))))) 71 (defun ends-with-subseq (suffix sequence &key (test #'eql)) 72 "Test whether SEQUENCE ends with SUFFIX. In other words: return true if 73 the last (length SUFFIX) elements of SEQUENCE are equal to SUFFIX." 74 (let ((sequence-length (length sequence)) 75 (suffix-length (length suffix))) 76 (when (< sequence-length suffix-length) 77 ;; if SEQUENCE is shorter than SUFFIX, then SEQUENCE can't end with SUFFIX. 78 (return-from ends-with-subseq nil)) 79 (loop for sequence-index from (- sequence-length suffix-length) below sequence-length 80 for suffix-index from 0 below suffix-length 81 when (not (funcall test (elt sequence sequence-index) (elt suffix suffix-index))) 82 do (return-from ends-with-subseq nil) 85 (defun split-sequence (delimiter seq &key (count nil) (remove-empty-subseqs nil) (from-end nil) (start 0) (end nil) (test nil test-supplied) (test-not nil test-not-supplied) (key nil key-supplied)) 86 "Return a list of subsequences in seq delimited by delimiter. 88 If :remove-empty-subseqs is NIL, empty subsequences will be included 89 in the result; otherwise they will be discarded. All other keywords 90 work analogously to those for CL:SUBSTITUTE. In particular, the 91 behaviour of :from-end is possibly different from other versions of 92 this function; :from-end values of NIL and T are equivalent unless 93 :count is supplied. The second return value is an index suitable as an 94 argument to CL:SUBSEQ into the sequence indicating where processing 96 (let ((len (length seq)) 97 (other-keys (nconc (when test-supplied 99 (when test-not-supplied 100 (list :test-not test-not)) 103 (unless end (setq end len)) 105 (loop for right = end then left 106 for left = (max (or (apply #'position delimiter seq 112 unless (and (= right (1+ left)) 113 remove-empty-subseqs) ; empty subseq we don't want 114 if (and count (>= nr-elts count)) 115 ;; We can't take any more. Return now. 116 return (values (nreverse subseqs) right) 118 collect (subseq seq (1+ left) right) into subseqs 119 and sum 1 into nr-elts 121 finally (return (values (nreverse subseqs) (1+ left)))) 122 (loop for left = start then (+ right 1) 123 for right = (min (or (apply #'position delimiter seq 128 unless (and (= right left) 129 remove-empty-subseqs) ; empty subseq we don't want 130 if (and count (>= nr-elts count)) 131 ;; We can't take any more. Return now. 132 return (values subseqs left) 134 collect (subseq seq left right) into subseqs 135 and sum 1 into nr-elts 137 finally (return (values subseqs right)))))) 139 (defun split-sequence-if (predicate seq &key (count nil) (remove-empty-subseqs nil) (from-end nil) (start 0) (end nil) (key nil key-supplied)) 140 "Return a list of subsequences in seq delimited by items satisfying 143 If :remove-empty-subseqs is NIL, empty subsequences will be included 144 in the result; otherwise they will be discarded. All other keywords 145 work analogously to those for CL:SUBSTITUTE-IF. In particular, the 146 behaviour of :from-end is possibly different from other versions of 147 this function; :from-end values of NIL and T are equivalent unless 148 :count is supplied. The second return value is an index suitable as an 149 argument to CL:SUBSEQ into the sequence indicating where processing 151 (let ((len (length seq)) 152 (other-keys (when key-supplied 154 (unless end (setq end len)) 156 (loop for right = end then left 157 for left = (max (or (apply #'position-if predicate seq 163 unless (and (= right (1+ left)) 164 remove-empty-subseqs) ; empty subseq we don't want 165 if (and count (>= nr-elts count)) 166 ;; We can't take any more. Return now. 167 return (values (nreverse subseqs) right) 169 collect (subseq seq (1+ left) right) into subseqs 170 and sum 1 into nr-elts 172 finally (return (values (nreverse subseqs) (1+ left)))) 173 (loop for left = start then (+ right 1) 174 for right = (min (or (apply #'position-if predicate seq 179 unless (and (= right left) 180 remove-empty-subseqs) ; empty subseq we don't want 181 if (and count (>= nr-elts count)) 182 ;; We can't take any more. Return now. 183 return (values subseqs left) 185 collect (subseq seq left right) into subseqs 186 and sum 1 into nr-elts 188 finally (return (values subseqs right)))))) 190 (defun split-sequence-if-not (predicate seq &key (count nil) (remove-empty-subseqs nil) (from-end nil) (start 0) (end nil) (key nil key-supplied)) 191 "Return a list of subsequences in seq delimited by items satisfying 192 (CL:COMPLEMENT predicate). 194 If :remove-empty-subseqs is NIL, empty subsequences will be included 195 in the result; otherwise they will be discarded. All other keywords 196 work analogously to those for CL:SUBSTITUTE-IF-NOT. In particular, 197 the behaviour of :from-end is possibly different from other versions 198 of this function; :from-end values of NIL and T are equivalent unless 199 :count is supplied. The second return value is an index suitable as an 200 argument to CL:SUBSEQ into the sequence indicating where processing 201 stopped." ; Emacs syntax highlighting is broken, and this helps: " 202 (let ((len (length seq)) 203 (other-keys (when key-supplied 205 (unless end (setq end len)) 207 (loop for right = end then left 208 for left = (max (or (apply #'position-if-not predicate seq 214 unless (and (= right (1+ left)) 215 remove-empty-subseqs) ; empty subseq we don't want 216 if (and count (>= nr-elts count)) 217 ;; We can't take any more. Return now. 218 return (values (nreverse subseqs) right) 220 collect (subseq seq (1+ left) right) into subseqs 221 and sum 1 into nr-elts 223 finally (return (values (nreverse subseqs) (1+ left)))) 224 (loop for left = start then (+ right 1) 225 for right = (min (or (apply #'position-if-not predicate seq 230 unless (and (= right left) 231 remove-empty-subseqs) ; empty subseq we don't want 232 if (and count (>= nr-elts count)) 233 ;; We can't take any more. Return now. 234 return (values subseqs left) 236 collect (subseq seq left right) into subseqs 237 and sum 1 into nr-elts 239 finally (return (values subseqs right))))))