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
|
"Type of inner string indices, i.e. those that occur at least length
|
||||||
characters inside the string."
|
characters inside the string."
|
||||||
`(integer 0 (,(- array-dimension-limit (- length 1)))))
|
`(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