;;; -*-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 file-location ((place token-scanner-place))
  (make-file-location (scanner-filename (token-scanner-place-scanner place))
		      (token-scanner-place-line place)
		      (token-scanner-place-column place)))

(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 :scanner scanner
							: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 :scanner scanner
					     :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)
  (declare (ignore place))
  (with-slots (captures) scanner
    (decf captures)))

;;;----- That's all, folks --------------------------------------------------