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 filename
67 (limit (or end (length string))))))
68 "Scanner structure for a simple string scanner."
69 (%string "" :type string :read-only t)
70 (filename "<string>" :type string :read-only t)
71 (index 0 :type (and fixnum unsigned-byte))
72 (limit nil :type (and fixnum unsigned-byte) :read-only t)
74 (column 0 :type fixnum))
75 (define-access-wrapper string-scanner-string string-scanner-%string
78 (defmethod scanner-at-eof-p ((scanner string-scanner))
79 (>= (string-scanner-index scanner) (string-scanner-limit scanner)))
81 (defmethod scanner-current-char ((scanner string-scanner))
82 (char (string-scanner-string scanner) (string-scanner-index scanner)))
84 (defmethod scanner-step ((scanner string-scanner))
85 (let ((index (string-scanner-index scanner)))
86 (setf (values (string-scanner-line scanner)
87 (string-scanner-column scanner))
88 (update-position (char (string-scanner-string scanner) index)
89 (string-scanner-line scanner)
90 (string-scanner-column scanner))
91 (string-scanner-index scanner) (1+ index))))
93 (defmethod scanner-unread ((scanner string-scanner) char)
94 (let ((index (1- (string-scanner-index scanner))))
95 (setf (values (string-scanner-line scanner)
96 (string-scanner-column scanner))
97 (backtrack-position (char (string-scanner-string scanner) index)
98 (string-scanner-line scanner)
99 (string-scanner-column scanner))
100 (string-scanner-index scanner) index)))
102 (defmethod scanner-filename ((scanner string-scanner))
103 (string-scanner-filename scanner))
104 (defmethod scanner-line ((scanner string-scanner))
105 (string-scanner-line scanner))
106 (defmethod scanner-column ((scanner string-scanner))
107 (string-scanner-column scanner))
108 (defmethod file-location ((scanner string-scanner))
109 (make-file-location (string-scanner-filename scanner)
110 (string-scanner-line scanner)
111 (string-scanner-column scanner)))
113 (defmethod scanner-capture-place ((scanner string-scanner))
114 (string-scanner-index scanner))
116 (defmethod scanner-restore-place ((scanner string-scanner) place)
117 (setf (string-scanner-index scanner) place))
119 (defmethod scanner-interval
120 ((scanner string-scanner) place-a &optional place-b)
121 (with-slots ((string %string) index) scanner
122 (subseq string place-a (or place-b index))))
124 (defmethod make-scanner-stream ((scanner string-scanner))
125 (make-instance 'character-scanner-stream :scanner scanner))
127 ;;;--------------------------------------------------------------------------
130 (export '(list-scanner list-scanner-p make-list-scanner))
131 (defstruct (list-scanner
132 (:constructor make-list-scanner (list &aux (%list list))))
133 "Simple token scanner for lists.
135 The list elements are the token semantic values; the token types are the
136 names of the elements' classes. This is just about adequate for testing
137 purposes, but is far from ideal for real use."
138 (%list nil :type list))
139 (define-access-wrapper list-scanner-list list-scanner-%list)
141 (defmethod scanner-step ((scanner list-scanner))
142 (pop (list-scanner-list scanner)))
144 (defmethod scanner-at-eof-p ((scanner list-scanner))
145 (null (list-scanner-list scanner)))
147 (defmethod token-type ((scanner list-scanner))
148 (class-name (class-of (car (list-scanner-list scanner)))))
150 (defmethod token-value ((scanner list-scanner))
151 (car (list-scanner-list scanner)))
153 (defmethod scanner-capture-place ((scanner list-scanner))
154 (list-scanner-list scanner))
156 (defmethod scanner-restore-place ((scanner list-scanner) place)
157 (setf (list-scanner-list scanner) place))
159 ;;;----- That's all, folks --------------------------------------------------