From f5992dc3304d7d0b79eee741524980739e35aa2f Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Thu, 26 May 2016 09:26:09 +0100
Subject: [PATCH] src/parser/scanner-impl.lisp: Location protocol for
 `string-scanner'.

Implement the protocol using the utilities carefully provided years ago
for the purpose.
---
 doc/SYMBOLS                  |  4 ++++
 src/parser/scanner-impl.lisp | 34 ++++++++++++++++++++++++++++++----
 2 files changed, 34 insertions(+), 4 deletions(-)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index ddf63e5..0d8549f 100644
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -1913,6 +1913,7 @@ file-location
   condition-with-location
   file-location
   position-aware-stream
+  string-scanner
   token-scanner
   token-scanner-place
 cl:make-load-form
@@ -2000,6 +2001,7 @@ scanner-capture-place
 scanner-column
   t
   charbuf-scanner
+  string-scanner
   token-scanner
 (setf scanner-column)
   t token-scanner
@@ -2009,6 +2011,7 @@ scanner-current-char
 scanner-filename
   t
   charbuf-scanner
+  string-scanner
   token-scanner
 scanner-interval
   charbuf-scanner t
@@ -2016,6 +2019,7 @@ scanner-interval
 scanner-line
   t
   charbuf-scanner
+  string-scanner
   token-scanner
 (setf scanner-line)
   t token-scanner
diff --git a/src/parser/scanner-impl.lisp b/src/parser/scanner-impl.lisp
index 8bca29f..d856ba9 100644
--- a/src/parser/scanner-impl.lisp
+++ b/src/parser/scanner-impl.lisp
@@ -61,14 +61,17 @@
 (export '(string-scanner make-string-scanner string-scanner-p))
 (defstruct (string-scanner
 	     (:constructor make-string-scanner
-		 (string &key (start 0) end
+		 (string &key (start 0) end filename
 		  &aux (%string string)
 		       (index start)
 		       (limit (or end (length string))))))
   "Scanner structure for a simple string scanner."
   (%string "" :type string :read-only t)
+  (filename "<string>" :type string :read-only t)
   (index 0 :type (and fixnum unsigned-byte))
-  (limit nil :type (and fixnum unsigned-byte) :read-only t))
+  (limit nil :type (and fixnum unsigned-byte) :read-only t)
+  (line 1 :type fixnum)
+  (column 0 :type fixnum))
 (define-access-wrapper string-scanner-string string-scanner-%string
 		       :read-only t)
 
@@ -79,10 +82,33 @@
   (char (string-scanner-string scanner) (string-scanner-index scanner)))
 
 (defmethod scanner-step ((scanner string-scanner))
-  (incf (string-scanner-index scanner)))
+  (let ((index (string-scanner-index scanner)))
+    (setf (values (string-scanner-line scanner)
+		  (string-scanner-column scanner))
+	  (update-position (char (string-scanner-string scanner) index)
+			   (string-scanner-line scanner)
+			   (string-scanner-column scanner))
+	  (string-scanner-index scanner) (1+ index))))
 
 (defmethod scanner-unread ((scanner string-scanner) char)
-  (decf (string-scanner-index scanner)))
+  (let ((index (1- (string-scanner-index scanner))))
+    (setf (values (string-scanner-line scanner)
+		  (string-scanner-column scanner))
+	  (backtrack-position (char (string-scanner-string scanner) index)
+			      (string-scanner-line scanner)
+			      (string-scanner-column scanner))
+	  (string-scanner-index scanner) index)))
+
+(defmethod scanner-filename ((scanner string-scanner))
+  (string-scanner-filename scanner))
+(defmethod scanner-line ((scanner string-scanner))
+  (string-scanner-line scanner))
+(defmethod scanner-column ((scanner string-scanner))
+  (string-scanner-column scanner))
+(defmethod file-location ((scanner string-scanner))
+  (make-file-location (string-scanner-filename scanner)
+		      (string-scanner-line scanner)
+		      (string-scanner-column scanner)))
 
 (defmethod scanner-capture-place ((scanner string-scanner))
   (string-scanner-index scanner))
-- 
2.11.0