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:
2000-07-22 01:15:06 +00:00
parent d09b872f61
commit c3aa400e66

View File

@ -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))