read-while.lisp

(defun rw1 (in pred)
	  "Returns a string of consecutive chars for which pred returns true from the in stream."
	  (declare (optimize (safety 0) (speed 3)))
	  (let (buf)
	    (do ((c #1=(peek-char nil in nil #\Nul) #1#))
		((or (char= c #\Nul)
		     (not (funcall pred c))) (coerce (nreverse buf) 'string))
	      (push (read-char in) buf))))

(defun rw2 (in pred)
	  "Returns a string of consecutive chars for which pred returns true from the in stream."
	  (declare (optimize (safety 0) (speed 3)))
	  (with-output-to-string (buf)
	    (do ((c #1=(peek-char nil in nil #\Nul) #1#))
		((or (char= c #\Nul)
		     (not (funcall pred c))) (get-output-stream-string buf))
	      (write-char (read-char in) buf))))

(defun rw3 (in pred)
	  "Returns a string of consecutive chars for which pred returns true from the in stream."
	  (declare (optimize (safety 0) (speed 3)))
	  (let ((buf (make-array 8 :element-type 'character :adjustable t :fill-pointer 0)))
	    (do ((c #1=(peek-char nil in nil #\Nul) #1#))
		((or (char= c #\Nul)
		     (not (funcall pred c))) (coerce buf 'string))
	      (vector-push-extend (read-char in) buf))))

(declaim (ftype (function (stream (function (character) boolean))) rw4))

(defun rw4 (in pred)
	  "Returns a string of consecutive chars for which pred returns true from the in stream."
	  (declare (type stream in))
	  (declare (type (function (character) boolean) pred))
	  (declare (optimize (safety 0) (speed 3) (debug 3)))
	  (let ((buf (make-array 5 :element-type 'character :adjustable t :fill-pointer 0)))
		(declare (type (vector character *) buf))
	    (do ((c #1=(peek-char nil in nil #\Nul) #1#))
			((or (char= (the character c) #\Nul)
		     (not (the boolean (funcall pred (the character c))))) buf)
			 (vector-push-extend (the character (read-char (the stream in))) (the (vector character *) buf)))))
;	      ((the (ftype (function ((vector character *) character) integer) vector-push-extend)) (read-char (the stream in)) (the (vector character *) buf)))))

(disassemble #'rw4)

(time (dotimes (i 5000000)
		(with-input-from-string (s "hello world!")	
			  (rw1 s #'alphanumericp))))
;(time (dotimes (i 5000000)
;		(with-input-from-string (s "hello world!")
;		  (rw2 s #'alphanumericp))))
(time (dotimes (i 5000000)
		(with-input-from-string (s "hello world!")
		  (rw3 s #'alphanumericp))))
(time (dotimes (i 5000000)
		(with-input-from-string (s "hello world!")
		  (rw4 s #'alphanumericp))))