extended-sequence.lisp - clic - Clic is an command line interactive client for … | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
extended-sequence.lisp (5232B) | |
--- | |
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 seq… | |
6 ;;; can be at most ARRAY-DIMENSION-LIMIT long. This seems to match what … | |
7 ;;; assumes about them. | |
8 | |
9 ;;; TODO test this code. This will require creating such an extended seq… | |
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-exten… | |
16 split-extended-sequence-from-end split-extended-sequence-from-… | |
17 | |
18 (declaim (ftype (function (&rest t) (values list unsigned-byte)) | |
19 split-extended-sequence split-extended-sequence-if split… | |
20 | |
21 (declaim (ftype (function (function extended-sequence array-index | |
22 (or null fixnum) (or null fixnum) bo… | |
23 (values list fixnum)) | |
24 split-extended-sequence-from-start split-extended-sequen… | |
25 | |
26 (defun split-extended-sequence | |
27 (delimiter sequence start end from-end count remove-empty-subseqs te… | |
28 (cond | |
29 ((and (not from-end) (null test-not)) | |
30 (split-extended-sequence-from-start (lambda (sequence start) | |
31 (position delimiter sequence … | |
32 sequence start end count remove… | |
33 ((and (not from-end) test-not) | |
34 (split-extended-sequence-from-start (lambda (sequence start) | |
35 (position delimiter sequence … | |
36 sequence start end count remove… | |
37 ((and from-end (null test-not)) | |
38 (split-extended-sequence-from-end (lambda (sequence end) | |
39 (position delimiter sequence :e… | |
40 sequence start end count remove-e… | |
41 (t | |
42 (split-extended-sequence-from-end (lambda (sequence end) | |
43 (position delimiter sequence :e… | |
44 sequence start end count remove-e… | |
45 | |
46 (defun split-extended-sequence-if | |
47 (predicate sequence start end from-end count remove-empty-subseqs ke… | |
48 (if from-end | |
49 (split-extended-sequence-from-end (lambda (sequence end) | |
50 (position-if predicate sequenc… | |
51 sequence start end count remove-… | |
52 (split-extended-sequence-from-start (lambda (sequence start) | |
53 (position-if predicate seque… | |
54 sequence start end count remov… | |
55 | |
56 (defun split-extended-sequence-if-not | |
57 (predicate sequence start end from-end count remove-empty-subseqs ke… | |
58 (if from-end | |
59 (split-extended-sequence-from-end (lambda (sequence end) | |
60 (position-if-not predicate seq… | |
61 sequence start end count remove-… | |
62 (split-extended-sequence-from-start (lambda (sequence start) | |
63 (position-if-not predicate s… | |
64 sequence start end count remov… | |
65 | |
66 (defun split-extended-sequence-from-end (position-fn sequence start end … | |
67 (declare (optimize (speed 3) (debug 0)) | |
68 (type (function (extended-sequence fixnum) (or null fixnum)) … | |
69 (loop | |
70 :with length = (length sequence) | |
71 :with end = (or end length) | |
72 :for right := end :then left | |
73 :for left := (max (or (funcall position-fn sequence right) -1) | |
74 (1- start)) | |
75 :unless (and (= right (1+ left)) remove-empty-subseqs) | |
76 :if (and count (>= nr-elts count)) | |
77 :return (values (nreverse subseqs) right) | |
78 :else | |
79 :collect (subseq sequence (1+ left) right) into subseqs | |
80 :and :sum 1 :into nr-elts :of-type fixnum | |
81 :until (< left start) | |
82 :finally (return (values (nreverse subseqs) (1+ left))))) | |
83 | |
84 (defun split-extended-sequence-from-start (position-fn sequence start en… | |
85 (declare (optimize (speed 3) (debug 0)) | |
86 (type (function (extended-sequence fixnum) (or null fixnum)) … | |
87 (loop | |
88 :with length = (length sequence) | |
89 :with end = (or end length) | |
90 :for left := start :then (1+ right) | |
91 :for right := (min (or (funcall position-fn sequence left) length) | |
92 end) | |
93 :unless (and (= right left) remove-empty-subseqs) | |
94 :if (and count (>= nr-elts count)) | |
95 :return (values subseqs left) | |
96 :else | |
97 :collect (subseq sequence left right) :into subseqs | |
98 :and :sum 1 :into nr-elts :of-type fixnum | |
99 :until (>= right end) | |
100 :finally (return (values subseqs right)))) |