GopherProxy

	tsplit-sequence.lisp - clic - Clic is an command line interactive client for go…
	git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
	Log
	Files
	Refs
	Tags
	LICENSE
	---
	tsplit-sequence.lisp (8164B)
	---
	1 ;;;; -- Mode: Lisp; indent-tabs-mode: nil --
	2 ;;;
	3 ;;; SPLIT-SEQUENCE
	4 ;;;
	5 ;;; This code was based on Arthur Lemmens' in
	6 ;;; <URL:http://groups.google.com/groups?as_umsgid=39F36F1A.B8F19D20%40s…
	7 ;;;
	8 ;;; changes include:
	9 ;;;
	10 ;;; * altering the behaviour of the :from-end keyword argument to
	11 ;;; return the subsequences in original order, for consistency with
	12 ;;; CL:REMOVE, CL:SUBSTITUTE et al. (:from-end being non-NIL only
	13 ;;; affects the answer if :count is less than the number of
	14 ;;; subsequences, by analogy with the above-referenced functions).
	15 ;;;
	16 ;;; * changing the :maximum keyword argument to :count, by analogy
	17 ;;; with CL:REMOVE, CL:SUBSTITUTE, and so on.
	18 ;;;
	19 ;;; * naming the function SPLIT-SEQUENCE rather than PARTITION rather
	20 ;;; than SPLIT.
	21 ;;;
	22 ;;; * adding SPLIT-SEQUENCE-IF and SPLIT-SEQUENCE-IF-NOT.
	23 ;;;
	24 ;;; * The second return value is now an index rather than a copy of a
	25 ;;; portion of the sequence; this index is the `right' one to feed to
	26 ;;; CL:SUBSEQ for continued processing.
	27
	28 ;;; There's a certain amount of code duplication here, which is kept
	29 ;;; to illustrate the relationship between the SPLIT-SEQUENCE
	30 ;;; functions and the CL:POSITION functions.
	31
	32 (defpackage :split-sequence
	33 (:use :common-lisp)
	34 (:export #:split-sequence
	35 #:split-sequence-if
	36 #:split-sequence-if-not))
	37
	38 (in-package :split-sequence)
	39
	40 (deftype array-index (&optional (length array-dimension-limit))
	41 `(integer 0 (,length)))
	42
	43 (declaim (ftype (function (&rest t) (values list integer))
	44 split-sequence split-sequence-if split-sequence-if-not))
	45
	46 (declaim (ftype (function (function sequence array-index
	47 (or null array-index) (or null array…
	48 (values list integer))
	49 split-from-start split-from-end))
	50
	51 (macrolet ((check-bounds (sequence start end)
	52 (let ((length (gensym (string '#:length))))
	53 `(let ((,length (length ,sequence)))
	54 (check-type ,start unsigned-byte "a non-negative integ…
	55 (when ,end (check-type ,end unsigned-byte "a non-negat…
	56 (unless ,end
	57 (setf ,end ,length))
	58 (unless (<= ,start ,end ,length)
	59 (error "Wrong sequence bounds. start: ~S end: ~S" ,s…
	60
	61 (defun split-sequence (delimiter sequence &key (start 0) (end nil) (fr…
	62 (count nil) (remove-empty-subseqs nil)
	63 (test #'eql) (test-not nil) (key #'identity))
	64 "Return a list of subsequences in seq delimited by delimiter.
	65
	66 If :remove-empty-subseqs is NIL, empty subsequences will be included
	67 in the result; otherwise they will be discarded. All other keywords
	68 work analogously to those for CL:SUBSTITUTE. In particular, the
	69 behaviour of :from-end is possibly different from other versions of
	70 this function; :from-end values of NIL and T are equivalent unless
	71 :count is supplied. The second return value is an index suitable as an
	72 argument to CL:SUBSEQ into the sequence indicating where processing
	73 stopped."
	74 (check-bounds sequence start end)
	75 (cond
	76 ((and (not from-end) (null test-not))
	77 (split-from-start (lambda (sequence start)
	78 (position delimiter sequence :start start :ke…
	79 sequence start end count remove-empty-subseqs))
	80 ((and (not from-end) test-not)
	81 (split-from-start (lambda (sequence start)
	82 (position delimiter sequence :start start :ke…
	83 sequence start end count remove-empty-subseqs))
	84 ((and from-end (null test-not))
	85 (split-from-end (lambda (sequence end)
	86 (position delimiter sequence :end end :from-end…
	87 sequence start end count remove-empty-subseqs))
	88 (t
	89 (split-from-end (lambda (sequence end)
	90 (position delimiter sequence :end end :from-end…
	91 sequence start end count remove-empty-subseqs))))
	92
	93 (defun split-sequence-if (predicate sequence &key (start 0) (end nil) …
	94 (count nil) (remove-empty-subseqs nil) (key …
	95 "Return a list of subsequences in seq delimited by items satisfying
	96 predicate.
	97
	98 If :remove-empty-subseqs is NIL, empty subsequences will be included
	99 in the result; otherwise they will be discarded. All other keywords
	100 work analogously to those for CL:SUBSTITUTE-IF. In particular, the
	101 behaviour of :from-end is possibly different from other versions of
	102 this function; :from-end values of NIL and T are equivalent unless
	103 :count is supplied. The second return value is an index suitable as an
	104 argument to CL:SUBSEQ into the sequence indicating where processing
	105 stopped."
	106 (check-bounds sequence start end)
	107 (if from-end
	108 (split-from-end (lambda (sequence end)
	109 (position-if predicate sequence :end end :from…
	110 sequence start end count remove-empty-subseqs)
	111 (split-from-start (lambda (sequence start)
	112 (position-if predicate sequence :start start…
	113 sequence start end count remove-empty-subseqs)…
	114
	115 (defun split-sequence-if-not (predicate sequence &key (count nil) (rem…
	116 (from-end nil) (start 0) (end nil) (key …
	117 "Return a list of subsequences in seq delimited by items satisfying
	118 \(CL:COMPLEMENT predicate).
	119
	120 If :remove-empty-subseqs is NIL, empty subsequences will be included
	121 in the result; otherwise they will be discarded. All other keywords
	122 work analogously to those for CL:SUBSTITUTE-IF-NOT. In particular,
	123 the behaviour of :from-end is possibly different from other versions
	124 of this function; :from-end values of NIL and T are equivalent unless
	125 :count is supplied. The second return value is an index suitable as an
	126 argument to CL:SUBSEQ into the sequence indicating where processing
	127 stopped."
	128 (check-bounds sequence start end)
	129 (if from-end
	130 (split-from-end (lambda (sequence end)
	131 (position-if-not predicate sequence :end end :…
	132 sequence start end count remove-empty-subseqs)
	133 (split-from-start (lambda (sequence start)
	134 (position-if-not predicate sequence :start s…
	135 sequence start end count remove-empty-subseqs)…
	136
	137 (defun split-from-end (position-fn sequence start end count remove-empty…
	138 (declare (optimize (speed 3) (debug 0)))
	139 (loop
	140 :for right := end :then left
	141 :for left := (max (or (funcall position-fn sequence right) -1)
	142 (1- start))
	143 :unless (and (= right (1+ left))
	144 remove-empty-subseqs) ; empty subseq we don't want
	145 :if (and count (>= nr-elts count))
	146 ;; We can't take any more. Return now.
	147 :return (values (nreverse subseqs) right)
	148 :else
	149 :collect (subseq sequence (1+ left) right) into subseqs
	150 :and :sum 1 :into nr-elts
	151 :until (< left start)
	152 :finally (return (values (nreverse subseqs) (1+ left)))))
	153
	154 (defun split-from-start (position-fn sequence start end count remove-emp…
	155 (declare (optimize (speed 3) (debug 0)))
	156 (let ((length (length sequence)))
	157 (loop
	158 :for left := start :then (+ right 1)
	159 :for right := (min (or (funcall position-fn sequence left) length)
	160 end)
	161 :unless (and (= right left)
	162 remove-empty-subseqs) ; empty subseq we don't want
	163 :if (and count (>= nr-elts count))
	164 ;; We can't take any more. Return now.
	165 :return (values subseqs left)
	166 :else
	167 :collect (subseq sequence left right) :into subseqs
	168 :and :sum 1 :into nr-elts
	169 :until (>= right end)
	170 :finally (return (values subseqs right)))))
	171
	172 (pushnew :split-sequence features)