From c3aa400e66b9064a83aede0028a0f86c9656e74f Mon Sep 17 00:00:00 2001
From: "Pierre R. Mai" <pmai@pmsf.de>
Date: Sat, 22 Jul 2000 01:15:06 +0000
Subject: [PATCH] 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...
---
 src/utility.cl | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)

diff --git a/src/utility.cl b/src/utility.cl
index 71560fd..81a62fe 100644
--- a/src/utility.cl
+++ b/src/utility.cl
@@ -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))
+