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