3 ;;; Basic scanner interface
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensible Object Design, an object system for C.
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.
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.
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.
26 (cl:in-package #:sod-parser)
28 ;;;--------------------------------------------------------------------------
29 ;;; Common scanner implementation..
31 (defmethod file-location ((scanner character-scanner))
32 (scanner-file-location scanner))
34 (defmethod file-location ((scanner token-scanner))
35 (scanner-file-location scanner))
37 ;;;--------------------------------------------------------------------------
38 ;;; Streams on character scanners.
40 (defmethod stream-read-char ((stream character-scanner-stream))
41 (with-slots (scanner) stream
42 (if (scanner-at-eof-p scanner)
44 (prog1 (scanner-current-char scanner)
45 (scanner-step scanner)))))
47 (defmethod stream-unread-char ((stream character-scanner-stream) char)
48 (with-slots (scanner) stream
49 (scanner-unread scanner char)))
51 (defmethod stream-peek-char ((stream character-scanner-stream))
52 (with-slots (scanner) stream
53 (scanner-current-char scanner)))
55 ;;;--------------------------------------------------------------------------
58 ;; This is much more convenient for testing lexers than the full character
61 (export '(string-scanner make-string-scanner string-scanner-p))
62 (defstruct (string-scanner
63 (:constructor make-string-scanner
64 (string &key (start 0) end
67 (limit (or end (length string))))))
68 "Scanner structure for a simple string scanner."
69 (%string "" :type string :read-only t)
70 (index 0 :type (and fixnum unsigned-byte))
71 (limit nil :type (and fixnum unsigned-byte) :read-only t))
72 (define-access-wrapper string-scanner-string string-scanner-%string
75 (defmethod scanner-at-eof-p ((scanner string-scanner))
76 (>= (string-scanner-index scanner) (string-scanner-limit scanner)))
78 (defmethod scanner-current-char ((scanner string-scanner))
79 (char (string-scanner-string scanner) (string-scanner-index scanner)))
81 (defmethod scanner-step ((scanner string-scanner))
82 (incf (string-scanner-index scanner)))
84 (defmethod scanner-capture-place ((scanner string-scanner))
85 (string-scanner-index scanner))
87 (defmethod scanner-restore-place ((scanner string-scanner) place)
88 (setf (string-scanner-index scanner) place))
90 (defmethod scanner-interval
91 ((scanner string-scanner) place-a &optional place-b)
92 (with-slots ((string %string) index) scanner
93 (subseq string place-a (or place-b index))))
95 (defmethod make-scanner-stream ((scanner string-scanner))
96 (make-instance 'character-scanner-stream :scanner scanner))
98 ;;;--------------------------------------------------------------------------
101 (export '(list-scanner list-scanner-p make-list-scanner))
102 (defstruct (list-scanner
103 (:constructor make-list-scanner (list &aux (%list list))))
104 "Simple token scanner for lists.
106 The list elements are the token semantic values; the token types are the
107 names of the elements' classes. This is just about adequate for testing
108 purposes, but is far from ideal for real use."
109 (%list nil :type list))
110 (define-access-wrapper list-scanner-list list-scanner-%list)
112 (defmethod scanner-step ((scanner list-scanner))
113 (pop (list-scanner-list scanner)))
115 (defmethod scanner-at-eof-p ((scanner list-scanner))
116 (null (list-scanner-list scanner)))
118 (defmethod token-type ((scanner list-scanner))
119 (class-name (class-of (car (list-scanner-list scanner)))))
121 (defmethod token-value ((scanner list-scanner))
122 (car (list-scanner-list scanner)))
124 (defmethod scanner-capture-place ((scanner list-scanner))
125 (list-scanner-list scanner))
127 (defmethod scanner-restore-place ((scanner list-scanner) place)
128 (setf (list-scanner-list scanner) place))
130 ;;;----- That's all, folks --------------------------------------------------