vector.lisp - clic - Clic is an command line interactive client for gopher writ… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
vector.lisp (4514B) | |
--- | |
1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- | |
2 | |
3 (in-package :split-sequence) | |
4 | |
5 (declaim (inline | |
6 split-vector split-vector-if split-vector-if-not | |
7 split-vector-from-end split-vector-from-start)) | |
8 | |
9 (deftype array-index (&optional (length array-dimension-limit)) | |
10 `(integer 0 (,length))) | |
11 | |
12 (declaim (ftype (function (&rest t) (values list unsigned-byte)) | |
13 split-vector split-vector-if split-vector-if-not)) | |
14 | |
15 (declaim (ftype (function (function vector array-index | |
16 (or null array-index) (or null array… | |
17 (values list unsigned-byte)) | |
18 split-vector-from-start split-vector-from-end)) | |
19 | |
20 (defun split-vector | |
21 (delimiter vector start end from-end count remove-empty-subseqs test… | |
22 (cond | |
23 ((and (not from-end) (null test-not)) | |
24 (split-vector-from-start (lambda (vector start) | |
25 (position delimiter vector :start start … | |
26 vector start end count remove-empty-subseq… | |
27 ((and (not from-end) test-not) | |
28 (split-vector-from-start (lambda (vector start) | |
29 (position delimiter vector :start start … | |
30 vector start end count remove-empty-subseq… | |
31 ((and from-end (null test-not)) | |
32 (split-vector-from-end (lambda (vector end) | |
33 (position delimiter vector :end end :from-… | |
34 vector start end count remove-empty-subseqs)) | |
35 (t | |
36 (split-vector-from-end (lambda (vector end) | |
37 (position delimiter vector :end end :from-… | |
38 vector start end count remove-empty-subseqs)… | |
39 | |
40 (defun split-vector-if | |
41 (predicate vector start end from-end count remove-empty-subseqs key) | |
42 (if from-end | |
43 (split-vector-from-end (lambda (vector end) | |
44 (position-if predicate vector :end end :f… | |
45 vector start end count remove-empty-subseqs) | |
46 (split-vector-from-start (lambda (vector start) | |
47 (position-if predicate vector :start st… | |
48 vector start end count remove-empty-subse… | |
49 | |
50 (defun split-vector-if-not | |
51 (predicate vector start end from-end count remove-empty-subseqs key) | |
52 (if from-end | |
53 (split-vector-from-end (lambda (vector end) | |
54 (position-if-not predicate vector :end en… | |
55 vector start end count remove-empty-subseqs) | |
56 (split-vector-from-start (lambda (vector start) | |
57 (position-if-not predicate vector :star… | |
58 vector start end count remove-empty-subse… | |
59 | |
60 (defun split-vector-from-end (position-fn vector start end count remove-… | |
61 (declare (optimize (speed 3) (debug 0)) | |
62 (type (function (vector fixnum) (or null fixnum)) position-fn… | |
63 (loop | |
64 :with end = (or end (length vector)) | |
65 :for right := end :then left | |
66 :for left := (max (or (funcall position-fn vector right) -1) | |
67 (1- start)) | |
68 :unless (and (= right (1+ left)) remove-empty-subseqs) | |
69 :if (and count (>= nr-elts count)) | |
70 :return (values (nreverse subseqs) right) | |
71 :else | |
72 :collect (subseq vector (1+ left) right) into subseqs | |
73 :and :sum 1 :into nr-elts :of-type fixnum | |
74 :until (< left start) | |
75 :finally (return (values (nreverse subseqs) (1+ left))))) | |
76 | |
77 (defun split-vector-from-start (position-fn vector start end count remov… | |
78 (declare (optimize (speed 3) (debug 0)) | |
79 (type vector vector) | |
80 (type (function (vector fixnum) (or null fixnum)) position-fn… | |
81 (let ((length (length vector))) | |
82 (loop | |
83 :with end = (or end (length vector)) | |
84 :for left := start :then (1+ right) | |
85 :for right := (min (or (funcall position-fn vector left) length) | |
86 end) | |
87 :unless (and (= right left) remove-empty-subseqs) | |
88 :if (and count (>= nr-elts count)) | |
89 :return (values subseqs left) | |
90 :else | |
91 :collect (subseq vector left right) :into subseqs | |
92 :and :sum 1 :into nr-elts :of-type fixnum | |
93 :until (>= right end) | |
94 :finally (return (values subseqs right))))) |