sbcl stuff
This commit is contained in:
Ian Keane
parent
1d1dbc34df
commit
5d91dbb667
335 changed files with 119806 additions and 1 deletions
|
|
@ -0,0 +1,21 @@
|
|||
Copyright (C) 2001-2018, Arthur Lemmens et al.
|
||||
|
||||
Permission is hereby granted, free of charge, to any person
|
||||
obtaining a copy of this software and associated documentation
|
||||
files (the "Software"), to deal in the Software without
|
||||
restriction, including without limitation the rights to use, copy,
|
||||
modify, merge, publish, distribute, sublicense, and/or sell copies
|
||||
of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be
|
||||
included in all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
|
||||
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
||||
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||||
DEALINGS IN THE SOFTWARE.
|
||||
|
|
@ -0,0 +1,109 @@
|
|||
SPLIT-SEQUENCE
|
||||
==============
|
||||
|
||||
[SPLIT-SEQUENCE](http://cliki.net/split-sequence) is a member of the
|
||||
[Common Lisp Utilities](http://cliki.net/Common%20Lisp%20Utilities)
|
||||
family of programs, designed by community consensus.
|
||||
|
||||
|
||||
_Function_ __SPLIT-SEQUENCE, SPLIT-SEQUENCE-IF, SPLIT-SEQUENCE-IF-NOT__
|
||||
|
||||
|
||||
__Syntax:__
|
||||
|
||||
__split-sequence__ _delimiter sequence `&key` count
|
||||
remove-empty-subseqs from-end start end test test-not key ⇒ list,
|
||||
index_
|
||||
|
||||
__split-sequence-if__ _predicate sequence `&key` count
|
||||
remove-empty-subseqs from-end start end key ⇒ list, index_
|
||||
|
||||
__split-sequence-if-not__ _predicate sequence `&key` count
|
||||
remove-empty-subseqs from-end start end key ⇒ list, index_
|
||||
|
||||
|
||||
__Arguments and Values:__
|
||||
|
||||
_delimiter_—an _object_.
|
||||
|
||||
_predicate_—a designator for a _function_ of one _argument_ that
|
||||
returns a _generalized boolean_.
|
||||
|
||||
_sequence_—a _proper sequence_.
|
||||
|
||||
_count_—an _integer_ or __nil__. The default is __nil__.
|
||||
|
||||
_remove-empty-subseqs_—a _generalized boolean_. The default is
|
||||
_false_.
|
||||
|
||||
_from-end_—a _generalized boolean_. The default is _false_.
|
||||
|
||||
_start, end_—_bounding index designators_ of _sequence_. The
|
||||
defaults for _start_ and _end_ are __0__ and __nil__, respectively.
|
||||
|
||||
_test_—a _designator_ for a _function_ of two _arguments_ that
|
||||
returns a _generalized boolean_.
|
||||
|
||||
_test-not_—a _designator_ for a _function_ of two _arguments_
|
||||
that returns a _generalized boolean_.
|
||||
|
||||
_key_—a _designator_ for a _function_ of one _argument_, or
|
||||
__nil__.
|
||||
|
||||
_list_—a _proper sequence_.
|
||||
|
||||
_index_—an _integer_ greater than or equal to zero, and less
|
||||
than or equal to the _length_ of the _sequence_.
|
||||
|
||||
|
||||
__Description:__
|
||||
|
||||
Splits _sequence_ into a list of subsequences delimited by objects
|
||||
_satisfying the test_.
|
||||
|
||||
_List_ is a list of sequences of the same kind as _sequence_ that has
|
||||
elements consisting of subsequences of _sequence_ that were delimited
|
||||
in the argument by elements _satisfying the test_. Index is an index
|
||||
into _sequence_ indicating the unprocessed region, suitable as an
|
||||
argument to
|
||||
[subseq](http://www.lispworks.com/documentation/HyperSpec/Body/f_subseq.htm)
|
||||
to continue processing in the same manner if desired.
|
||||
|
||||
The _count_ argument, if supplied, limits the number of subsequences
|
||||
in the first return value; if more than _count_ delimited subsequences
|
||||
exist in _sequence_, the _count_ leftmost delimited subsequences will
|
||||
be in order in the first return value, and the second return value
|
||||
will be the index into _sequence_ at which processing stopped.
|
||||
|
||||
If _from-end_ is non-null, _sequence_ is conceptually processed from
|
||||
right to left, accumulating the subsequences in reverse order;
|
||||
_from-end_ only makes a difference in the case of a non-null _count_
|
||||
argument. In the presence of _from-end_, the _count_ rightmost
|
||||
delimited subsequences will be in the order that they are in
|
||||
_sequence_ in the first return value, and the second is the index
|
||||
indicating the end of the unprocessed region.
|
||||
|
||||
The _start_ and _end_ keyword arguments permit a certain subsequence
|
||||
of the _sequence_ to be processed without the need for a copying
|
||||
stage; their use is conceptually equivalent to partitioning the
|
||||
subsequence delimited by _start_ and _end_, only without the need for
|
||||
copying.
|
||||
|
||||
If _remove-empty-subseqs_ is null (the default), then empty
|
||||
subsequences will be included in the result.
|
||||
|
||||
In all cases, the subsequences in the first return value will be in
|
||||
the order that they appeared in _sequence_.
|
||||
|
||||
|
||||
__Examples:__
|
||||
|
||||
<pre>
|
||||
SPLIT-SEQUENCE> (split-sequence #\Space "A stitch in time saves nine.")
|
||||
⇒ ("A" "stitch" "in" "time" "saves" "nine.")
|
||||
⇒ 28
|
||||
|
||||
SPLIT-SEQUENCE> (split-sequence #\, "foo,bar ,baz, foobar , barbaz,")
|
||||
⇒ ("foo" "bar " "baz" " foobar " " barbaz" "")
|
||||
⇒ 30
|
||||
</pre>
|
||||
|
|
@ -0,0 +1,79 @@
|
|||
;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
|
||||
|
||||
(in-package :split-sequence)
|
||||
|
||||
(defun list-long-enough-p (list length)
|
||||
(or (zerop length)
|
||||
(not (null (nthcdr (1- length) list)))))
|
||||
|
||||
(defun check-bounds (sequence start end)
|
||||
(progn
|
||||
(check-type start unsigned-byte "a non-negative integer")
|
||||
(check-type end (or null unsigned-byte) "a non-negative integer or NIL")
|
||||
(typecase sequence
|
||||
(list
|
||||
(when end
|
||||
(unless (list-long-enough-p sequence end)
|
||||
(error "The list is too short: END was ~S but the list is ~S elements long."
|
||||
end (length sequence)))))
|
||||
(t
|
||||
(let ((length (length sequence)))
|
||||
(unless end (setf end length))
|
||||
(unless (<= start end length)
|
||||
(error "Wrong sequence bounds. START: ~S END: ~S" start end)))))))
|
||||
|
||||
(define-condition simple-program-error (program-error simple-condition) ())
|
||||
|
||||
(defmacro check-tests (test test-p test-not test-not-p)
|
||||
`(progn
|
||||
(when (and ,test-p ,test-not-p)
|
||||
(error (make-condition 'simple-program-error
|
||||
:format-control "Cannot specify both TEST and TEST-NOT.")))
|
||||
(when (and ,test-not-p (not ,test-p))
|
||||
(check-type ,test-not (or function (and symbol (not null)))))
|
||||
(when (and ,test-p (not ,test-not-p))
|
||||
(check-type ,test (or function (and symbol (not null)))))))
|
||||
|
||||
(declaim (ftype (function (&rest t) (values list unsigned-byte))
|
||||
split-sequence split-sequence-if split-sequence-if-not))
|
||||
|
||||
(defun split-sequence (delimiter sequence &key (start 0) (end nil) (from-end nil)
|
||||
(count nil) (remove-empty-subseqs nil)
|
||||
(test #'eql test-p) (test-not nil test-not-p)
|
||||
(key #'identity))
|
||||
(check-bounds sequence start end)
|
||||
(check-tests test test-p test-not test-not-p)
|
||||
(etypecase sequence
|
||||
(list (split-list delimiter sequence start end from-end count
|
||||
remove-empty-subseqs test test-not key))
|
||||
(vector (split-vector delimiter sequence start end from-end count
|
||||
remove-empty-subseqs test test-not key))
|
||||
#+(or abcl sbcl)
|
||||
(extended-sequence (split-extended-sequence delimiter sequence start end from-end count
|
||||
remove-empty-subseqs test test-not key))))
|
||||
|
||||
(defun split-sequence-if (predicate sequence &key (start 0) (end nil) (from-end nil)
|
||||
(count nil) (remove-empty-subseqs nil) (key #'identity))
|
||||
(check-bounds sequence start end)
|
||||
(etypecase sequence
|
||||
(list (split-list-if predicate sequence start end from-end count
|
||||
remove-empty-subseqs key))
|
||||
(vector (split-vector-if predicate sequence start end from-end count
|
||||
remove-empty-subseqs key))
|
||||
#+(or abcl sbcl)
|
||||
(extended-sequence (split-extended-sequence-if predicate sequence start end from-end count
|
||||
remove-empty-subseqs key))))
|
||||
|
||||
(defun split-sequence-if-not (predicate sequence &key (start 0) (end nil) (from-end nil)
|
||||
(count nil) (remove-empty-subseqs nil) (key #'identity))
|
||||
(check-bounds sequence start end)
|
||||
(etypecase sequence
|
||||
(list (split-list-if-not predicate sequence start end from-end count
|
||||
remove-empty-subseqs key))
|
||||
(vector (split-vector-if-not predicate sequence start end from-end count
|
||||
remove-empty-subseqs key))
|
||||
#+(or abcl sbcl)
|
||||
(extended-sequence (split-extended-sequence-if-not predicate sequence start end from-end count
|
||||
remove-empty-subseqs key))))
|
||||
|
||||
(pushnew :split-sequence *features*)
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
|
||||
|
||||
(in-package :split-sequence)
|
||||
|
||||
(setf (documentation 'split-sequence 'function)
|
||||
"Return a list of subsequences in seq delimited by delimiter.
|
||||
If :remove-empty-subseqs is NIL, empty subsequences will be included
|
||||
in the result; otherwise they will be discarded. All other keywords
|
||||
work analogously to those for CL:SUBSTITUTE. In particular, the
|
||||
behaviour of :from-end is possibly different from other versions of
|
||||
this function; :from-end values of NIL and T are equivalent unless
|
||||
:count is supplied. :count limits the number of subseqs in the main
|
||||
resulting list. The second return value is an index suitable as an
|
||||
argument to CL:SUBSEQ into the sequence indicating where processing
|
||||
stopped.")
|
||||
|
||||
(setf (documentation 'split-sequence-if 'function)
|
||||
"Return a list of subsequences in seq delimited by items satisfying
|
||||
predicate.
|
||||
If :remove-empty-subseqs is NIL, empty subsequences will be included
|
||||
in the result; otherwise they will be discarded. All other keywords
|
||||
work analogously to those for CL:SUBSTITUTE-IF. In particular, the
|
||||
behaviour of :from-end is possibly different from other versions of
|
||||
this function; :from-end values of NIL and T are equivalent unless
|
||||
:count is supplied. :count limits the number of subseqs in the main
|
||||
resulting list. The second return value is an index suitable as an
|
||||
argument to CL:SUBSEQ into the sequence indicating where processing
|
||||
stopped.")
|
||||
|
||||
(setf (documentation 'split-sequence-if-not 'function)
|
||||
"Return a list of subsequences in seq delimited by items satisfying
|
||||
\(CL:COMPLEMENT predicate).
|
||||
If :remove-empty-subseqs is NIL, empty subsequences will be included
|
||||
in the result; otherwise they will be discarded. All other keywords
|
||||
work analogously to those for CL:SUBSTITUTE-IF-NOT. In particular,
|
||||
the behaviour of :from-end is possibly different from other versions
|
||||
of this function; :from-end values of NIL and T are equivalent unless
|
||||
:count is supplied. :count limits the number of subseqs in the main
|
||||
resulting list. The second return value is an index suitable as an
|
||||
argument to CL:SUBSEQ into the sequence indicating where processing
|
||||
stopped.")
|
||||
|
|
@ -0,0 +1,100 @@
|
|||
;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
|
||||
|
||||
(in-package :split-sequence)
|
||||
|
||||
;;; For extended sequences, we make the assumption that all extended sequences
|
||||
;;; can be at most ARRAY-DIMENSION-LIMIT long. This seems to match what SBCL
|
||||
;;; assumes about them.
|
||||
|
||||
;;; TODO test this code. This will require creating such an extended sequence.
|
||||
|
||||
(deftype extended-sequence ()
|
||||
'(and sequence (not list) (not vector)))
|
||||
|
||||
(declaim (inline
|
||||
split-extended-sequence split-extended-sequence-if split-extended-sequence-if-not
|
||||
split-extended-sequence-from-end split-extended-sequence-from-start))
|
||||
|
||||
(declaim (ftype (function (&rest t) (values list unsigned-byte))
|
||||
split-extended-sequence split-extended-sequence-if split-extended-sequence-if-not))
|
||||
|
||||
(declaim (ftype (function (function extended-sequence array-index
|
||||
(or null fixnum) (or null fixnum) boolean)
|
||||
(values list fixnum))
|
||||
split-extended-sequence-from-start split-extended-sequence-from-end))
|
||||
|
||||
(defun split-extended-sequence
|
||||
(delimiter sequence start end from-end count remove-empty-subseqs test test-not key)
|
||||
(cond
|
||||
((and (not from-end) (null test-not))
|
||||
(split-extended-sequence-from-start (lambda (sequence start)
|
||||
(position delimiter sequence :start start :key key :test test))
|
||||
sequence start end count remove-empty-subseqs))
|
||||
((and (not from-end) test-not)
|
||||
(split-extended-sequence-from-start (lambda (sequence start)
|
||||
(position delimiter sequence :start start :key key :test-not test-not))
|
||||
sequence start end count remove-empty-subseqs))
|
||||
((and from-end (null test-not))
|
||||
(split-extended-sequence-from-end (lambda (sequence end)
|
||||
(position delimiter sequence :end end :from-end t :key key :test test))
|
||||
sequence start end count remove-empty-subseqs))
|
||||
(t
|
||||
(split-extended-sequence-from-end (lambda (sequence end)
|
||||
(position delimiter sequence :end end :from-end t :key key :test-not test-not))
|
||||
sequence start end count remove-empty-subseqs))))
|
||||
|
||||
(defun split-extended-sequence-if
|
||||
(predicate sequence start end from-end count remove-empty-subseqs key)
|
||||
(if from-end
|
||||
(split-extended-sequence-from-end (lambda (sequence end)
|
||||
(position-if predicate sequence :end end :from-end t :key key))
|
||||
sequence start end count remove-empty-subseqs)
|
||||
(split-extended-sequence-from-start (lambda (sequence start)
|
||||
(position-if predicate sequence :start start :key key))
|
||||
sequence start end count remove-empty-subseqs)))
|
||||
|
||||
(defun split-extended-sequence-if-not
|
||||
(predicate sequence start end from-end count remove-empty-subseqs key)
|
||||
(if from-end
|
||||
(split-extended-sequence-from-end (lambda (sequence end)
|
||||
(position-if-not predicate sequence :end end :from-end t :key key))
|
||||
sequence start end count remove-empty-subseqs)
|
||||
(split-extended-sequence-from-start (lambda (sequence start)
|
||||
(position-if-not predicate sequence :start start :key key))
|
||||
sequence start end count remove-empty-subseqs)))
|
||||
|
||||
(defun split-extended-sequence-from-end (position-fn sequence start end count remove-empty-subseqs)
|
||||
(declare (optimize (speed 3) (debug 0))
|
||||
(type (function (extended-sequence fixnum) (or null fixnum)) position-fn))
|
||||
(loop
|
||||
:with length = (length sequence)
|
||||
:with end = (or end length)
|
||||
:for right := end :then left
|
||||
:for left := (max (or (funcall position-fn sequence right) -1)
|
||||
(1- start))
|
||||
:unless (and (= right (1+ left)) remove-empty-subseqs)
|
||||
:if (and count (>= nr-elts count))
|
||||
:return (values (nreverse subseqs) right)
|
||||
:else
|
||||
:collect (subseq sequence (1+ left) right) into subseqs
|
||||
:and :sum 1 :into nr-elts :of-type fixnum
|
||||
:until (< left start)
|
||||
:finally (return (values (nreverse subseqs) (1+ left)))))
|
||||
|
||||
(defun split-extended-sequence-from-start (position-fn sequence start end count remove-empty-subseqs)
|
||||
(declare (optimize (speed 3) (debug 0))
|
||||
(type (function (extended-sequence fixnum) (or null fixnum)) position-fn))
|
||||
(loop
|
||||
:with length = (length sequence)
|
||||
:with end = (or end length)
|
||||
:for left := start :then (1+ right)
|
||||
:for right := (min (or (funcall position-fn sequence left) length)
|
||||
end)
|
||||
:unless (and (= right left) remove-empty-subseqs)
|
||||
:if (and count (>= nr-elts count))
|
||||
:return (values subseqs left)
|
||||
:else
|
||||
:collect (subseq sequence left right) :into subseqs
|
||||
:and :sum 1 :into nr-elts :of-type fixnum
|
||||
:until (>= right end)
|
||||
:finally (return (values subseqs right))))
|
||||
|
|
@ -0,0 +1,116 @@
|
|||
;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
|
||||
|
||||
(in-package :split-sequence)
|
||||
|
||||
(declaim (inline
|
||||
collect-until count-while
|
||||
split-list split-list-if split-list-if-not
|
||||
split-list-from-end split-list-from-start split-list-internal))
|
||||
|
||||
(declaim (ftype (function (&rest t) (values list unsigned-byte))
|
||||
split-list split-list-if split-list-if-not))
|
||||
|
||||
(declaim (ftype (function (function list unsigned-byte (or null unsigned-byte) (or null unsigned-byte)
|
||||
boolean)
|
||||
(values list unsigned-byte))
|
||||
split-list-from-start split-list-from-end split-list-internal))
|
||||
|
||||
(defun collect-until (predicate list end)
|
||||
"Collect elements from LIST until one that satisfies PREDICATE is found.
|
||||
|
||||
At most END elements will be examined. If END is null, all elements will be examined.
|
||||
|
||||
Returns four values:
|
||||
|
||||
* The collected items.
|
||||
* The remaining items.
|
||||
* The number of elements examined.
|
||||
* Whether the search ended by running off the end, instead of by finding a delimiter."
|
||||
(let ((examined 0)
|
||||
(found nil))
|
||||
(flet ((examine (value)
|
||||
(incf examined)
|
||||
(setf found (funcall predicate value))))
|
||||
(loop :for (value . remaining) :on list
|
||||
:until (eql examined end)
|
||||
:until (examine value)
|
||||
:collect value :into result
|
||||
:finally (return (values result
|
||||
remaining
|
||||
examined
|
||||
(and (not found)
|
||||
(or (null end)
|
||||
(= end examined)))))))))
|
||||
|
||||
(defun count-while (predicate list end)
|
||||
"Count the number of elements satisfying PREDICATE at the beginning of LIST.
|
||||
|
||||
At most END elements will be counted. If END is null, all elements will be examined."
|
||||
(if end
|
||||
(loop :for value :in list
|
||||
:for i :below end
|
||||
:while (funcall predicate value)
|
||||
:summing 1)
|
||||
(loop :for value :in list
|
||||
:while (funcall predicate value)
|
||||
:summing 1)))
|
||||
|
||||
(defun split-list-internal (predicate list start end count remove-empty-subseqs)
|
||||
(let ((count count)
|
||||
(done nil)
|
||||
(index start)
|
||||
(end (when end (- end start)))
|
||||
(list (nthcdr start list)))
|
||||
(flet ((should-collect-p (chunk)
|
||||
(unless (and remove-empty-subseqs (null chunk))
|
||||
(when (numberp count) (decf count))
|
||||
t))
|
||||
(gather-chunk ()
|
||||
(multiple-value-bind (chunk remaining examined ran-off-end)
|
||||
(collect-until predicate list end)
|
||||
(incf index examined)
|
||||
(when end (decf end examined))
|
||||
(setf list remaining
|
||||
done ran-off-end)
|
||||
chunk)))
|
||||
(values (loop :with chunk
|
||||
:until (or done (eql 0 count))
|
||||
:do (setf chunk (gather-chunk))
|
||||
:when (should-collect-p chunk)
|
||||
:collect chunk)
|
||||
(+ index
|
||||
(if remove-empty-subseqs
|
||||
(count-while predicate list end) ; chew off remaining empty seqs
|
||||
0))))))
|
||||
|
||||
(defun split-list-from-end (predicate list start end count remove-empty-subseqs)
|
||||
(let ((length (length list)))
|
||||
(multiple-value-bind (result index)
|
||||
(split-list-internal predicate (reverse list)
|
||||
(if end (- length end) 0)
|
||||
(- length start) count remove-empty-subseqs)
|
||||
(loop :for cons on result
|
||||
:for car := (car cons)
|
||||
:do (setf (car cons) (nreverse car)))
|
||||
(values (nreverse result) (- length index)))))
|
||||
|
||||
(defun split-list-from-start (predicate list start end count remove-empty-subseqs)
|
||||
(split-list-internal predicate list start end count remove-empty-subseqs))
|
||||
|
||||
(defun split-list-if (predicate list start end from-end count remove-empty-subseqs key)
|
||||
(let ((predicate (lambda (x) (funcall predicate (funcall key x)))))
|
||||
(if from-end
|
||||
(split-list-from-end predicate list start end count remove-empty-subseqs)
|
||||
(split-list-from-start predicate list start end count remove-empty-subseqs))))
|
||||
|
||||
(defun split-list-if-not (predicate list start end from-end count remove-empty-subseqs key)
|
||||
(split-list-if (complement predicate) list start end from-end count remove-empty-subseqs key))
|
||||
|
||||
(defun split-list
|
||||
(delimiter list start end from-end count remove-empty-subseqs test test-not key)
|
||||
(let ((predicate (if test-not
|
||||
(lambda (x) (not (funcall test-not delimiter (funcall key x))))
|
||||
(lambda (x) (funcall test delimiter (funcall key x))))))
|
||||
(if from-end
|
||||
(split-list-from-end predicate list start end count remove-empty-subseqs)
|
||||
(split-list-from-start predicate list start end count remove-empty-subseqs))))
|
||||
|
|
@ -0,0 +1,150 @@
|
|||
From ...
|
||||
Path: supernews.google.com!sn-xit-02!sn-xit-03!supernews.com!news.tele.dk!193.190.198.17!newsfeeds.belnet.be!
|
||||
news.belnet.be!skynet.be!newsfeed2.news.nl.uu.net!sun4nl!not-for-mail
|
||||
From: Arthur Lemmens <lemmens@simplex.nl>
|
||||
Newsgroups: comp.lang.lisp
|
||||
Subject: Re: Q: on hashes and counting
|
||||
Date: Mon, 23 Oct 2000 00:50:02 +0200
|
||||
Organization: Kikashi Software
|
||||
Lines: 129
|
||||
Message-ID: <39F36F1A.B8F19D20@simplex.nl>
|
||||
References: <8sl58e$ivq$1@nnrp1.deja.com> <878zrlp1cr.fsf@orion.bln.pmsf.de>
|
||||
Mime-Version: 1.0
|
||||
Content-Type: text/plain; charset=us-ascii
|
||||
Content-Transfer-Encoding: 7bit
|
||||
X-Trace: porthos.nl.uu.net 972255051 2606 193.78.46.221 (22 Oct 2000 22:50:51 GMT)
|
||||
X-Complaints-To: abuse@nl.uu.net
|
||||
NNTP-Posting-Date: 22 Oct 2000 22:50:51 GMT
|
||||
X-Mailer: Mozilla 4.5 [en] (Win98; I)
|
||||
X-Accept-Language: en
|
||||
Xref: supernews.google.com comp.lang.lisp:2515
|
||||
|
||||
|
||||
Pierre R. Mai wrote:
|
||||
|
||||
> ;;; The following functions are based on the versions by Arthur
|
||||
> ;;; Lemmens of the original code by Bernard Pfahringer posted to
|
||||
> ;;; comp.lang.lisp. I only renamed and diddled them a bit.
|
||||
>
|
||||
> (defun partition
|
||||
|
||||
[snip]
|
||||
|
||||
> ;; DO: Find a more efficient way to take care of :from-end T.
|
||||
> (when from-end
|
||||
> (setf seq (reverse seq))
|
||||
> (psetf start (- len end)
|
||||
> end (- len start)))
|
||||
|
||||
I've written a different version now for dealing with :FROM-END T.
|
||||
It doesn't call REVERSE anymore, which makes it more efficient.
|
||||
Also, I prefer the new semantics. Stuff like
|
||||
(split #\space "one two three " :from-end t)
|
||||
now returns
|
||||
("three" "two" "one")
|
||||
which I find a lot more useful than
|
||||
("eerht" "owt" "eno")
|
||||
If you prefer the latter, it's easy enough to use
|
||||
(split #\space (reverse "one two three "))
|
||||
|
||||
|
||||
Here it is (feel free to use this code any way you like):
|
||||
|
||||
(defun SPLIT (delimiter seq
|
||||
&key (maximum nil)
|
||||
(keep-empty-subseqs nil)
|
||||
(from-end nil)
|
||||
(start 0)
|
||||
(end nil)
|
||||
(test nil test-supplied)
|
||||
(test-not nil test-not-supplied)
|
||||
(key nil key-supplied))
|
||||
|
||||
"Return a list of subsequences in <seq> delimited by <delimiter>.
|
||||
If :keep-empty-subseqs is true, empty subsequences will be included
|
||||
in the result; otherwise they will be discarded.
|
||||
If :maximum is supplied, the result will contain no more than :maximum
|
||||
(possibly empty) subsequences. The second result value contains the
|
||||
unsplit rest of the sequence.
|
||||
All other keywords work analogously to those for CL:POSITION."
|
||||
|
||||
;; DO: Make ":keep-delimiters t" include the delimiters in the result (?).
|
||||
|
||||
(let ((len (length seq))
|
||||
(other-keys (nconc (when test-supplied
|
||||
(list :test test))
|
||||
(when test-not-supplied
|
||||
(list :test-not test-not))
|
||||
(when key-supplied
|
||||
(list :key key)))))
|
||||
|
||||
(unless end (setq end len))
|
||||
(if from-end
|
||||
(loop for right = end then left
|
||||
for left = (max (or (apply #'position delimiter seq
|
||||
:end right
|
||||
:from-end t
|
||||
other-keys)
|
||||
-1)
|
||||
(1- start))
|
||||
unless (and (= right (1+ left) )
|
||||
(not keep-empty-subseqs)) ; empty subseq we don't want
|
||||
if (and maximum (>= nr-elts maximum))
|
||||
;; We can't take any more. Return now.
|
||||
return (values subseqs (subseq seq start right))
|
||||
else
|
||||
collect (subseq seq (1+ left) right) into subseqs
|
||||
and sum 1 into nr-elts
|
||||
until (<= left start)
|
||||
finally return (values subseqs (subseq seq start (1+ left))))
|
||||
(loop for left = start then (+ right 1)
|
||||
for right = (min (or (apply #'position delimiter seq
|
||||
:start left
|
||||
other-keys)
|
||||
len)
|
||||
end)
|
||||
unless (and (= right left)
|
||||
(not keep-empty-subseqs)) ; empty subseq we don't want
|
||||
if (and maximum (>= nr-elts maximum))
|
||||
;; We can't take any more. Return now.
|
||||
return (values subseqs (subseq seq left end))
|
||||
else
|
||||
collect (subseq seq left right) into subseqs
|
||||
and sum 1 into nr-elts
|
||||
until (= right end)
|
||||
finally return (values subseqs (subseq seq right end))))))
|
||||
|
||||
|
||||
|
||||
Here are some examples of how you can use this:
|
||||
|
||||
|
||||
CL-USER 2 > (split #\space "word1 word2 word3")
|
||||
("word1" "word2" "word3")
|
||||
""
|
||||
|
||||
CL-USER 3 > (split #\space "word1 word2 word3" :from-end t)
|
||||
("word3" "word2" "word1")
|
||||
""
|
||||
|
||||
CL-USER 4 > (split nil '(a b nil c d e nil nil nil nil f) :maximum 2)
|
||||
((A B) (C D E))
|
||||
(F)
|
||||
|
||||
CL-USER 5 > (split #\space "Nospaceshere.")
|
||||
("Nospaceshere.")
|
||||
""
|
||||
|
||||
CL-USER 6 > (split #\; "12;13;;14" :keep-empty-subseqs t)
|
||||
|
||||
("12" "13" "" "14")
|
||||
""
|
||||
|
||||
CL-USER 7 > (split #\; "12;13;;14" :keep-empty-subseqs t :from-end t)
|
||||
|
||||
("14" "" "13" "12")
|
||||
""
|
||||
|
||||
CL-USER 8 > (split #\space "Nospaceshere. ")
|
||||
("Nospaceshere.")
|
||||
""
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
|
||||
;;;
|
||||
;;; SPLIT-SEQUENCE
|
||||
;;;
|
||||
;;; This code was based on Arthur Lemmens' in
|
||||
;;; <URL:http://groups.google.com/groups?as_umsgid=39F36F1A.B8F19D20%40simplex.nl>;
|
||||
;;;
|
||||
;;; changes include:
|
||||
;;;
|
||||
;;; * altering the behaviour of the :from-end keyword argument to
|
||||
;;; return the subsequences in original order, for consistency with
|
||||
;;; CL:REMOVE, CL:SUBSTITUTE et al. (:from-end being non-NIL only
|
||||
;;; affects the answer if :count is less than the number of
|
||||
;;; subsequences, by analogy with the above-referenced functions).
|
||||
;;;
|
||||
;;; * changing the :maximum keyword argument to :count, by analogy
|
||||
;;; with CL:REMOVE, CL:SUBSTITUTE, and so on.
|
||||
;;;
|
||||
;;; * naming the function SPLIT-SEQUENCE rather than PARTITION rather
|
||||
;;; than SPLIT.
|
||||
;;;
|
||||
;;; * adding SPLIT-SEQUENCE-IF and SPLIT-SEQUENCE-IF-NOT.
|
||||
;;;
|
||||
;;; * The second return value is now an index rather than a copy of a
|
||||
;;; portion of the sequence; this index is the `right' one to feed to
|
||||
;;; CL:SUBSEQ for continued processing.
|
||||
|
||||
;;; There's a certain amount of code duplication in the vector and
|
||||
;;; extended sequence modules, which is kept to illustrate the
|
||||
;;; relationship between the SPLIT-SEQUENCE functions and the
|
||||
;;; CL:POSITION functions.
|
||||
|
||||
(defpackage #:split-sequence
|
||||
(:use #:common-lisp)
|
||||
(:export #:split-sequence
|
||||
#:split-sequence-if
|
||||
#:split-sequence-if-not))
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
;;; -*- Lisp -*-
|
||||
|
||||
(defsystem :split-sequence
|
||||
:author "Arthur Lemmens <alemmens@xs4all.nl>"
|
||||
:maintainer "Sharp Lispers <sharplispers@googlegroups.com>"
|
||||
:description "Splits a sequence into a list of subsequences
|
||||
delimited by objects satisfying a test."
|
||||
:license "MIT"
|
||||
:version (:read-file-form "version.sexp")
|
||||
:components ((:static-file "version.sexp")
|
||||
(:file "package")
|
||||
(:file "vector")
|
||||
(:file "list")
|
||||
(:file "extended-sequence" :if-feature (:or :sbcl :abcl))
|
||||
(:file "api")
|
||||
(:file "documentation")))
|
||||
|
||||
(defsystem :split-sequence/tests
|
||||
:author "Arthur Lemmens <alemmens@xs4all.nl>"
|
||||
:maintainer "Sharp Lispers <sharplispers@googlegroups.com>"
|
||||
:description "Split-Sequence test suite"
|
||||
:license "MIT"
|
||||
:depends-on (:split-sequence :fiveam)
|
||||
:components ((:file "tests")))
|
||||
|
||||
(defmethod perform ((o test-op) (c (eql (find-system :split-sequence))))
|
||||
(load-system :split-sequence/tests)
|
||||
(symbol-call :5am :run! :split-sequence))
|
||||
|
|
@ -0,0 +1,268 @@
|
|||
;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
|
||||
|
||||
(defpackage :split-sequence/tests
|
||||
(:use :common-lisp :split-sequence :fiveam))
|
||||
|
||||
(in-package :split-sequence/tests)
|
||||
|
||||
(in-suite* :split-sequence)
|
||||
|
||||
;;; UNIT TESTS
|
||||
|
||||
(defmacro define-test (name (&key input output index) &body forms)
|
||||
;; This macro automatically generates test code for testing vector and list input.
|
||||
;; Vector input and output is automatically coerced into list form for the list tests.
|
||||
;; (DEFINE-TEST FOO ...) generates FIVEAM tests FOO.VECTOR and FOO.LIST.
|
||||
(check-type name symbol)
|
||||
(check-type input (cons symbol (cons vector null)))
|
||||
(check-type output (cons symbol (cons list null)))
|
||||
(check-type index (cons symbol (cons unsigned-byte null)))
|
||||
(let* ((input-symbol (first input)) (vector-input (second input))
|
||||
(output-symbol (first output)) (vector-output (second output))
|
||||
(index-symbol (first index)) (index-value (second index))
|
||||
(list-input (coerce vector-input 'list))
|
||||
(list-output (mapcar (lambda (x) (coerce x 'list)) vector-output))
|
||||
(vector-name (intern (concatenate 'string (symbol-name name) ".VECTOR")))
|
||||
(list-name (intern (concatenate 'string (symbol-name name) ".LIST"))))
|
||||
`(progn
|
||||
(test (,vector-name :compile-at :definition-time)
|
||||
(let ((,input-symbol ',vector-input)
|
||||
(,output-symbol ',vector-output)
|
||||
(,index-symbol ,index-value))
|
||||
,@forms))
|
||||
(test (,list-name :compile-at :definition-time)
|
||||
(let ((,input-symbol ',list-input)
|
||||
(,output-symbol ',list-output)
|
||||
(,index-symbol ,index-value))
|
||||
,@forms)))))
|
||||
|
||||
(define-test split-sequence.0 (:input (input "")
|
||||
:output (output (""))
|
||||
:index (index 0))
|
||||
(is (equalp (split-sequence #\; input)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.1 (:input (input "a;;b;c")
|
||||
:output (output ("a" "" "b" "c"))
|
||||
:index (index 6))
|
||||
(is (equalp (split-sequence #\; input)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.2 (:input (input "a;;b;c")
|
||||
:output (output ("a" "" "b" "c"))
|
||||
:index (index 0))
|
||||
(is (equalp (split-sequence #\; input :from-end t)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.3 (:input (input "a;;b;c")
|
||||
:output (output ("c"))
|
||||
:index (index 4))
|
||||
(is (equalp (split-sequence #\; input :from-end t :count 1)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.4 (:input (input "a;;b;c")
|
||||
:output (output ("a" "b" "c"))
|
||||
:index (index 6))
|
||||
(is (equalp (split-sequence #\; input :remove-empty-subseqs t)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.5 (:input (input ";oo;bar;ba;")
|
||||
:output (output ("oo" "bar" "b"))
|
||||
:index (index 9))
|
||||
(is (equalp (split-sequence #\; input :start 1 :end 9)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.6 (:input (input "abracadabra")
|
||||
:output (output ("" "br" "c" "d" "br" ""))
|
||||
:index (index 11))
|
||||
(is (equalp (split-sequence #\A input :key #'char-upcase)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.7 (:input (input "abracadabra")
|
||||
:output (output ("r" "c" "d"))
|
||||
:index (index 7))
|
||||
(is (equalp (split-sequence #\A input :key #'char-upcase :start 2 :end 7)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.8 (:input (input "abracadabra")
|
||||
:output (output ("r" "c" "d"))
|
||||
:index (index 2))
|
||||
(is (equalp (split-sequence #\A input :key #'char-upcase :start 2 :end 7 :from-end t)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.9 (:input (input #(1 2 0))
|
||||
:output (output (#(1 2) #()))
|
||||
:index (index 0))
|
||||
(is (equalp (split-sequence 0 input :from-end t)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.10 (:input (input #(2 0 0 2 3 2 0 1 0 3))
|
||||
:output (output ())
|
||||
:index (index 8))
|
||||
(is (equalp (split-sequence 0 input :start 8 :end 9 :from-end t :count 0 :remove-empty-subseqs t)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.11 (:input (input #(0 1 3 0 3 1 2 2 1 0))
|
||||
:output (output ())
|
||||
:index (index 0))
|
||||
(is (equalp (split-sequence 0 input :start 0 :end 0 :remove-empty-subseqs t)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.12 (:input (input #(3 0 0 0 3 3 0 3 1 0))
|
||||
:output (output ())
|
||||
:index (index 10))
|
||||
(is (equalp (split-sequence 0 input :start 9 :end 10 :from-end t :count 0)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.13 (:input (input #(3 3 3 3 0 2 0 0 1 2))
|
||||
:output (output (#(1)))
|
||||
:index (index 6))
|
||||
(is (equalp (split-sequence 0 input :start 6 :end 9 :from-end t :count 1 :remove-empty-subseqs t)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.14 (:input (input #(1 0))
|
||||
:output (output (#(1)))
|
||||
:index (index 0))
|
||||
(is (equalp (split-sequence 0 input :from-end t :count 1 :remove-empty-subseqs t)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.15 (:input (input #(0 0))
|
||||
:output (output ())
|
||||
:index (index 1))
|
||||
(is (equalp (split-sequence 0 input :start 0 :end 1 :count 0 :remove-empty-subseqs t)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.16 (:input (input "a;;b;c")
|
||||
:output (output ("" ";;" ";" ""))
|
||||
:index (index 6))
|
||||
(is (equalp (split-sequence #\; input :test-not #'eql)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.17 (:input (input "a;;b;c")
|
||||
:output (output ("" ";;" ";" ""))
|
||||
:index (index 0))
|
||||
(is (equalp (split-sequence #\; input :from-end t :test-not #'eql)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence.18 (:input (input #(1 0 2 0 3 0 4))
|
||||
:output (output (#(1) #(2) #(3)))
|
||||
:index (index 6))
|
||||
(is (equalp (split-sequence 0 input :count 3)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence-if.1 (:input (input "abracadabra")
|
||||
:output (output ("" "" "r" "c" "d" "" "r" ""))
|
||||
:index (index 11))
|
||||
(is (equalp (split-sequence-if (lambda (x) (member x '(#\a #\b))) input)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence-if.2 (:input (input "123456")
|
||||
:output (output ("1" "3" "5"))
|
||||
:index (index 6))
|
||||
(is (equalp (split-sequence-if (lambda (x) (evenp (parse-integer (string x)))) input
|
||||
:remove-empty-subseqs t)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence-if.3 (:input (input "123456")
|
||||
:output (output ("1" "3" "5" ""))
|
||||
:index (index 6))
|
||||
(is (equalp (split-sequence-if (lambda (x) (evenp (parse-integer (string x)))) input)
|
||||
(values output index))))
|
||||
|
||||
(define-test split-sequence-if-not.1 (:input (input "abracadabra")
|
||||
:output (output ("ab" "a" "a" "ab" "a"))
|
||||
:index (index 11))
|
||||
(is (equalp (split-sequence-if-not (lambda (x) (member x '(#\a #\b))) input)
|
||||
(values output index))))
|
||||
|
||||
(test split-sequence.start-end-error
|
||||
(signals error (split-sequence 0 #(0 1 2 3) :start nil))
|
||||
(signals error (split-sequence 0 #(0 1 2 3) :end '#:end))
|
||||
(signals error (split-sequence 0 #(0 1 2 3) :start 0 :end 8))
|
||||
(signals error (split-sequence 0 #(0 1 2 3) :start 2 :end 0)))
|
||||
|
||||
(test split-sequence.test-provided
|
||||
;; Neither provided
|
||||
(is (equal '((1) (3)) (split-sequence 2 '(1 2 3))))
|
||||
;; Either provided
|
||||
(is (equal '((1) (3)) (split-sequence 2 '(1 2 3) :test #'eql)))
|
||||
(is (equal '(() (2) ()) (split-sequence 2 '(1 2 3) :test-not #'eql)))
|
||||
(signals type-error (split-sequence 2 '(1 2 3) :test nil))
|
||||
(signals type-error (split-sequence 2 '(1 2 3) :test-not nil))
|
||||
;; Both provided
|
||||
(signals program-error (split-sequence 2 '(1 2 3) :test #'eql :test-not nil))
|
||||
(signals program-error (split-sequence 2 '(1 2 3) :test nil :test-not #'eql))
|
||||
(signals program-error (split-sequence 2 '(1 2 3) :test #'eql :test-not #'eql))
|
||||
(signals program-error (split-sequence 2 '(1 2 3) :test nil :test-not nil)))
|
||||
|
||||
;;; FUZZ TEST
|
||||
|
||||
(test split-sequence.fuzz
|
||||
(fuzz :verbose nil :fiveamp t))
|
||||
|
||||
(defun fuzz (&key (max-length 100) (repetitions 1000000) (verbose t) (print-every 10000) (fiveamp nil))
|
||||
(flet ((random-vector (n)
|
||||
(let ((vector (make-array n :element-type '(unsigned-byte 2))))
|
||||
(dotimes (i n) (setf (aref vector i) (random 4)))
|
||||
vector))
|
||||
(random-boolean () (if (= 0 (random 2)) t nil))
|
||||
(fuzz-failure (vector start end from-end count remove-empty-subseqs
|
||||
expected-splits expected-index actual-splits actual-index)
|
||||
(format nil "Fuzz failure:
|
||||
\(MULTIPLE-VALUE-CALL #'VALUES
|
||||
(SPLIT-SEQUENCE 0 ~S
|
||||
:START ~S :END ~S :FROM-END ~S :COUNT ~S :REMOVE-EMPTY-SUBSEQS ~S)
|
||||
(SPLIT-SEQUENCE 0 (COERCE ~S 'LIST)
|
||||
:START ~S :END ~S :FROM-END ~S :COUNT ~S :REMOVE-EMPTY-SUBSEQS ~S))
|
||||
~S~%~S~%~S~%~S"
|
||||
vector start end from-end count remove-empty-subseqs
|
||||
vector start end from-end count remove-empty-subseqs
|
||||
expected-splits expected-index actual-splits actual-index)))
|
||||
(let ((failure-string nil)
|
||||
(predicate (lambda (x) (= x 0)))
|
||||
(predicate-not (lambda (x) (/= x 0))))
|
||||
(dotimes (i repetitions)
|
||||
(when (and verbose (= 0 (mod (1+ i) print-every)))
|
||||
(format t "Fuzz: Pass ~D passed.~%" (1+ i)))
|
||||
(let* ((length (1+ (random max-length)))
|
||||
(vector (random-vector length))
|
||||
(list (coerce vector 'list))
|
||||
(remove-empty-subseqs (random-boolean))
|
||||
(start 0) end from-end count)
|
||||
(case (random 5)
|
||||
(0)
|
||||
(1 (setf start (random length)))
|
||||
(2 (setf start (random length)
|
||||
end (+ start (random (1+ (- length start))))))
|
||||
(3 (setf start (random length)
|
||||
end (+ start (random (1+ (- length start))))
|
||||
from-end t))
|
||||
(4 (setf start (random length)
|
||||
end (+ start (random (1+ (- length start))))
|
||||
from-end t
|
||||
count (random (1+ (- end start))))))
|
||||
(let ((args (list :start start :end end :from-end from-end :count count
|
||||
:remove-empty-subseqs remove-empty-subseqs)))
|
||||
(multiple-value-bind (expected-splits expected-index)
|
||||
(case (random 3)
|
||||
(0 (apply #'split-sequence 0 vector args))
|
||||
(1 (apply #'split-sequence-if predicate vector args))
|
||||
(2 (apply #'split-sequence-if-not predicate-not vector args)))
|
||||
(multiple-value-bind (actual-splits actual-index)
|
||||
(case (random 3)
|
||||
(0 (apply #'split-sequence 0 list args))
|
||||
(1 (apply #'split-sequence-if predicate list args))
|
||||
(2 (apply #'split-sequence-if-not predicate-not list args)))
|
||||
(let* ((expected-splits (mapcar (lambda (x) (coerce x 'list)) expected-splits))
|
||||
(result (and (equal actual-splits expected-splits)
|
||||
(= expected-index actual-index))))
|
||||
(unless result
|
||||
(let ((string (fuzz-failure
|
||||
vector start end from-end count remove-empty-subseqs
|
||||
expected-splits expected-index actual-splits actual-index)))
|
||||
(cond (fiveamp
|
||||
(setf failure-string string)
|
||||
(return))
|
||||
(t (assert result () string)))))))))))
|
||||
(when fiveamp
|
||||
(is (not failure-string) failure-string)))))
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
|
||||
|
||||
(in-package :split-sequence)
|
||||
|
||||
(declaim (inline
|
||||
split-vector split-vector-if split-vector-if-not
|
||||
split-vector-from-end split-vector-from-start))
|
||||
|
||||
(deftype array-index (&optional (length array-dimension-limit))
|
||||
`(integer 0 (,length)))
|
||||
|
||||
(declaim (ftype (function (&rest t) (values list unsigned-byte))
|
||||
split-vector split-vector-if split-vector-if-not))
|
||||
|
||||
(declaim (ftype (function (function vector array-index
|
||||
(or null array-index) (or null array-index) boolean)
|
||||
(values list unsigned-byte))
|
||||
split-vector-from-start split-vector-from-end))
|
||||
|
||||
(defun split-vector
|
||||
(delimiter vector start end from-end count remove-empty-subseqs test test-not key)
|
||||
(cond
|
||||
((and (not from-end) (null test-not))
|
||||
(split-vector-from-start (lambda (vector start)
|
||||
(position delimiter vector :start start :key key :test test))
|
||||
vector start end count remove-empty-subseqs))
|
||||
((and (not from-end) test-not)
|
||||
(split-vector-from-start (lambda (vector start)
|
||||
(position delimiter vector :start start :key key :test-not test-not))
|
||||
vector start end count remove-empty-subseqs))
|
||||
((and from-end (null test-not))
|
||||
(split-vector-from-end (lambda (vector end)
|
||||
(position delimiter vector :end end :from-end t :key key :test test))
|
||||
vector start end count remove-empty-subseqs))
|
||||
(t
|
||||
(split-vector-from-end (lambda (vector end)
|
||||
(position delimiter vector :end end :from-end t :key key :test-not test-not))
|
||||
vector start end count remove-empty-subseqs))))
|
||||
|
||||
(defun split-vector-if
|
||||
(predicate vector start end from-end count remove-empty-subseqs key)
|
||||
(if from-end
|
||||
(split-vector-from-end (lambda (vector end)
|
||||
(position-if predicate vector :end end :from-end t :key key))
|
||||
vector start end count remove-empty-subseqs)
|
||||
(split-vector-from-start (lambda (vector start)
|
||||
(position-if predicate vector :start start :key key))
|
||||
vector start end count remove-empty-subseqs)))
|
||||
|
||||
(defun split-vector-if-not
|
||||
(predicate vector start end from-end count remove-empty-subseqs key)
|
||||
(if from-end
|
||||
(split-vector-from-end (lambda (vector end)
|
||||
(position-if-not predicate vector :end end :from-end t :key key))
|
||||
vector start end count remove-empty-subseqs)
|
||||
(split-vector-from-start (lambda (vector start)
|
||||
(position-if-not predicate vector :start start :key key))
|
||||
vector start end count remove-empty-subseqs)))
|
||||
|
||||
(defun split-vector-from-end (position-fn vector start end count remove-empty-subseqs)
|
||||
(declare (optimize (speed 3) (debug 0))
|
||||
(type (function (vector fixnum) (or null fixnum)) position-fn))
|
||||
(loop
|
||||
:with end = (or end (length vector))
|
||||
:for right := end :then left
|
||||
:for left := (max (or (funcall position-fn vector right) -1)
|
||||
(1- start))
|
||||
:unless (and (= right (1+ left)) remove-empty-subseqs)
|
||||
:if (and count (>= nr-elts count))
|
||||
:return (values (nreverse subseqs) right)
|
||||
:else
|
||||
:collect (subseq vector (1+ left) right) into subseqs
|
||||
:and :sum 1 :into nr-elts :of-type fixnum
|
||||
:until (< left start)
|
||||
:finally (return (values (nreverse subseqs) (1+ left)))))
|
||||
|
||||
(defun split-vector-from-start (position-fn vector start end count remove-empty-subseqs)
|
||||
(declare (optimize (speed 3) (debug 0))
|
||||
(type vector vector)
|
||||
(type (function (vector fixnum) (or null fixnum)) position-fn))
|
||||
(let ((length (length vector)))
|
||||
(loop
|
||||
:with end = (or end (length vector))
|
||||
:for left := start :then (1+ right)
|
||||
:for right := (min (or (funcall position-fn vector left) length)
|
||||
end)
|
||||
:unless (and (= right left) remove-empty-subseqs)
|
||||
:if (and count (>= nr-elts count))
|
||||
:return (values subseqs left)
|
||||
:else
|
||||
:collect (subseq vector left right) :into subseqs
|
||||
:and :sum 1 :into nr-elts :of-type fixnum
|
||||
:until (>= right end)
|
||||
:finally (return (values subseqs right)))))
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
;; -*- lisp -*-
|
||||
"2.0.0"
|
||||
Loading…
Add table
Add a link
Reference in a new issue