chiark - git - mdw - sod/blob - src/parser/impl-scanner-token.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     (cond (tail
  43            (let ((next (token-scanner-place-next tail)))
  44              (setf type (token-scanner-place-type next)
  45                    value (token-scanner-place-value next)
  46                    line (token-scanner-place-line next)
  47                    column (token-scanner-place-column next)
  48                    tail next)))
  49           (t
  50            (multiple-value-bind (ty val) (scanner-token scanner)
  51              (setf type ty
  52                    value val)
  53              (when (plusp captures)
  54                (let ((next (make-token-scanner-place
  55                             :type ty :value val :line line :column column)))
  56                  (setf (token-scanner-place-next tail) next
  57                        tail next))))))))
  58
  59 (defmethod scanner-capture-place ((scanner token-scanner))
  60   (with-slots (type value captures tail line column) scanner
  61     (incf captures)
  62     (or tail
  63         (setf tail (make-token-scanner-place
  64                     :type type :value value :line line :column column)))))
  65
  66 (defmethod scanner-restore-place ((scanner token-scanner) place)
  67   (with-slots (type value tail line column) scanner
  68     (setf type (token-scanner-place-type place)
  69           value (token-scanner-place-value place)
  70           line (token-scanner-place-line place)
  71           column (token-scanner-place-column place)
  72           tail place)))
  73
  74 (defmethod scanner-release-place ((scanner token-scanner) place)
  75   (with-slots (captures) scanner
  76     (decf captures)))
  77
  78 ;;;----- That's all, folks --------------------------------------------------