api.lisp - clic - Clic is an command line interactive client for gopher written… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
api.lisp (3854B) | |
--- | |
1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- | |
2 | |
3 (in-package :split-sequence) | |
4 | |
5 (defun list-long-enough-p (list length) | |
6 (or (zerop length) | |
7 (not (null (nthcdr (1- length) list))))) | |
8 | |
9 (defun check-bounds (sequence start end) | |
10 (progn | |
11 (check-type start unsigned-byte "a non-negative integer") | |
12 (check-type end (or null unsigned-byte) "a non-negative integer or N… | |
13 (typecase sequence | |
14 (list | |
15 (when end | |
16 (unless (list-long-enough-p sequence end) | |
17 (error "The list is too short: END was ~S but the list is ~S … | |
18 end (length sequence))))) | |
19 (t | |
20 (let ((length (length sequence))) | |
21 (unless end (setf end length)) | |
22 (unless (<= start end length) | |
23 (error "Wrong sequence bounds. START: ~S END: ~S" start end))… | |
24 | |
25 (define-condition simple-program-error (program-error simple-condition) … | |
26 | |
27 (defmacro check-tests (test test-p test-not test-not-p) | |
28 `(progn | |
29 (when (and ,test-p ,test-not-p) | |
30 (error (make-condition 'simple-program-error | |
31 :format-control "Cannot specify both TEST … | |
32 (when (and ,test-not-p (not ,test-p)) | |
33 (check-type ,test-not (or function (and symbol (not null))))) | |
34 (when (and ,test-p (not ,test-not-p)) | |
35 (check-type ,test (or function (and symbol (not null))))))) | |
36 | |
37 (declaim (ftype (function (&rest t) (values list unsigned-byte)) | |
38 split-sequence split-sequence-if split-sequence-if-not)) | |
39 | |
40 (defun split-sequence (delimiter sequence &key (start 0) (end nil) (from… | |
41 (count nil) (remove-empty-su… | |
42 (test #'eql test-p) (test-no… | |
43 (key #'identity)) | |
44 (check-bounds sequence start end) | |
45 (check-tests test test-p test-not test-not-p) | |
46 (etypecase sequence | |
47 (list (split-list delimiter sequence start end from-end count | |
48 remove-empty-subseqs test test-not key)) | |
49 (vector (split-vector delimiter sequence start end from-end count | |
50 remove-empty-subseqs test test-not key)) | |
51 #+(or abcl sbcl) | |
52 (extended-sequence (split-extended-sequence delimiter sequence start… | |
53 remove-empty-subseqs tes… | |
54 | |
55 (defun split-sequence-if (predicate sequence &key (start 0) (end nil) (f… | |
56 (count nil) (remove-empty… | |
57 (check-bounds sequence start end) | |
58 (etypecase sequence | |
59 (list (split-list-if predicate sequence start end from-end count | |
60 remove-empty-subseqs key)) | |
61 (vector (split-vector-if predicate sequence start end from-end count | |
62 remove-empty-subseqs key)) | |
63 #+(or abcl sbcl) | |
64 (extended-sequence (split-extended-sequence-if predicate sequence st… | |
65 remove-empty-subseqs … | |
66 | |
67 (defun split-sequence-if-not (predicate sequence &key (start 0) (end nil… | |
68 (count nil) (remove-e… | |
69 (check-bounds sequence start end) | |
70 (etypecase sequence | |
71 (list (split-list-if-not predicate sequence start end from-end count | |
72 remove-empty-subseqs key)) | |
73 (vector (split-vector-if-not predicate sequence start end from-end c… | |
74 remove-empty-subseqs key)) | |
75 #+(or abcl sbcl) | |
76 (extended-sequence (split-extended-sequence-if-not predicate sequenc… | |
77 remove-empty-subs… | |
78 | |
79 (pushnew :split-sequence *features*) |