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

KindCoveredAll%
expression0177 0.0
branch010 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
 (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 NIL")
13
     (typecase sequence
14
       (list
15
        (when end
16
          (unless (<= start end)
17
            (error "Wrong sequence bounds. START: ~S END: ~S" start end))
18
          (unless (list-long-enough-p sequence end)
19
            (error "The list is too short: END was ~S but the list is ~S elements long."
20
                   end (length sequence)))))
21
       (t
22
        (let ((length (length sequence)))
23
          (unless end (setf end length))
24
          (unless (<= start end length)
25
            (error "Wrong sequence bounds. START: ~S END: ~S" start end)))))))
26
 
27
 (define-condition simple-program-error (program-error simple-condition) ())
28
 
29
 (defmacro check-tests (test test-p test-not test-not-p)
30
   `(if ,test-p
31
        (if ,test-not-p
32
            (error (make-condition 'simple-program-error
33
                                   :format-control "Cannot specify both TEST and TEST-NOT."))
34
            (check-type ,test (or function (and symbol (not null)))))
35
        (when ,test-not-p
36
          (check-type ,test-not (or function (and symbol (not null)))))))
37
 
38
 (declaim (ftype (function (&rest t) (values list unsigned-byte))
39
                 split-sequence split-sequence-if split-sequence-if-not))
40
 
41
 (defun split-sequence (delimiter sequence &key (start 0) (end nil) (from-end nil)
42
                                             (count nil) (remove-empty-subseqs nil)
43
                                             (test #'eql test-p) (test-not nil test-not-p)
44
                                             (key #'identity))
45
   (check-bounds sequence start end)
46
   (check-tests test test-p test-not test-not-p)
47
   (etypecase sequence
48
     (list (split-list delimiter sequence start end from-end count
49
                       remove-empty-subseqs test test-not key))
50
     (vector (split-vector delimiter sequence start end from-end count
51
                           remove-empty-subseqs test test-not key))
52
     #+(or abcl sbcl)
53
     (extended-sequence (split-extended-sequence delimiter sequence start end from-end count
54
                                                 remove-empty-subseqs test test-not key))))
55
 
56
 (defun split-sequence-if (predicate sequence &key (start 0) (end nil) (from-end nil)
57
                                                (count nil) (remove-empty-subseqs nil) (key #'identity))
58
   (check-bounds sequence start end)
59
   (etypecase sequence
60
     (list (split-list-if predicate sequence start end from-end count
61
                          remove-empty-subseqs key))
62
     (vector (split-vector-if predicate sequence start end from-end count
63
                              remove-empty-subseqs key))
64
     #+(or abcl sbcl)
65
     (extended-sequence (split-extended-sequence-if predicate sequence start end from-end count
66
                                                    remove-empty-subseqs key))))
67
 
68
 (defun split-sequence-if-not (predicate sequence &key (start 0) (end nil) (from-end nil)
69
                                                    (count nil) (remove-empty-subseqs nil) (key #'identity))
70
   (check-bounds sequence start end)
71
   (etypecase sequence
72
     (list (split-list-if-not predicate sequence start end from-end count
73
                              remove-empty-subseqs key))
74
     (vector (split-vector-if-not predicate sequence start end from-end count
75
                                  remove-empty-subseqs key))
76
     #+(or abcl sbcl)
77
     (extended-sequence (split-extended-sequence-if-not predicate sequence start end from-end count
78
                                                        remove-empty-subseqs key))))
79
 
80
 (pushnew :split-sequence *features*)