[cl-utilities-cvs] CVS update: cl-utilities/read-delimited.lisp

[Peter Scott]

Update of /project/cl-utilities/cvsroot/cl-utilities
In directory common-lisp.net:/tmp/cvs-serv5758

Modified Files:
	read-delimited.lisp 
Log Message:
Major refactoring. It now does exactly the same thing as it used to,
but now it does it in such a way that I'm not afraid of its source
code.

Date: Thu May 26 21:46:46 2005
Author: pscott

Index: cl-utilities/read-delimited.lisp
diff -u cl-utilities/read-delimited.lisp:1.1.1.1 cl-utilities/read-delimited.lisp:1.2
--- cl-utilities/read-delimited.lisp:1.1.1.1	Mon May  9 23:26:29 2005
+++ cl-utilities/read-delimited.lisp	Thu May 26 21:46:46 2005
@@ -1,5 +1,25 @@
 (in-package :cl-utilities)
 
+(defun read-delimited (sequence stream &key (start 0) end
+		       (delimiter #\Newline) (test #'eql) (key #'identity))
+  ;; Check bounds on SEQUENCE
+  (multiple-value-setq (start end)
+    (%read-delimited-bounds-check sequence start end))
+  ;; Loop until we run out of input characters or places to put them,
+  ;; or until we encounter the delimiter.
+  (loop for index from start
+	for char = (read-char stream nil nil)
+	for test-result = (funcall test (funcall key char) delimiter)
+	while (and char
+		   (< index end)
+		   (not test-result))
+	do (setf (elt sequence index) char)
+	finally (return-from read-delimited
+		  (values index test-result))))
+
+;; Conditions
+;;;;;;;;;;;;;
+
 (define-condition read-delimited-bounds-error (error)
   ((start :initarg :start :reader read-delimited-bounds-error-start)
    (end :initarg :end :reader read-delimited-bounds-error-end)
@@ -11,41 +31,48 @@
   (:documentation "There's a problem with the indices START and END
 for SEQUENCE. See CLHS SUBSEQ-OUT-OF-BOUNDS:IS-AN-ERROR issue."))
 
-(defun read-delimited (sequence stream &key (start 0) end
-		       (delimiter #\Newline) (test #'eql) key)
-  ;; Check to make sure END is in bounds
-  (when (and end (> end (length sequence)))
+;; Error checking for bounds
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun %read-delimited-bounds-check (sequence start end)
+  "Check to make sure START and END are in bounds when calling
+READ-DELIMITED with SEQUENCE"
+  (check-type start (or integer null))
+  (check-type end (or integer null))
+  (let ((start (%read-delimited-bounds-check-start sequence start end))
+	(end (%read-delimited-bounds-check-end sequence start end)))
+    ;; Returns (values start end)
+    (%read-delimited-bounds-check-order sequence start end)))
+
+(defun %read-delimited-bounds-check-order (sequence start end)
+  "Check the order of START and END bounds, and return them in the
+correct order."
+  (when (< end start)
     (restart-case (error 'read-delimited-bounds-error
 			 :start start :end end :sequence sequence)
       (continue ()
-	:report "Use default instead"
-	(setf end nil))))
-  ;; Check to make sure START is in bounds
+	:report "Switch start and end"
+	(rotatef start end))))
+  (values start end))
+
+(defun %read-delimited-bounds-check-start (sequence start end)
+  "Check to make sure START is in bounds when calling READ-DELIMITED
+with SEQUENCE"
   (when (and start (< start 0))
     (restart-case (error 'read-delimited-bounds-error
 			 :start start :end end :sequence sequence)
       (continue ()
-	:report "Use default instead"
+	:report "Use default for START instead"
 	(setf start 0))))
-  (let ((key (or key #'identity))
-	(end (or end (length sequence))))
-    ;; START and END should be positive integers by now
-    (check-type start unsigned-byte)
-    (check-type end unsigned-byte)
-    ;; Check to make sure that START < END
-    (when (< end start)
-      (restart-case (error 'read-delimited-bounds-error
-			   :start start :end end :sequence sequence)
-	(continue ()
-	  :report "Switch start and end"
-	  (rotatef start end))))
-    ;; Actually do the looping
-    (loop for index from start
-	  for char = (read-char stream nil nil)
-	  for test-result = (funcall test (funcall key char) delimiter)
-	  while (and char
-		     (< index end)
-		     (not test-result))
-	  do (setf (elt sequence index) char)
-	  finally (return-from read-delimited
-		    (values index test-result)))))
\ No newline at end of file
+  start)
+
+(defun %read-delimited-bounds-check-end (sequence start end)
+  "Check to make sure END is in bounds when calling READ-DELIMITED
+with SEQUENCE"
+  (when (and end (> end (length sequence)))
+    (restart-case (error 'read-delimited-bounds-error
+			 :start start :end end :sequence sequence)
+      (continue ()
+	:report "Use default for END instead"
+	(setf end nil))))
+  (or end (length sequence)))
\ No newline at end of file