Work in progress, recovered from old crybaby.

[sod] / src / parser / impl-scanner-token.lisp

diff --git a/src/parser/impl-scanner-token.lisp b/src/parser/impl-scanner-token.lisp
index e058b2738e758373cf206387b39b9806cdde0245..bf5e39400628d47a16eaf3c9a094c84b1411172a 100644 (file)
--- a/src/parser/impl-scanner-token.lisp
+++ b/src/parser/impl-scanner-token.lisp
@@ -39,22 +39,23 @@ (defmethod scanner-at-eof-p ((scanner token-scanner))
 
 (defmethod scanner-step ((scanner token-scanner))
   (with-slots (type value tail captures line column) scanner
 
 (defmethod scanner-step ((scanner token-scanner))
   (with-slots (type value tail captures line column) scanner

-    (cond (tail
-          (let ((next (token-scanner-place-next tail)))
-            (setf type (token-scanner-place-type next)
-                  value (token-scanner-place-value next)
-                  line (token-scanner-place-line next)
-                  column (token-scanner-place-column next)
-                  tail next)))
-         (t
-          (multiple-value-bind (ty val) (scanner-token scanner)
-            (setf type ty
-                  value val)
-            (when (plusp captures)
-              (let ((next (make-token-scanner-place
-                           :type ty :value val :line line :column column)))
-                (setf (token-scanner-place-next tail) next
-                      tail next))))))))
+    (acond ((and tail (token-scanner-place-next tail))
+           (setf type (token-scanner-place-type it)
+                 value (token-scanner-place-value it)
+                 line (token-scanner-place-line it)
+                 column (token-scanner-place-column it)
+                 tail it))
+          (t
+           (multiple-value-bind (ty val) (scanner-token scanner)
+             (setf type ty
+                   value val)
+             (if (plusp captures)
+                 (let ((next (make-token-scanner-place
+                              :type ty :value val
+                              :line line :column column)))
+                   (setf (token-scanner-place-next tail) next
+                         tail next))
+                 (setf tail nil)))))))

 
 (defmethod scanner-capture-place ((scanner token-scanner))
   (with-slots (type value captures tail line column) scanner
 
 (defmethod scanner-capture-place ((scanner token-scanner))
   (with-slots (type value captures tail line column) scanner