Speed up PEEK-CHAR

* Use repeated READ-CHAR calls followed by a final UNREAD-CHAR call
  instead of repeating both, PEEK-CHAR and READ-CHAR calls.

* When PEEK-TYPE is T, for runs of identical characters, look up the
  syntax type only once, for the first character of the run.

code/reader/read-common.lisp

@@ -2,7 +2,6 @@
 
 ;;; We have to provide our own PEEK-CHAR function because CL:PEEK-CHAR
 ;;; obviously does not use Eclector's readtable.
-
 (defun peek-char (&optional peek-type
                             (input-stream *standard-input*)
                             (eof-error-p t)
@@ -15,15 +14,28 @@
                   (%reader-error input-stream 'end-of-file))
                  (t
                   eof-value))))
-    (if (not (eq peek-type t))
-        (done (cl:peek-char peek-type input-stream nil input-stream recursive-p))
+    ;; There are three peek types:
+    ;; NIL          Fetch the next character. We delegate to `cl:read'.
+    ;; T            Skip over whitespace, then peek. We do this
+    ;;              ourselves since we must use our readtable.
+    ;; a character  Skip until the supplied character is the next
+    ;;              character. We delegate to `cl:read'.
+    (if (eq peek-type t)
+        ;; Repeated `cl:read-char' and a final `unread-char' tends to
+        ;; be faster than repeating `cl:peek-char' and `cl:read-char'.
+        ;; Looking up the syntax type is relatively slow so we do it
+        ;; only once for runs of identical characters.
         (loop with readtable = (state-value *client* 'cl:*readtable*)
-              for char = (cl:peek-char nil input-stream nil input-stream recursive-p)
+              for previous of-type (or null character) = nil then char
+              for char = (cl:read-char input-stream nil input-stream recursive-p)
               while (and (not (eq char input-stream))
-                         (eq (eclector.readtable:syntax-type readtable char)
-                             :whitespace))
-              do (read-char input-stream) ; consume whitespace char
-              finally (return (done char))))))
+                         (or (eql previous char)
+                             (eq (eclector.readtable:syntax-type readtable char)
+                                 :whitespace)))
+              finally (unless (eq char input-stream)
+                        (unread-char char input-stream))
+                      (return (done char)))
+        (done (cl:peek-char peek-type input-stream nil input-stream recursive-p)))))
 
 ;;; Establishing context
 

test/reader/read.lisp

@@ -22,6 +22,10 @@
 
       ("a" (:stream)          #\a))))
 
+;;; Avoid literal tab characters in the source code since editors may
+;;; display them inconsistently or even remove them.
+(defvar *ws* (format nil "  ~C  a" #\Tab))
+
 (test peek-char/smoke
   "Smoke test for the PEEK-CHAR function."
   (do-stream-input-cases ((input length) args
@@ -44,43 +48,55 @@
         (t
          (expect "value"      (equal expected (do-it)))
          (expect "host value" (equal expected (do-it/host))))))
-    '(;; Peek type T
-      (""   (t :stream)            eclector.reader:end-of-file)
-      (""   (t :stream nil)        nil)
-      (""   (t :stream nil :eof)   :eof)
+    `(;; Peek type T
+      (""    (t :stream)            eclector.reader:end-of-file)
+      (""    (t :stream nil)        nil)
+      (""    (t :stream nil :eof)   :eof)
+
+      (" "   (t :stream)            eclector.reader:end-of-file)
+      (" "   (t :stream nil)        nil)
+      (" "   (t :stream nil :eof)   :eof)
 
-      (" "  (t :stream)            eclector.reader:end-of-file)
-      (" "  (t :stream nil)        nil)
-      (" "  (t :stream nil :eof)   :eof)
+      (" a"  (t :stream)            #\a)
+      (" a"  (t :stream nil)        #\a)
+      (" a"  (t :stream nil :eof)   #\a)
 
-      (" a" (t :stream)            #\a)
-      (" a" (t :stream nil)        #\a)
-      (" a" (t :stream nil :eof)   #\a)
+      (,*ws* (t :stream)            #\a)
+      (,*ws* (t :stream nil)        #\a)
+      (,*ws* (t :stream nil :eof)   #\a)
       ;; Peek type NIL
-      (""   ()                     eclector.reader:end-of-file)
-      (""   (nil :stream)          eclector.reader:end-of-file)
-      (""   (nil :stream nil)      nil)
-      (""   (nil :stream nil :eof) :eof)
+      (""    ()                     eclector.reader:end-of-file)
+      (""    (nil :stream)          eclector.reader:end-of-file)
+      (""    (nil :stream nil)      nil)
+      (""    (nil :stream nil :eof) :eof)
 
-      (" "  (nil :stream)          #\Space)
-      (" "  (nil :stream nil)      #\Space)
-      (" "  (nil :stream nil :eof) #\Space)
+      (" "   (nil :stream)          #\Space)
+      (" "   (nil :stream nil)      #\Space)
+      (" "   (nil :stream nil :eof) #\Space)
 
-      (" a" (nil :stream)          #\Space)
-      (" a" (nil :stream nil)      #\Space)
-      (" a" (nil :stream nil :eof) #\Space)
+      (" a"  (nil :stream)          #\Space)
+      (" a"  (nil :stream nil)      #\Space)
+      (" a"  (nil :stream nil :eof) #\Space)
+
+      (,*ws* (nil :stream)            #\Space)
+      (,*ws* (nil :stream nil)        #\Space)
+      (,*ws* (nil :stream nil :eof)   #\Space)
       ;; Peek type CHAR
-      (""   (#\a :stream)          eclector.reader:end-of-file)
-      (""   (#\a :stream nil)      nil)
-      (""   (#\a :stream nil :eof) :eof)
+      (""    (#\a :stream)          eclector.reader:end-of-file)
+      (""    (#\a :stream nil)      nil)
+      (""    (#\a :stream nil :eof) :eof)
+
+      (" "   (#\a :stream)          eclector.reader:end-of-file)
+      (" "   (#\a :stream nil)      nil)
+      (" "   (#\a :stream nil :eof) :eof)
 
-      (" "  (#\a :stream)          eclector.reader:end-of-file)
-      (" "  (#\a :stream nil)      nil)
-      (" "  (#\a :stream nil :eof) :eof)
+      (" a"  (#\a :stream)          #\a)
+      (" a"  (#\a :stream nil)      #\a)
+      (" a"  (#\a :stream nil :eof) #\a)
 
-      (" a" (#\a :stream)          #\a)
-      (" a" (#\a :stream nil)      #\a)
-      (" a" (#\a :stream nil :eof) #\a))))
+      (,*ws* (#\a :stream)            #\a)
+      (,*ws* (#\a :stream nil)        #\a)
+      (,*ws* (#\a :stream nil :eof)   #\a))))
 
 (test read/smoke
   "Smoke test for the READ function."