X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/bf090e021a5c20da452a4841cdfb8eb78e29544e..aa14a4cddcb96b681d5c19a2ec8bad382f43b264:/src/parser/scanner-token-impl.lisp

diff --git a/src/parser/scanner-token-impl.lisp b/src/parser/scanner-token-impl.lisp
new file mode 100644
index 0000000..bf5e394
--- /dev/null
+++ b/src/parser/scanner-token-impl.lisp
@@ -0,0 +1,79 @@
+;;; -*-lisp-*-
+;;;
+;;; Tokenizing scanner
+;;;
+;;; (c) 2009 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This file is part of the Sensble Object Design, an object system for C.
+;;;
+;;; SOD is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; SOD is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with SOD; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(cl:in-package #:sod-parser)
+
+;;;--------------------------------------------------------------------------
+;;; Token scanner implementation.
+
+(defmethod shared-initialize :after
+    ((scanner token-scanner) slot-names &key)
+  (declare (ignore slot-names))
+  (scanner-step scanner))
+
+(defmethod scanner-at-eof-p ((scanner token-scanner))
+  (with-slots (type) scanner
+    (eq type :eof)))
+
+(defmethod scanner-step ((scanner token-scanner))
+  (with-slots (type value tail captures line column) scanner
+    (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
+    (incf captures)
+    (or tail
+	(setf tail (make-token-scanner-place
+		    :type type :value value :line line :column column)))))
+
+(defmethod scanner-restore-place ((scanner token-scanner) place)
+  (with-slots (type value tail line column) scanner
+    (setf type (token-scanner-place-type place)
+	  value (token-scanner-place-value place)
+	  line (token-scanner-place-line place)
+	  column (token-scanner-place-column place)
+	  tail place)))
+
+(defmethod scanner-release-place ((scanner token-scanner) place)
+  (with-slots (captures) scanner
+    (decf captures)))
+
+;;;----- That's all, folks --------------------------------------------------