Changes that bring CLASH up to extended HTTP/1.0 support:
Added partitioning functions as a stop-gap measure while PMSF-Lib is unreleased. This should probably belong into parsing.cl...
This commit is contained in:
@ -21,3 +21,73 @@
|
||||
"Type of inner string indices, i.e. those that occur at least length
|
||||
characters inside the string."
|
||||
`(integer 0 (,(- array-dimension-limit (- length 1)))))
|
||||
|
||||
;;; 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 (delimiter seq
|
||||
&key (maximum nil)
|
||||
(remove-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 :remove-empty-subseqs is true, empty subsequences will be discarded
|
||||
from the result; otherwise they will be included.
|
||||
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 include the delimiters in the result(?).
|
||||
(let ((len (length seq)))
|
||||
(unless end (setq end len))
|
||||
;; 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)))
|
||||
|
||||
(loop with other-keys = (nconc (when test-supplied
|
||||
(list :test test))
|
||||
(when test-not-supplied
|
||||
(list :test-not test-not))
|
||||
(when key-supplied
|
||||
(list :key key)))
|
||||
for left = start then (+ right 1)
|
||||
for right = (min (or (apply #'position delimiter seq
|
||||
:start left
|
||||
other-keys)
|
||||
len)
|
||||
end)
|
||||
unless (and (= right left) ; empty-subsequence
|
||||
remove-empty-subseqs)
|
||||
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))))))
|
||||
|
||||
(defun partition-if (predicate seq &rest keys)
|
||||
"PARTITION-IF is to PARTITION what POSITION-IF is to POSITION"
|
||||
(apply #'partition nil seq
|
||||
:test (lambda (ignore x)
|
||||
(declare (ignore ignore))
|
||||
(funcall predicate x))
|
||||
keys))
|
||||
|
||||
(defun partition-if-not (predicate seq &rest keys)
|
||||
"PARTITION-IF-NOT is to PARTITION what POSITION-IF-NOT is to POSITION"
|
||||
(apply #'partition nil seq
|
||||
:test-not (lambda (ignore x)
|
||||
(declare (ignore ignore))
|
||||
(funcall predicate x))
|
||||
keys))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user