chiark / gitweb /
16861793b9a269cb027a2b91d9ee6aae38ee9940
[sod] / src / lexer-impl.lisp
1 ;;; -*-lisp-*-
2 ;;;
3 ;;; Implementation of lexical analysis protocol.
4 ;;;
5 ;;; (c) 2009 Straylight/Edgeware
6 ;;;
7
8 ;;;----- Licensing notice ---------------------------------------------------
9 ;;;
10 ;;; This file is part of the Sensible 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)
27
28 ;;;--------------------------------------------------------------------------
29 ;;; Class implementation.
30
31 (defmethod shared-initialize :after
32     ((scanner sod-token-scanner) slot-names &key)
33   (default-slot (scanner 'sod-parser::filename slot-names)
34     (scanner-filename (token-scanner-char-scanner scanner))))
35
36 (defmethod make-scanner-stream ((scanner sod-token-scanner))
37   (make-scanner-stream (token-scanner-char-scanner scanner)))
38
39 ;;;--------------------------------------------------------------------------
40 ;;; Indicators and error messages.
41
42 (defun show-char (char)
43   "Format CHAR as a string in a readable way."
44   (cond ((null char) "<end-of-file>")
45         ((and (graphic-char-p char) (char/= char #\space))
46          (format nil "`~C'" char))
47         (t (format nil "<~(~:C~)>" char))))
48
49 (defun %skip-until (scanner token-types
50                     &key (keep-end (not (null (cdr token-types)))))
51   "This is the implementation of the `skip-until' parser."
52   (do ((consumedp nil t))
53       ((let ((type (token-type scanner))
54              (value (token-value scanner)))
55          (some (lambda (spec)
56                  (multiple-value-bind (want-type want-value)
57                      (cond ((listp spec) (values (car spec) (cadr spec)))
58                            (t (values spec t)))
59                    (and (eq want-type type)
60                         (or (eq want-value t)
61                             (equal want-value value)))))
62                token-types))
63        (unless keep-end (scanner-step scanner))
64        (values nil t (or keep-end consumedp)))
65     (when (scanner-at-eof-p scanner)
66       (return (values token-types nil consumedp)))
67     (scanner-step scanner)))
68
69 (defun parse-error-recover (scanner parser recover
70                             &key ignore-unconsumed force-progress)
71   "This is the implementation of the `error' parser."
72   (multiple-value-bind (result win consumedp) (funcall parser)
73     (cond ((or win
74                (and (not consumedp)
75                     (or ignore-unconsumed
76                         (scanner-at-eof-p scanner))))
77            ;; If we succeeded, or if we didn't consume any tokens and the
78            ;; caller's OK with that, then there's nothing for us to do here.
79            ;; On the other hand, if we failed, didn't consume any tokens, and
80            ;; we're at end-of-file, then there's not much hope of making
81            ;; onward progress, so in this case we propagate the failure
82            ;; rather than trying to recover.  And we assume that the
83            ;; continuation will somehow arrange to report the problem, and
84            ;; avoid inundating the user with error reports.
85            (values result win consumedp))
86           (t
87            ;; Now we have to do some kind of sensible error recovery.  The
88            ;; important thing to do here is to make sure that we make some
89            ;; progress.  If we consumed any tokens then we're fine, and we'll
90            ;; just try the provided recovery strategy.  Otherwise, if we're
91            ;; not at EOF, then we can ensure progress by discarding the
92            ;; current token.  Finally, if we are at EOF then our best bet is
93            ;; simply to propagate the current failure back to the caller, but
94            ;; we handled that case above.
95            (syntax-error scanner result)
96            (when (and force-progress (not consumedp)) (scanner-step scanner))
97            (funcall recover)))))
98
99 ;;;--------------------------------------------------------------------------
100 ;;; Token scanning.
101
102 (defmethod scanner-token ((scanner sod-token-scanner))
103   (with-slots (char-scanner line column) scanner
104     (with-parser-context (character-scanner-context :scanner char-scanner)
105
106       (flet ((scan-digits (&key (radix 10) (min 1) (init 0))
107                ;; Scan and return a sequence of digits.
108                (parse (many (acc init (+ (* acc radix) it) :min min)
109                         (label (list :digit radix)
110                                (filter (lambda (ch)
111                                          (digit-char-p ch radix)))))))
112              (start-floc ()
113                ;; This is a little nasty.  We scan the first token during
114                ;; instance initialization, as a result of `shared-initialize'
115                ;; on `token-scanner'.  Unfortunately, this happens before
116                ;; we've had a chance to initialize our own `filename' slot.
117                ;; This means that we can't use the SCANNER as a file
118                ;; location, however tempting it might be.  So we have this
119                ;; hack.
120                (make-file-location (scanner-filename char-scanner)
121                                    (scanner-line scanner)
122                                    (scanner-column scanner))))
123
124         ;; Skip initial junk, and remember the place.
125         (loop
126           (setf (scanner-line scanner) (scanner-line char-scanner)
127                 (scanner-column scanner) (scanner-column char-scanner))
128           (cond-parse (:consumedp cp :expected exp)
129             ((satisfies whitespace-char-p) (parse :whitespace))
130             ((scan-comment char-scanner))
131             (t (if cp (lexer-error char-scanner exp) (return)))))
132
133         ;; Now parse something.
134         (cond-parse (:consumedp cp :expected exp)
135
136           ;; Alphanumerics mean we read an identifier.
137           ((or #\_ (satisfies alpha-char-p))
138            (values :id (with-output-to-string (out)
139                          (write-char it out)
140                          (parse (many (nil nil (write-char it out))
141                                   (or #\_ (satisfies alphanumericp)))))))
142
143           ;; Quotes introduce a literal.
144           ((seq ((quote (or #\" #\'))
145                  (contents (many (out (make-string-output-stream)
146                                       (progn (write-char it out) out)
147                                       :final (get-output-stream-string out))
148                              (or (and #\\ :any) (not quote))))
149                  (nil (or (char quote)
150                           (seq (:eof)
151                             (lexer-error char-scanner (list quote))
152                             (info-with-location
153                              (start-floc) "Literal started here")))))
154              (ecase quote
155                (#\" contents)
156                (#\' (case (length contents)
157                       (1 (char contents 0))
158                       (0 (cerror*-with-location (start-floc)
159                                                 'simple-lexer-error
160                                                 :format-control
161                                                 "Empty character literal")
162                          #\?)
163                       (t (cerror*-with-location (start-floc)
164                                                 'simple-lexer-error
165                                                 :format-control
166                                                 "Too many characters ~
167                                                  in character literal")
168                          (char contents 0))))))
169            (values (etypecase it
170                      (character :char)
171                      (string :string))
172                    it))
173
174           ;; Zero introduces a chosen-radix integer.
175           ((and #\0
176                 (or (and (or #\b #\B) (scan-digits :radix 2))
177                     (and (or #\o #\O) (scan-digits :radix 8))
178                     (and (or #\x #\X) (scan-digits :radix 16))
179                     (scan-digits :radix 8 :min 0)))
180            (values :int it))
181
182           ;; Any other digit forces radix-10.
183           ((seq ((d (filter digit-char-p))
184                  (i (scan-digits :radix 10 :min 0 :init d)))
185              i)
186            (values :int it))
187
188           ;; Some special punctuation sequences are single tokens.
189           ("..." (values :ellipsis nil))
190
191           ;; Any other character is punctuation.
192           (:any (values it nil))
193
194           ;; End of file means precisely that.
195           (:eof (values :eof nil))
196
197           ;; Report errors and try again.  Because we must have consumed some
198           ;; input in order to get here (we've matched both :any and :eof) we
199           ;; must make progress on every call.
200           (t
201            (assert cp)
202            (lexer-error char-scanner exp)
203            (scanner-token scanner)))))))
204
205 ;;;----- That's all, folks --------------------------------------------------