list.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) 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-byte) (or null unsigned-byte)
14 boolean)
15 (values list unsigned-byte))
16 split-list-from-start split-list-from-end split-list-internal))
17
18 (defun collect-until (predicate list end)
19 "Collect elements from LIST until one that satisfies PREDICATE is found.
20
21 At most END elements will be examined. If END is null, all elements will be examined.
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 finding a delimiter."
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 LIST.
47
48 At most END elements will be counted. If END is null, all elements will be examined."
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-subseqs)
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 remaining empty seqs
84 0))))))
85
86 (defun split-list-from-end (predicate list start end count remove-empty-subseqs)
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-empty-subseqs)
98 (split-list-internal predicate list start end count remove-empty-subseqs))
99
100 (defun split-list-if (predicate list start end from-end count remove-empty-subseqs key)
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-subseqs)
104 (split-list-from-start predicate list start end count remove-empty-subseqs))))
105
106 (defun split-list-if-not (predicate list start end from-end count remove-empty-subseqs key)
107 (split-list-if (complement predicate) list start end from-end count remove-empty-subseqs key))
108
109 (defun split-list
110 (delimiter list start end from-end count remove-empty-subseqs test test-not key)
111 (let ((predicate (if test-not
112 (lambda (x) (not (funcall test-not delimiter (funcall key x))))
113 (lambda (x) (funcall test delimiter (funcall key x))))))
114 (if from-end
115 (split-list-from-end predicate list start end count remove-empty-subseqs)
116 (split-list-from-start predicate list start end count remove-empty-subseqs))))