chiark - git - mdw - sod/blob - src/parser/scanner-token-impl.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Tokenizing scanner
   4 ;;;
   5 ;;; (c) 2009 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This file is part of the Sensble Object Design, an object system for C.
  11 ;;;
  12 ;;; SOD is free software; you can redistribute it and/or modify
  13 ;;; it under the terms of the GNU General Public License as published by
  14 ;;; the Free Software Foundation; either version 2 of the License, or
  15 ;;; (at your option) any later version.
  16 ;;;
  17 ;;; SOD is distributed in the hope that it will be useful,
  18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;;; GNU General Public License for more details.
  21 ;;;
  22 ;;; You should have received a copy of the GNU General Public License
  23 ;;; along with SOD; if not, write to the Free Software Foundation,
  24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 (cl:in-package #:sod-parser)
  27
  28 ;;;--------------------------------------------------------------------------
  29 ;;; Token scanner implementation.
  30
  31 (defmethod shared-initialize :after
  32     ((scanner token-scanner) slot-names &key)
  33   (declare (ignore slot-names))
  34   (scanner-step scanner))
  35
  36 (defmethod scanner-at-eof-p ((scanner token-scanner))
  37   (with-slots (type) scanner
  38     (eq type :eof)))
  39
  40 (defmethod scanner-step ((scanner token-scanner))
  41   (with-slots (type value tail captures line column) scanner
  42     (acond ((and tail (token-scanner-place-next tail))
  43             (setf type (token-scanner-place-type it)
  44                   value (token-scanner-place-value it)
  45                   line (token-scanner-place-line it)
  46                   column (token-scanner-place-column it)
  47                   tail it))
  48            (t
  49             (multiple-value-bind (ty val) (scanner-token scanner)
  50               (setf type ty
  51                     value val)
  52               (if (plusp captures)
  53                   (let ((next (make-token-scanner-place
  54                                :type ty :value val
  55                                :line line :column column)))
  56                     (setf (token-scanner-place-next tail) next
  57                           tail next))
  58                   (setf tail nil)))))))
  59
  60 (defmethod scanner-capture-place ((scanner token-scanner))
  61   (with-slots (type value captures tail line column) scanner
  62     (incf captures)
  63     (or tail
  64         (setf tail (make-token-scanner-place
  65                     :type type :value value :line line :column column)))))
  66
  67 (defmethod scanner-restore-place ((scanner token-scanner) place)
  68   (with-slots (type value tail line column) scanner
  69     (setf type (token-scanner-place-type place)
  70           value (token-scanner-place-value place)
  71           line (token-scanner-place-line place)
  72           column (token-scanner-place-column place)
  73           tail place)))
  74
  75 (defmethod scanner-release-place ((scanner token-scanner) place)
  76   (declare (ignore place))
  77   (with-slots (captures) scanner
  78     (decf captures)))
  79
  80 ;;;----- That's all, folks --------------------------------------------------