An actual running implementation, which makes code that compiles.

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

;;; -*-lisp-*-
;;;
;;; Scanner protocol definitions.
;;;
;;; (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)

;;;--------------------------------------------------------------------------
;;; Scanner context protocol.

(export 'parser-scanner)
(defgeneric parser-scanner (context)
  (:documentation
   "Return the symbol naming the CONTEXT's run-time scanner."))

(export 'scanner-context)
(defclass scanner-context ()
  ((scanner :initarg :scanner :type symbol :reader parser-scanner))
  (:documentation
   "Base class for scanner contexts.

   A scanner is simply an object maintaining the run-time state of a parsing
   operation, in the same way as a parser context maintains the compile-time
   state.  So the scanner context is a compile-time context which expands to
   calls to use the run-time scanner.  See?

   This class provides common compile-time behaviour for `parser-at-eof-p'
   and friends by invoking corresponding methods on the scanner object at
   run-time."))

;;;--------------------------------------------------------------------------
;;; Basic scanner protocol.

(export 'scanner-at-eof-p)
(defgeneric scanner-at-eof-p (scanner)
  (:documentation
   "Answer whether the SCANNER is at end-of-file.

   It is an error to query the current item when at end-of-file."))

(export 'scanner-step)
(defgeneric scanner-step (scanner)
  (:documentation
   "Advance the SCANNER to the next item.

   The precise nature of the items isn't known at this level, so a protocol
   for accessing them is left for later."))

;;;--------------------------------------------------------------------------
;;; Scanner place-capture protocol.

(export 'scanner-capture-place)
(defgeneric scanner-capture-place (scanner)
  (:documentation
   "Capture the SCANNER's current place and return it.")
  (:method (scanner)
    (error "Scanner ~S doesn't support rewinding." scanner)))

(export 'scanner-restore-place)
(defgeneric scanner-restore-place (scanner place)
  (:documentation
   "`Rewind' the SCANNER to the captured PLACE.

   The place was previously captured by `scanner-capture-place'."))

(export 'scanner-release-place)
(defgeneric scanner-release-place (scanner place)
  (:documentation
   "Release a PLACE captured from the SCANNER.

   The place was previously captured by `scanner-capture-place'.")
  (:method (scanner place) nil))

(export 'with-scanner-place)
(defmacro with-scanner-place ((place scanner) &body body)
  "Evaluate BODY with PLACE bound to the captured current place.

   Automatically releases the place when the BODY finishes.  Note that
   if you wanted to circumvent the cleanup then you should have used
   `with-parser-place', which does all of this in the meta-level."
  (once-only (scanner)
    `(let ((,place (scanner-capture-place ,scanner)))
       (unwind-protect (progn ,@body)
	 (scanner-release-place ,scanner ,place)))))

;;;--------------------------------------------------------------------------
;;; Character scanner protocol.

(export 'character-scanner)
(defclass character-scanner ()
  ()
  (:documentation "Base class for character scanners."))

(export 'character-scanner-context)
(defclass character-scanner-context
    (scanner-context character-parser-context)
  ()
  (:documentation
   "A context for a richer character-oriented scanner."))

(export 'scanner-current-char)
(defgeneric scanner-current-char (scanner)
  (:documentation
   "Returns the SCANNER's current character.

   You advance to the next one using `scanner-step'."))

(export 'scanner-unread)
(defgeneric scanner-unread (scanner char)
  (:documentation
   "Rewind SCANNER by one character, specifically CHAR.

   CHAR must be the character most recently stepped over by `scanner-step' --
   it is an error to unread before the first call to `scanner-step'.  It is
   also an error to unread after encountering end-of-file."))

(export 'scanner-interval)
(defgeneric scanner-interval (scanner place-a &optional place-b)
  (:documentation
   "Return the characters from PLACE-A up to (but not including) PLACE-B.

   The characters are returned as a string.  If PLACE-B is omitted, return
   the characters up to (but not including) the current position.  It is an
   error if PLACE-B precedes PLACE-A or they are from different scanners."))

(export '(scanner-filename scanner-line scanner-column))
(defgeneric scanner-filename (scanner)
  (:documentation "Return the filename backing the SCANNER.")
  (:method (scanner) nil))
(defgeneric scanner-line (scanner)
  (:documentation "Return the SCANNER's current line number.")
  (:method (scanner) nil))
(defgeneric scanner-column (scanner)
  (:documentation "Return the SCANNER's current column number.")
  (:method (scanner) nil))

(defun scanner-file-location (scanner)
  "Capture the current location of the SCANNER.

   This uses the generic functions `scanner-filename', `scanner-line' and
   `scanner-column' to compute its result.  There are default methods on
   these functions which make up dummy results.

   There is a method for `file-location' defined on `character-scanner' which
   simply calls this function; but since some scanners are structure-objects
   rather than standard-objects they can't include `character-scanner' as a
   superclass."
  (make-file-location (scanner-filename scanner)
		      (scanner-line scanner)
		      (scanner-column scanner)))

;;;--------------------------------------------------------------------------
;;; Token scanner protocol.

;; A place marker.

(export '(token-scanner-place token-scanner-place-p))
(defstruct token-scanner-place
  "A link in the chain of lookahead tokens; capturable as a place.

   If the scanner's place is captured, it starts to maintain a list of
   lookahead tokens.  The list contains internal links -- it works out
   slightly easier that way.  This is basically a simpler version of the
   charbuf scanner (q.v.); most significantly, the chain links here do double
   duty as place markers.

   The details of this structure are not a defined part of the token scanner
   protocol."

  (scanner nil :type token-scanner :read-only t)
  (next nil :type (or token-scanner-place null))
  (type nil :read-only t)
  (value nil :read-only t)
  (line 1 :type (or fixnum null) :read-only t)
  (column 0 :type (or fixnum null) :read-only t))

;; The token scanner base class and parser context.

(export '(token-scanner token-type token-value))
(defclass token-scanner ()
  ((type :reader token-type)
   (value :reader token-value)
   (captures :initform 0 :type fixnum)
   (tail :initform nil :type (or token-scanner-place null))
   (filename :initarg :filename :type string :reader scanner-filename)
   (line :initarg :line :initform 1 :type fixnum :accessor scanner-line)
   (column :initarg :column :initform 0
	   :type fixnum :accessor scanner-column))
  (:documentation
   "A rewindable scanner for tokenizing.

   The scanner should be used via the parser protocol; see also the token
   scanner protocol, which explains the model.

   Subclasses must provide the detailed scanning behaviour -- most notably
   the `scanner-token' generic function -- and also implement a method on
   `file-location' to return the location.  The `scanner-token' method should
   also update the `line' and `column' slots to track the position in the
   underlying source, if appropriate.  This class will handle the remaining
   details, such as dealing correctly with rewinding."))

(export 'token-scanner-context)
(defclass token-scanner-context (scanner-context token-parser-context)
  ()
  (:documentation
   "A parser context for a richer token-based scanners."))

;; Protocol.

(export 'scanner-token)
(defgeneric scanner-token (scanner)
  (:documentation
   "Internal protocol: read the next token from the SCANNER.

   This function is called by `scanner-step' to actually read the next token
   if necessary.  It should return two values: the token's `type' and its
   `value'."))

;;;--------------------------------------------------------------------------
;;; Character scanner streams.
;;;
;;; This seems like an abstraction inversion, but it's important if we're to
;;; `read' from a character scanner.

(export 'character-scanner-stream)
(defclass character-scanner-stream (fundamental-character-input-stream)
  ((scanner :initarg :scanner))
  (:documentation
   "A stream which reads from a character scanner.

   The SCANNER must implement the character scanner protcol, including
   `scanner-current-char', `scanner-step', and `scanner-unread'; it is not
   necessary that the scanner implement the place-capture protocol.

   The stream can be made more efficient by implementing
   `stream-read-sequence' and `stream-read-line' in a scanner-specific
   manner."))

(export 'make-scanner-stream)
(defgeneric make-scanner-stream (scanner)
  (:documentation
   "Return a stream which reads from the SCANNER.

   The default method simply constructs a `character-scanner-stream'
   instance.  Subclasses of `character-scanner' can override this method in
   order to return instances of more efficient stream subclasses.")
  (:method ((scanner character-scanner))
    (make-instance 'character-scanner-stream :scanner scanner)))

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