list.lisp - clic - Clic is an command line interactive client for gopher writte… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
list.lisp (4980B) | |
--- | |
1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- | |
2 | |
3 (in-package :split-sequence) | |
4 | |
5 (declaim (inline | |
6 collect-until count-while | |
7 split-list split-list-if split-list-if-not | |
8 split-list-from-end split-list-from-start split-list-internal)) | |
9 | |
10 (declaim (ftype (function (&rest t) (values list unsigned-byte)) | |
11 split-list split-list-if split-list-if-not)) | |
12 | |
13 (declaim (ftype (function (function list unsigned-byte (or null unsigned… | |
14 boolean) | |
15 (values list unsigned-byte)) | |
16 split-list-from-start split-list-from-end split-list-int… | |
17 | |
18 (defun collect-until (predicate list end) | |
19 "Collect elements from LIST until one that satisfies PREDICATE is foun… | |
20 | |
21 At most END elements will be examined. If END is null, all elements wi… | |
22 | |
23 Returns four values: | |
24 | |
25 * The collected items. | |
26 * The remaining items. | |
27 * The number of elements examined. | |
28 * Whether the search ended by running off the end, instead of by findi… | |
29 (let ((examined 0) | |
30 (found nil)) | |
31 (flet ((examine (value) | |
32 (incf examined) | |
33 (setf found (funcall predicate value)))) | |
34 (loop :for (value . remaining) :on list | |
35 :until (eql examined end) | |
36 :until (examine value) | |
37 :collect value :into result | |
38 :finally (return (values result | |
39 remaining | |
40 examined | |
41 (and (not found) | |
42 (or (null end) | |
43 (= end examined))))))))) | |
44 | |
45 (defun count-while (predicate list end) | |
46 "Count the number of elements satisfying PREDICATE at the beginning of… | |
47 | |
48 At most END elements will be counted. If END is null, all elements wil… | |
49 (if end | |
50 (loop :for value :in list | |
51 :for i :below end | |
52 :while (funcall predicate value) | |
53 :summing 1) | |
54 (loop :for value :in list | |
55 :while (funcall predicate value) | |
56 :summing 1))) | |
57 | |
58 (defun split-list-internal (predicate list start end count remove-empty-… | |
59 (let ((count count) | |
60 (done nil) | |
61 (index start) | |
62 (end (when end (- end start))) | |
63 (list (nthcdr start list))) | |
64 (flet ((should-collect-p (chunk) | |
65 (unless (and remove-empty-subseqs (null chunk)) | |
66 (when (numberp count) (decf count)) | |
67 t)) | |
68 (gather-chunk () | |
69 (multiple-value-bind (chunk remaining examined ran-off-end) | |
70 (collect-until predicate list end) | |
71 (incf index examined) | |
72 (when end (decf end examined)) | |
73 (setf list remaining | |
74 done ran-off-end) | |
75 chunk))) | |
76 (values (loop :with chunk | |
77 :until (or done (eql 0 count)) | |
78 :do (setf chunk (gather-chunk)) | |
79 :when (should-collect-p chunk) | |
80 :collect chunk) | |
81 (+ index | |
82 (if remove-empty-subseqs | |
83 (count-while predicate list end) ; chew off remaini… | |
84 0)))))) | |
85 | |
86 (defun split-list-from-end (predicate list start end count remove-empty-… | |
87 (let ((length (length list))) | |
88 (multiple-value-bind (result index) | |
89 (split-list-internal predicate (reverse list) | |
90 (if end (- length end) 0) | |
91 (- length start) count remove-empty-subseqs) | |
92 (loop :for cons on result | |
93 :for car := (car cons) | |
94 :do (setf (car cons) (nreverse car))) | |
95 (values (nreverse result) (- length index))))) | |
96 | |
97 (defun split-list-from-start (predicate list start end count remove-empt… | |
98 (split-list-internal predicate list start end count remove-empty-subse… | |
99 | |
100 (defun split-list-if (predicate list start end from-end count remove-emp… | |
101 (let ((predicate (lambda (x) (funcall predicate (funcall key x))))) | |
102 (if from-end | |
103 (split-list-from-end predicate list start end count remove-empty… | |
104 (split-list-from-start predicate list start end count remove-emp… | |
105 | |
106 (defun split-list-if-not (predicate list start end from-end count remove… | |
107 (split-list-if (complement predicate) list start end from-end count re… | |
108 | |
109 (defun split-list | |
110 (delimiter list start end from-end count remove-empty-subseqs test t… | |
111 (let ((predicate (if test-not | |
112 (lambda (x) (not (funcall test-not delimiter (fun… | |
113 (lambda (x) (funcall test delimiter (funcall key … | |
114 (if from-end | |
115 (split-list-from-end predicate list start end count remove-empty… | |
116 (split-list-from-start predicate list start end count remove-emp… |