Plaster
New
List
Login
text
apl
aspx
asterisk
brainfuck
c
c++hdr
c++src
cassandra
ceylon
clojure
clojurescript
cmake
cobol
coffeescript
common-lisp
crystal
csharp
css
cypher-query
cython
d
dart
diff
django
dockerfile
dylan
ebnf
ecl
ecmascript
edn
eiffel
ejs
elm
erb
erlang
ez80
factor
fcl
feature
forth
fortran
fragment
gfm
go
gql
groovy
gss
haml
handlebars-template
haskell
haxe
hive
html
http
httpd-php
httpd-php-open
hxml
ini
java
javascript
json
jsp
jsx
julia
kotlin
latex
less
literate-haskell
lua
mariadb
markdown
mbox
mirc
mscgen
msgenny
mssql
mumps
mysql
n-triples
nesc
nginx-conf
nsis
objectivec
octave
oz
pascal
perl
pgp
pgp-keys
pgp-signature
pgsql
php
pig
plsql
properties
protobuf
puppet
python
q
rpm-changes
rpm-spec
rsrc
ruby
rustsrc
sas
sass
scala
scheme
scss
sieve
slim
smarty
solr
soy
sparql-query
spreadsheet
sql
squirrel
stex
styl
swift
systemverilog
tcl
textile
tiddlywiki
tiki
tlv
tornado
ttcn-asn
ttcn-cfg
turtle
twig
typescript
typescript-jsx
vb
vbscript
velocity
verilog
vertex
vhdl
vue
webidl
xml
xml-dtd
xquery
xu
yaml
z80
default
Visibility:
public
unlisted
private
(defun split-list-internal (predicate list start end count remove-empty-subseqs key) (declare (optimize (speed 3) (debug 0))) (let ((current-first nil) (current-last nil) (next-cons (nthcdr start list)) (result '()) (nr-elts 0)) (declare (unsigned-byte nr-elts)) (do ((n start (1+ n))) (nil) (declare (unsigned-byte n)) (cond ((or (endp next-cons) (and count (>= nr-elts count)) (<= end n)) (unless (or (and count (>= nr-elts count)) (and remove-empty-subseqs (null current-first))) (push current-first result)) (when (and (= end n) current-first) (setf (cdr current-last) nil)) (when (and remove-empty-subseqs (< n end)) (loop :while next-cons :while (< n end) :while (funcall predicate (funcall key (car next-cons))) :do (setf next-cons (cdr next-cons)) (incf n))) (return (values (nreverse result) n))) ((funcall predicate (funcall key (car next-cons))) (unless (and remove-empty-subseqs (null current-first)) (push current-first result) (incf nr-elts)) (when current-last (setf (cdr current-last) nil)) (setf next-cons (cdr next-cons) current-first nil current-last nil)) (t (setf current-last next-cons) (unless current-first (setf current-first next-cons)) (setf next-cons (cdr next-cons)))))))