extended-sequence.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) 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 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
27 (delimiter sequence start end from-end count remove-empty-subseqs test test-not key)
28 (cond
29 ((and (not from-end) (null test-not))
30 (split-extended-sequence-from-start (lambda (sequence start)
31 (position delimiter sequence :start start :key key :test test))
32 sequence start end count remove-empty-subseqs))
33 ((and (not from-end) test-not)
34 (split-extended-sequence-from-start (lambda (sequence start)
35 (position delimiter sequence :start start :key key :test-not test-not))
36 sequence start end count remove-empty-subseqs))
37 ((and from-end (null test-not))
38 (split-extended-sequence-from-end (lambda (sequence end)
39 (position delimiter sequence :end end :from-end t :key key :test test))
40 sequence start end count remove-empty-subseqs))
41 (t
42 (split-extended-sequence-from-end (lambda (sequence end)
43 (position delimiter sequence :end end :from-end t :key key :test-not test-not))
44 sequence start end count remove-empty-subseqs))))
45
46 (defun split-extended-sequence-if
47 (predicate sequence start end from-end count remove-empty-subseqs key)
48 (if from-end
49 (split-extended-sequence-from-end (lambda (sequence end)
50 (position-if predicate sequence :end end :from-end t :key key))
51 sequence start end count remove-empty-subseqs)
52 (split-extended-sequence-from-start (lambda (sequence start)
53 (position-if predicate sequence :start start :key key))
54 sequence start end count remove-empty-subseqs)))
55
56 (defun split-extended-sequence-if-not
57 (predicate sequence start end from-end count remove-empty-subseqs key)
58 (if from-end
59 (split-extended-sequence-from-end (lambda (sequence end)
60 (position-if-not predicate sequence :end end :from-end t :key key))
61 sequence start end count remove-empty-subseqs)
62 (split-extended-sequence-from-start (lambda (sequence start)
63 (position-if-not predicate sequence :start start :key key))
64 sequence start end count remove-empty-subseqs)))
65
66 (defun split-extended-sequence-from-end (position-fn sequence start end count remove-empty-subseqs)
67 (declare (optimize (speed 3) (debug 0))
68 (type (function (extended-sequence fixnum) (or null fixnum)) position-fn))
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 end count remove-empty-subseqs)
85 (declare (optimize (speed 3) (debug 0))
86 (type (function (extended-sequence fixnum) (or null fixnum)) position-fn))
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))))