Massive reorganization in progress.

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

;;; -*-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
    (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))))))))

(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 --------------------------------------------------