3rdparties/software/split-sequence-v2.0.0/vector.lisp (4514 bytes)
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)))))