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

Kind	Covered	All	%
expression	0	215	0.0
branch	0	26	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

;;; For extended sequences, we make the assumption that all extended sequences

6

;;; can be at most ARRAY-DIMENSION-LIMIT long. This seems to match what SBCL

7

;;; assumes about them.

8

9

;;; TODO test this code. This will require creating such an extended sequence.

10

11

(deftype extended-sequence ()

12

'(and sequence (not list) (not vector)))

13

14

(declaim (inline

15

split-extended-sequence split-extended-sequence-if split-extended-sequence-if-not

16

split-extended-sequence-from-end split-extended-sequence-from-start))

17

18

(declaim (ftype (function (&rest t) (values list unsigned-byte))

19

split-extended-sequence split-extended-sequence-if split-extended-sequence-if-not))

20

21

(declaim (ftype (function (function extended-sequence array-index

22

                                     (or null fixnum) (or null fixnum) boolean)

23

(values list fixnum))

24

split-extended-sequence-from-start split-extended-sequence-from-end))

25

26

(defun split-extended-sequence-from-end (position-fn sequence start end count remove-empty-subseqs)

27

(declare (optimize (speed 3) (debug 0))

28

(type (function (extended-sequence fixnum) (or null fixnum)) position-fn))

29

(loop

30

:with length = (length sequence)

31

:with end = (or end length)

32

:for right := end :then left

33

:for left := (max (or (funcall position-fn sequence right) -1)

34

(1- start))

35

:unless (and (= right (1+ left)) remove-empty-subseqs)

36

:if (and count (>= nr-elts count))

37

:return (values (nreverse subseqs) right)

38

:else

39

:collect (subseq sequence (1+ left) right) into subseqs

40

:and :sum 1 :into nr-elts :of-type fixnum

41

:until (< left start)

42

:finally (return (values (nreverse subseqs) (1+ left)))))

43

44

(defun split-extended-sequence-from-start (position-fn sequence start end count remove-empty-subseqs)

45

(declare (optimize (speed 3) (debug 0))

46

(type (function (extended-sequence fixnum) (or null fixnum)) position-fn))

47

(loop

48

:with length = (length sequence)

49

:with end = (or end length)

50

:for left := start :then (1+ right)

51

:for right := (min (or (funcall position-fn sequence left) length)

52

end)

53

:unless (and (= right left) remove-empty-subseqs)

54

:if (and count (>= nr-elts count))

55

:return (values subseqs left)

56

:else

57

:collect (subseq sequence left right) :into subseqs

58

:and :sum 1 :into nr-elts :of-type fixnum

59

:until (>= right end)

60

:finally (return (values subseqs right))))

61

62

(defun split-extended-sequence-if

63

(predicate sequence start end from-end count remove-empty-subseqs key)

64

(if from-end

65

(split-extended-sequence-from-end (lambda (sequence end)

66

                                           (position-if predicate sequence :end end :from-end t :key key))

67

                                         sequence start end count remove-empty-subseqs)

68

(split-extended-sequence-from-start (lambda (sequence start)

69

                                             (position-if predicate sequence :start start :key key))

70

                                           sequence start end count remove-empty-subseqs)))

71

72

(defun split-extended-sequence-if-not

73

(predicate sequence start end from-end count remove-empty-subseqs key)

74

(if from-end

75

(split-extended-sequence-from-end (lambda (sequence end)

76

                                           (position-if-not predicate sequence :end end :from-end t :key key))

77

                                         sequence start end count remove-empty-subseqs)

78

(split-extended-sequence-from-start (lambda (sequence start)

79

                                             (position-if-not predicate sequence :start start :key key))

80

                                           sequence start end count remove-empty-subseqs)))

81

82

(defun split-extended-sequence

83

(delimiter sequence start end from-end count remove-empty-subseqs test test-not key)

84

(cond

85

((and (not from-end) (null test-not))

86

(split-extended-sequence-from-start (lambda (sequence start)

87

                                            (position delimiter sequence :start start :key key :test test))

88

                                          sequence start end count remove-empty-subseqs))

89

((and (not from-end) test-not)

90

(split-extended-sequence-from-start (lambda (sequence start)

91

                                            (position delimiter sequence :start start :key key :test-not test-not))

92

                                          sequence start end count remove-empty-subseqs))

93

((and from-end (null test-not))

94

(split-extended-sequence-from-end (lambda (sequence end)

95

                                          (position delimiter sequence :end end :from-end t :key key :test test))

96

                                        sequence start end count remove-empty-subseqs))

97

(t

98

(split-extended-sequence-from-end (lambda (sequence end)

99

                                          (position delimiter sequence :end end :from-end t :key key :test-not test-not))

100

                                        sequence start end count remove-empty-subseqs))))