vector.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
HTML git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
DIR Log
DIR Files
DIR Refs
DIR Tags
DIR README
DIR 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-index) boolean)
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 test-not key)
22 (cond
23 ((and (not from-end) (null test-not))
24 (split-vector-from-start (lambda (vector start)
25 (position delimiter vector :start start :key key :test test))
26 vector start end count remove-empty-subseqs))
27 ((and (not from-end) test-not)
28 (split-vector-from-start (lambda (vector start)
29 (position delimiter vector :start start :key key :test-not test-not))
30 vector start end count remove-empty-subseqs))
31 ((and from-end (null test-not))
32 (split-vector-from-end (lambda (vector end)
33 (position delimiter vector :end end :from-end t :key key :test test))
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-end t :key key :test-not test-not))
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 :from-end t :key key))
45 vector start end count remove-empty-subseqs)
46 (split-vector-from-start (lambda (vector start)
47 (position-if predicate vector :start start :key key))
48 vector start end count remove-empty-subseqs)))
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 end :from-end t :key key))
55 vector start end count remove-empty-subseqs)
56 (split-vector-from-start (lambda (vector start)
57 (position-if-not predicate vector :start start :key key))
58 vector start end count remove-empty-subseqs)))
59
60 (defun split-vector-from-end (position-fn vector start end count remove-empty-subseqs)
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 remove-empty-subseqs)
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)))))