An actual running implementation, which makes code that compiles.

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

;;; -*-lisp-*-
;;;
;;; Basic scanner interface
;;;
;;; (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)

;;;--------------------------------------------------------------------------
;;; Common scanner implementation..

(defmethod file-location ((scanner character-scanner))
  (scanner-file-location scanner))

(defmethod file-location ((scanner token-scanner))
  (scanner-file-location scanner))

;;;--------------------------------------------------------------------------
;;; Streams on character scanners.

(defmethod stream-read-char ((stream character-scanner-stream))
  (with-slots (scanner) stream
    (if (scanner-at-eof-p scanner)
	:eof
	(prog1 (scanner-current-char scanner)
	  (scanner-step scanner)))))

(defmethod stream-unread-char ((stream character-scanner-stream) char)
  (with-slots (scanner) stream
    (scanner-unread scanner char)))

(defmethod stream-peek-char ((stream character-scanner-stream))
  (with-slots (scanner) stream
    (scanner-current-char scanner)))

;;;--------------------------------------------------------------------------
;;; String scanner.

;; This is much more convenient for testing lexers than the full character
;; buffer scanner.

(export '(string-scanner make-string-scanner string-scanner-p))
(defstruct (string-scanner
	     (:constructor make-string-scanner
		 (string &key (start 0) end
		  &aux (index start)
		       (limit (or end (length string))))))
  "Scanner structure for a simple string scanner."
  (string "" :type string :read-only t)
  (index 0 :type (and fixnum unsigned-byte))
  (limit nil :type (and fixnum unsigned-byte) :read-only t))

(defmethod scanner-at-eof-p ((scanner string-scanner))
  (>= (string-scanner-index scanner) (string-scanner-limit scanner)))

(defmethod scanner-current-char ((scanner string-scanner))
  (char (string-scanner-string scanner) (string-scanner-index scanner)))

(defmethod scanner-step ((scanner string-scanner))
  (incf (string-scanner-index scanner)))

(defmethod scanner-capture-place ((scanner string-scanner))
  (string-scanner-index scanner))

(defmethod scanner-restore-place ((scanner string-scanner) place)
  (setf (string-scanner-index scanner) place))

(defmethod scanner-interval
    ((scanner string-scanner) place-a &optional place-b)
  (with-slots (string index) scanner
    (subseq string place-a (or place-b index))))

;;;--------------------------------------------------------------------------
;;; List scanner.

(export 'list-scanner)
(defstruct (list-scanner
	     (:constructor make-list-scanner (list)))
  "Simple token scanner for lists.

   The list elements are the token semantic values; the token types are the
   names of the elements' classes.  This is just about adequate for testing
   purposes, but is far from ideal for real use."
  (list nil :type list))

(defmethod scanner-step ((scanner list-scanner))
  (pop (list-scanner-list scanner)))

(defmethod scanner-at-eof-p ((scanner list-scanner))
  (null (list-scanner-list scanner)))

(defmethod token-type ((scanner list-scanner))
  (class-name (class-of (car (list-scanner-list scanner)))))

(defmethod token-value ((scanner list-scanner))
  (car (list-scanner-list scanner)))

(defmethod scanner-capture-place ((scanner list-scanner))
  (list-scanner-list scanner))

(defmethod scanner-restore-place ((scanner list-scanner) place)
  (setf (list-scanner-list scanner) place))

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