Coverage report: /home/ellis/.stash/quicklisp/dists/ultralisp/software/sharplispers-split-sequence-20211208061629/vector.lisp

KindCoveredAll%
expression2218 0.9
branch026 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
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-from-end (position-fn vector start end count remove-empty-subseqs)
21
   (declare (optimize (speed 3) (debug 0))
22
            (type (function (vector fixnum) (or null fixnum)) position-fn))
23
   (loop
24
     :with end = (or end (length vector))
25
     :for right := end :then left
26
     :for left := (max (or (funcall position-fn vector right) -1)
27
                       (1- start))
28
     :unless (and (= right (1+ left)) remove-empty-subseqs)
29
       :if (and count (>= nr-elts count))
30
         :return (values (nreverse subseqs) right)
31
       :else
32
         :collect (subseq vector (1+ left) right) into subseqs
33
         :and :sum 1 :into nr-elts :of-type fixnum
34
     :until (< left start)
35
     :finally (return (values (nreverse subseqs) (1+ left)))))
36
 
37
 (defun split-vector-from-start (position-fn vector start end count remove-empty-subseqs)
38
   (declare (optimize (speed 3) (debug 0))
39
            (type vector vector)
40
            (type (function (vector fixnum) (or null fixnum)) position-fn))
41
   (let ((length (length vector)))
42
     (loop
43
       :with end = (or end (length vector))
44
       :for left := start :then (1+ right)
45
       :for right := (min (or (funcall position-fn vector left) length)
46
                          end)
47
       :unless (and (= right left) remove-empty-subseqs)
48
         :if (and count (>= nr-elts count))
49
           :return (values subseqs left)
50
         :else
51
           :collect (subseq vector left right) :into subseqs
52
           :and :sum 1 :into nr-elts :of-type fixnum
53
       :until (>= right end)
54
       :finally (return (values subseqs right)))))
55
 
56
 (defun split-vector-if
57
     (predicate vector start end from-end count remove-empty-subseqs key)
58
   (if from-end
59
       (split-vector-from-end (lambda (vector end)
60
                                (position-if predicate vector :end end :from-end t :key key))
61
                              vector start end count remove-empty-subseqs)
62
       (split-vector-from-start (lambda (vector start)
63
                                  (position-if predicate vector :start start :key key))
64
                                vector start end count remove-empty-subseqs)))
65
 
66
 (defun split-vector-if-not
67
     (predicate vector start end from-end count remove-empty-subseqs key)
68
   (if from-end
69
       (split-vector-from-end (lambda (vector end)
70
                                (position-if-not predicate vector :end end :from-end t :key key))
71
                              vector start end count remove-empty-subseqs)
72
       (split-vector-from-start (lambda (vector start)
73
                                  (position-if-not predicate vector :start start :key key))
74
                                vector start end count remove-empty-subseqs)))
75
 
76
 (defun split-vector
77
     (delimiter vector start end from-end count remove-empty-subseqs test test-not key)
78
   (cond
79
     ((and (not from-end) (null test-not))
80
      (split-vector-from-start (lambda (vector start)
81
                                 (position delimiter vector :start start :key key :test test))
82
                               vector start end count remove-empty-subseqs))
83
     ((and (not from-end) test-not)
84
      (split-vector-from-start (lambda (vector start)
85
                                 (position delimiter vector :start start :key key :test-not test-not))
86
                               vector start end count remove-empty-subseqs))
87
     ((and from-end (null test-not))
88
      (split-vector-from-end (lambda (vector end)
89
                               (position delimiter vector :end end :from-end t :key key :test test))
90
                             vector start end count remove-empty-subseqs))
91
     (t
92
      (split-vector-from-end (lambda (vector end)
93
                               (position delimiter vector :end end :from-end t :key key :test-not test-not))
94
                             vector start end count remove-empty-subseqs))))