mdw@git.distorted.org.uk Git - 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 file-location ((place token-scanner-place))
  32   (make-file-location (scanner-filename (token-scanner-place-scanner place))
  33                       (token-scanner-place-line place)
  34                       (token-scanner-place-column place)))
  35
  36 (defmethod shared-initialize :after
  37     ((scanner token-scanner) slot-names &key)
  38   (declare (ignore slot-names))
  39   (scanner-step scanner))
  40
  41 (defmethod scanner-at-eof-p ((scanner token-scanner))
  42   (with-slots (type) scanner
  43     (eq type :eof)))
  44
  45 (defmethod scanner-step ((scanner token-scanner))
  46   (with-slots (type value tail captures line column) scanner
  47     (acond ((and tail (token-scanner-place-next tail))
  48             (setf type (token-scanner-place-type it)
  49                   value (token-scanner-place-value it)
  50                   line (token-scanner-place-line it)
  51                   column (token-scanner-place-column it)
  52                   tail it))
  53            (t
  54             (multiple-value-bind (ty val) (scanner-token scanner)
  55               (setf type ty
  56                     value val)
  57               (if (plusp captures)
  58                   (let ((next (make-token-scanner-place :scanner scanner
  59                                                         :type ty :value val
  60                                                         :line line
  61                                                         :column column)))
  62                     (setf (token-scanner-place-next tail) next
  63                           tail next))
  64                   (setf tail nil)))))))
  65
  66 (defmethod scanner-capture-place ((scanner token-scanner))
  67   (with-slots (type value captures tail line column) scanner
  68     (incf captures)
  69     (or tail
  70         (setf tail (make-token-scanner-place :scanner scanner
  71                                              :type type :value value
  72                                              :line line :column column)))))
  73
  74 (defmethod scanner-restore-place ((scanner token-scanner) place)
  75   (with-slots (type value tail line column) scanner
  76     (setf type (token-scanner-place-type place)
  77           value (token-scanner-place-value place)
  78           line (token-scanner-place-line place)
  79           column (token-scanner-place-column place)
  80           tail place)))
  81
  82 (defmethod scanner-release-place ((scanner token-scanner) place)
  83   (declare (ignore place))
  84   (with-slots (captures) scanner
  85     (decf captures)))
  86
  87 ;;;----- That's all, folks --------------------------------------------------