Commit | Line | Data |
---|---|---|
bf090e02 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Top-level parser for module syntax | |
4 | ;;; | |
5 | ;;; (c) 2010 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
e0808c47 | 10 | ;;; This file is part of the Sensible Object Design, an object system for C. |
bf090e02 MW |
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 | (in-package #:sod) | |
27 | ||
28 | ;;;-------------------------------------------------------------------------- | |
29 | ;;; Toplevel syntax. | |
30 | ||
bf090e02 MW |
31 | ;;; Type names. |
32 | ||
048d0b2d | 33 | (define-pluggable-parser module typename (scanner pset) |
ceed01af | 34 | ;; `typename' list[id] `;' |
048d0b2d | 35 | (declare (ignore pset)) |
bf090e02 MW |
36 | (with-parser-context (token-scanner-context :scanner scanner) |
37 | (parse (and "typename" | |
65eebc3b | 38 | (skip-many () |
c41a95b1 MW |
39 | (error () |
40 | (seq ((id :id)) | |
41 | (if (or (gethash id *module-type-map*) | |
42 | (find-simple-c-type id)) | |
43 | (cerror* "Type `~A' already defined" id) | |
44 | (add-to-module *module* | |
45 | (make-instance 'type-item | |
46 | :name id)))) | |
47 | (skip-until () #\, #\;)) | |
bf090e02 | 48 | #\,) |
c41a95b1 | 49 | (must #\;))))) |
bf090e02 MW |
50 | |
51 | ;;; Fragments. | |
52 | ||
048d0b2d | 53 | (define-pluggable-parser module code (scanner pset) |
4fc52153 | 54 | ;; `code' id `:' item-name [constraints] `{' c-fragment `}' |
54ea6ee8 | 55 | ;; `code' id `:' constraints `;' |
048d0b2d | 56 | ;; |
ceed01af | 57 | ;; constraints ::= `[' list[constraint] `]' |
4fc52153 MW |
58 | ;; constraint ::= item-name+ |
59 | ;; item-name ::= id | `(' id+ `)' | |
048d0b2d | 60 | (declare (ignore pset)) |
bf090e02 | 61 | (with-parser-context (token-scanner-context :scanner scanner) |
4fc52153 MW |
62 | (labels ((kw () |
63 | (parse (seq ((kw :id)) | |
64 | (intern (frob-identifier kw) 'keyword)))) | |
65 | (item () | |
66 | (parse (or (kw) | |
67 | (seq (#\( (names (list (:min 1) (kw))) #\)) | |
66c60924 MW |
68 | names)))) |
69 | (constraints () | |
70 | (parse (seq (#\[ | |
71 | (constraints | |
72 | (list () | |
73 | (list (:min 1) | |
74 | (error (:ignore-unconsumed t) (item) | |
75 | (skip-until () :id #\( #\, #\]))) | |
76 | #\,)) | |
77 | #\]) | |
78 | constraints))) | |
79 | (fragment () | |
80 | (parse-delimited-fragment scanner #\{ #\}))) | |
9ec578d9 | 81 | (parse (seq ("code" |
ea4843d5 MW |
82 | (reason (must (kw))) |
83 | (nil (must #\:)) | |
54ea6ee8 MW |
84 | (item (or (seq ((constraints (constraints)) |
85 | (nil (must #\;))) | |
86 | (make-instance 'code-fragment-item | |
87 | :reason reason | |
88 | :constraints constraints)) | |
89 | (seq ((name (must (item))) | |
d018d6d8 MW |
90 | (constraints (? (constraints))) |
91 | (fragment (fragment))) | |
92 | (and name | |
93 | (make-instance 'code-fragment-item | |
94 | :reason reason | |
95 | :constraints constraints | |
96 | :name name | |
97 | :fragment fragment)))))) | |
98 | (when item (add-to-module *module* item))))))) | |
bf090e02 MW |
99 | |
100 | ;;; External files. | |
101 | ||
9ec578d9 MW |
102 | (export 'read-module) |
103 | (defun read-module (pathname &key (truename nil truep) location) | |
bf090e02 MW |
104 | "Parse the file at PATHNAME as a module, returning it. |
105 | ||
106 | This is the main entry point for parsing module files. You may well know | |
107 | the file's TRUENAME already (e.g., because `probe-file' dropped it into | |
108 | your lap) so you can avoid repeating the search by providing it. | |
109 | ||
110 | The LOCATION is the thing which wanted the module imported -- usually a | |
111 | `file-location' object, though it might be anything other than `t' which | |
112 | can be printed in the event of circular imports." | |
113 | ||
9ec578d9 MW |
114 | (setf pathname (merge-pathnames pathname |
115 | (make-pathname :type "SOD" :case :common))) | |
116 | (unless truep (setf truename (truename pathname))) | |
bf090e02 MW |
117 | (define-module (pathname :location location :truename truename) |
118 | (with-open-file (f-stream pathname :direction :input) | |
a351d620 | 119 | (let* ((char-scanner (make-instance 'charbuf-scanner |
e783e65b MW |
120 | :stream f-stream |
121 | :filename (namestring pathname))) | |
bf090e02 MW |
122 | (scanner (make-instance 'sod-token-scanner |
123 | :char-scanner char-scanner))) | |
124 | (with-default-error-location (scanner) | |
125 | (with-parser-context (token-scanner-context :scanner scanner) | |
300a3f0a MW |
126 | (multiple-value-bind (result winp consumedp) |
127 | (parse (skip-many () | |
128 | (seq ((pset (parse-property-set scanner)) | |
129 | (nil (error () | |
a8bc7831 MW |
130 | (plug module scanner pset) |
131 | (skip-until (:keep-end nil) | |
132 | #\; #\})))) | |
300a3f0a MW |
133 | (check-unused-properties pset)))) |
134 | (declare (ignore consumedp)) | |
135 | (unless winp (syntax-error scanner result))))))))) | |
048d0b2d | 136 | |
048d0b2d MW |
137 | (define-pluggable-parser module file (scanner pset) |
138 | ;; `import' string `;' | |
139 | ;; `load' string `;' | |
140 | (declare (ignore pset)) | |
bf090e02 | 141 | (flet ((common (name type what thunk) |
87fa582a | 142 | (when name |
fbd5be64 | 143 | (find-file (pathname (scanner-filename scanner)) |
87fa582a MW |
144 | (merge-pathnames name |
145 | (make-pathname :type type | |
146 | :case :common)) | |
147 | what | |
148 | thunk)))) | |
bf090e02 | 149 | (with-parser-context (token-scanner-context :scanner scanner) |
87fa582a | 150 | (parse (or (seq ("import" (name (must :string)) (nil (must #\;))) |
bf090e02 MW |
151 | (common name "SOD" "module" |
152 | (lambda (path true) | |
153 | (handler-case | |
154 | (let ((module (read-module path | |
155 | :truename true))) | |
156 | (when module | |
157 | (module-import module) | |
e05aabbb | 158 | (pushnew path (module-files *module*)) |
bf090e02 MW |
159 | (pushnew module |
160 | (module-dependencies | |
161 | *module*)))) | |
162 | (file-error (error) | |
163 | (cerror* "Error reading module ~S: ~A" | |
87fa582a MW |
164 | path error)) |
165 | (error (error) | |
166 | (cerror* "Unexpected error reading ~ | |
167 | module ~S: ~A" | |
bf090e02 | 168 | path error)))))) |
87fa582a | 169 | (seq ("load" (name (must :string)) (nil (must #\;))) |
bf090e02 MW |
170 | (common name "LISP" "Lisp file" |
171 | (lambda (path true) | |
172 | (handler-case | |
e05aabbb MW |
173 | (progn |
174 | (pushnew path (module-files *module*)) | |
175 | (load true :verbose nil :print nil)) | |
bf090e02 MW |
176 | (error (error) |
177 | (cerror* "Error loading Lisp file ~S: ~A" | |
178 | path error))))))))))) | |
179 | ||
01e3faf9 MW |
180 | ;;; Setting properties. |
181 | ||
182 | (define-pluggable-parser module set (scanner pset) | |
ceed01af | 183 | ;; `set' list[property] `;' |
01e3faf9 MW |
184 | (with-parser-context (token-scanner-context :scanner scanner) |
185 | (parse (and "set" | |
186 | (lisp (let ((module-pset (module-pset *module*))) | |
187 | (when pset | |
188 | (pset-map (lambda (prop) | |
5445420e MW |
189 | (add-property |
190 | module-pset | |
191 | (p-name prop) (p-value prop) | |
192 | :type (p-type prop) | |
193 | :location (p-location prop)) | |
01e3faf9 MW |
194 | (setf (p-seenp prop) t)) |
195 | pset)) | |
99a74df1 | 196 | (parse (skip-many (:min (if pset 0 1)) |
01e3faf9 | 197 | (error (:ignore-unconsumed t) |
5445420e | 198 | (parse-property scanner module-pset) |
65eebc3b | 199 | (skip-until () #\, #\;)) |
01e3faf9 MW |
200 | #\,)))) |
201 | #\;)))) | |
202 | ||
bf090e02 MW |
203 | ;;; Lisp escape. |
204 | ||
048d0b2d | 205 | (define-pluggable-parser module lisp (scanner pset) |
bf090e02 | 206 | ;; `lisp' s-expression `;' |
048d0b2d | 207 | (declare (ignore pset)) |
bf090e02 MW |
208 | (with-parser-context (token-scanner-context :scanner scanner) |
209 | (parse (seq ((sexp (if (and (eql (token-type scanner) :id) | |
210 | (string= (token-value scanner) "lisp")) | |
211 | (let* ((stream (make-scanner-stream scanner)) | |
212 | (sexp (read stream t))) | |
213 | (scanner-step scanner) | |
214 | (values sexp t t)) | |
215 | (values '((:id "lisp")) nil nil))) | |
634c11b0 | 216 | (nil (must #\;))) |
bf090e02 MW |
217 | (eval sexp))))) |
218 | ||
219 | ;;;-------------------------------------------------------------------------- | |
00d59354 MW |
220 | ;;; Static instances. |
221 | ||
222 | (define-pluggable-parser module instance (scanner pset) | |
223 | ;; `instance' id id list[slot-initializer] `;' | |
224 | (with-parser-context (token-scanner-context :scanner scanner) | |
225 | (let ((duff nil) | |
226 | (floc nil) | |
227 | (empty-pset (make-property-set))) | |
228 | (parse (seq ("instance" | |
229 | (class (seq ((class-name (must :id))) | |
230 | (setf floc (file-location scanner)) | |
231 | (restart-case (find-sod-class class-name) | |
232 | (continue () | |
233 | (setf duff t) | |
234 | nil)))) | |
235 | (name (must :id)) | |
236 | (inits (? (seq (#\: | |
237 | (inits (list (:min 0) | |
238 | (seq ((nick (must :id)) | |
239 | #\. | |
240 | (name (must :id)) | |
241 | (value | |
242 | (parse-delimited-fragment | |
243 | scanner #\= '(#\, #\;) | |
244 | :keep-end t))) | |
245 | (make-sod-instance-initializer | |
246 | class nick name value | |
247 | empty-pset | |
248 | :add-to-class nil | |
249 | :location scanner)) | |
250 | #\,))) | |
251 | inits))) | |
252 | #\;) | |
253 | (unless duff | |
254 | (acond ((find-if (lambda (item) | |
255 | (and (typep item 'static-instance) | |
256 | (string= (static-instance-name item) | |
257 | name))) | |
258 | (module-items *module*)) | |
259 | (cerror*-with-location floc | |
260 | "Instance with name `~A' ~ | |
261 | already defined." | |
262 | name) | |
263 | (info-with-location (file-location it) | |
264 | "Previous definition was ~ | |
265 | here.")) | |
266 | (t | |
267 | (add-to-module *module* | |
268 | (make-static-instance class name | |
269 | inits | |
270 | pset | |
271 | floc)))))))))) | |
272 | ||
273 | ;;;-------------------------------------------------------------------------- | |
bf090e02 MW |
274 | ;;; Class declarations. |
275 | ||
7f2917d2 MW |
276 | (export 'class-item) |
277 | ||
a42893dd MW |
278 | (define-pluggable-parser class-item initfrags (scanner class pset) |
279 | ;; raw-class-item ::= frag-keyword `{' c-fragment `}' | |
280 | ;; frag-keyword ::= `init' | `teardown' | |
281 | (with-parser-context (token-scanner-context :scanner scanner) | |
282 | (parse (seq ((make (or (seq ("init") #'make-sod-class-initfrag) | |
283 | (seq ("teardown") #'make-sod-class-tearfrag))) | |
284 | (frag (parse-delimited-fragment scanner #\{ #\}))) | |
81054f01 | 285 | (funcall make class frag pset :location scanner))))) |
a42893dd | 286 | |
b2983f35 | 287 | (define-pluggable-parser class-item initargs (scanner class pset) |
ceed01af | 288 | ;; initarg-item ::= `initarg' declspec+ list[init-declarator] |
b2983f35 MW |
289 | ;; init-declarator ::= declarator [`=' initializer] |
290 | (with-parser-context (token-scanner-context :scanner scanner) | |
291 | (parse (seq ("initarg" | |
292 | (base-type (parse-c-type scanner)) | |
293 | (nil (skip-many (:min 1) | |
294 | (seq ((declarator (parse-declarator scanner | |
295 | base-type)) | |
296 | (init (? (parse-delimited-fragment | |
297 | scanner #\= (list #\; #\,) | |
298 | :keep-end t)))) | |
299 | (make-sod-user-initarg class | |
300 | (cdr declarator) | |
301 | (car declarator) | |
81054f01 MW |
302 | pset |
303 | :default init | |
304 | :location scanner)) | |
b2983f35 | 305 | #\,)) |
7dca21e9 | 306 | (nil (must #\;))))))) |
b2983f35 | 307 | |
6362119e MW |
308 | (defun synthetic-name () |
309 | "Return an obviously bogus synthetic not-identifier." | |
310 | (let ((ix *temporary-index*)) | |
311 | (incf *temporary-index*) | |
312 | (make-instance 'temporary-variable :tag (format nil "%%#~A" ix)))) | |
313 | ||
048d0b2d | 314 | (defun parse-class-body (scanner pset name supers) |
c91b90c3 | 315 | ;; class-body ::= `{' class-item* `}' |
048d0b2d MW |
316 | ;; |
317 | ;; class-item ::= property-set raw-class-item | |
c91b90c3 | 318 | (with-parser-context (token-scanner-context :scanner scanner) |
6362119e MW |
319 | (when name (make-class-type name)) |
320 | (let* ((duff (null name)) | |
d1c01c33 MW |
321 | (superclasses |
322 | (let ((superclasses (restart-case | |
323 | (mapcar #'find-sod-class | |
324 | (or supers (list "SodObject"))) | |
325 | (continue () | |
326 | (setf duff t) | |
327 | (list (find-sod-class "SodObject")))))) | |
0c289c54 MW |
328 | (find-duplicates (lambda (first second) |
329 | (declare (ignore second)) | |
330 | (setf duff t) | |
331 | (cerror* "Class `~A' has duplicate ~ | |
332 | direct superclass `~A'" | |
333 | name first)) | |
334 | superclasses) | |
335 | (delete-duplicates superclasses))) | |
6362119e MW |
336 | (synthetic-name (or name |
337 | (let ((var (synthetic-name))) | |
338 | (unless pset | |
339 | (setf pset (make-property-set))) | |
340 | (unless (pset-get pset "nick") | |
341 | (add-property pset "nick" var :type :id)) | |
342 | var))) | |
81054f01 MW |
343 | (class (make-sod-class synthetic-name superclasses pset |
344 | :location scanner)) | |
c91b90c3 MW |
345 | (nick (sod-class-nickname class))) |
346 | ||
8152ead4 MW |
347 | (labels ((must-id () |
348 | (parse (must :id (progn (setf duff t) (synthetic-name))))) | |
349 | ||
350 | (parse-maybe-dotted-name () | |
002d481f | 351 | ;; maybe-dotted-name ::= [id `.'] id |
c91b90c3 MW |
352 | ;; |
353 | ;; A plain identifier is returned as a string, as usual; a | |
354 | ;; dotted identifier is returned as a cons cell of the two | |
355 | ;; names. | |
8152ead4 MW |
356 | (parse (seq ((name-a (must-id)) |
357 | (name-b (? (seq (#\. (id (must-id))) id)))) | |
31114112 MW |
358 | (if name-b (cons name-a name-b) |
359 | name-a)))) | |
360 | ||
361 | (parse-maybe-dotted-declarator (base-type) | |
362 | ;; Parse a declarator or dotted-declarator, i.e., one whose | |
363 | ;; centre is maybe-dotted-name above. | |
364 | (parse-declarator scanner base-type | |
365 | :keywordp t | |
366 | :kernel #'parse-maybe-dotted-name)) | |
c91b90c3 | 367 | |
c91b90c3 MW |
368 | (parse-message-item (sub-pset type name) |
369 | ;; message-item ::= | |
370 | ;; declspec+ declarator -!- (method-body | `;') | |
2cbdee3d MW |
371 | ;; |
372 | ;; Don't allow a method-body here if the message takes a | |
373 | ;; varargs list, because we don't have a name for the | |
374 | ;; `va_list' parameter. | |
81054f01 MW |
375 | (let ((message (make-sod-message class name type sub-pset |
376 | :location scanner))) | |
2cbdee3d MW |
377 | (if (varargs-message-p message) |
378 | (parse #\;) | |
379 | (parse (or #\; (parse-method-item sub-pset | |
380 | type nick name)))))) | |
c91b90c3 MW |
381 | |
382 | (parse-method-item (sub-pset type sub-nick name) | |
383 | ;; method-item ::= | |
384 | ;; declspec+ dotted-declarator -!- method-body | |
385 | ;; | |
386 | ;; method-body ::= `{' c-fragment `}' | `extern' `;' | |
387 | (parse (seq ((body (or (seq ("extern" #\;) nil) | |
388 | (parse-delimited-fragment | |
389 | scanner #\{ #\})))) | |
add6883c MW |
390 | (restart-case |
391 | (make-sod-method class sub-nick name type | |
81054f01 MW |
392 | body sub-pset |
393 | :location scanner) | |
add6883c | 394 | (continue () :report "Continue"))))) |
c91b90c3 MW |
395 | |
396 | (parse-initializer () | |
a888e3ac | 397 | ;; initializer ::= `=' c-fragment |
c91b90c3 | 398 | ;; |
a888e3ac MW |
399 | ;; Return a VALUE, ready for passing to a `sod-initializer' |
400 | ;; constructor. | |
abfdb01c | 401 | (parse-delimited-fragment scanner #\= '(#\, #\;) |
a888e3ac | 402 | :keep-end t)) |
c91b90c3 MW |
403 | |
404 | (parse-slot-item (sub-pset base-type type name) | |
405 | ;; slot-item ::= | |
406 | ;; declspec+ declarator -!- [initializer] | |
ceed01af | 407 | ;; [`,' list[init-declarator]] `;' |
c91b90c3 | 408 | ;; |
ceed01af | 409 | ;; init-declarator ::= declarator [initializer] |
05d59b98 | 410 | (flet ((make-it (name type init) |
add6883c MW |
411 | (restart-case |
412 | (progn | |
81054f01 MW |
413 | (make-sod-slot class name type sub-pset |
414 | :location scanner) | |
add6883c | 415 | (when init |
81054f01 MW |
416 | (make-sod-instance-initializer |
417 | class nick name init sub-pset | |
418 | :location scanner))) | |
add6883c | 419 | (continue () :report "Continue")))) |
8152ead4 MW |
420 | (parse (and (error () |
421 | (seq ((init (? (parse-initializer)))) | |
422 | (make-it name type init)) | |
423 | (skip-until () #\, #\;)) | |
05d59b98 | 424 | (skip-many () |
8152ead4 MW |
425 | (error (:ignore-unconsumed t) |
426 | (seq (#\, | |
427 | (ds (parse-declarator scanner | |
428 | base-type)) | |
429 | (init (? (parse-initializer)))) | |
430 | (make-it (cdr ds) (car ds) init)) | |
431 | (skip-until () #\, #\;))) | |
432 | (must #\;))))) | |
c91b90c3 | 433 | |
b2983f35 | 434 | (parse-initializer-item (sub-pset must-init-p constructor) |
c91b90c3 | 435 | ;; initializer-item ::= |
ceed01af | 436 | ;; [`class'] -!- list[slot-initializer] `;' |
c91b90c3 | 437 | ;; |
b2983f35 | 438 | ;; slot-initializer ::= id `.' id [initializer] |
5445420e | 439 | (let ((parse-init (if must-init-p #'parse-initializer |
b2983f35 MW |
440 | (parser () (? (parse-initializer)))))) |
441 | (parse (and (skip-many () | |
8152ead4 MW |
442 | (error (:ignore-unconsumed t) |
443 | (seq ((name-a :id) #\. | |
444 | (name-b (must-id)) | |
445 | (init (funcall parse-init))) | |
446 | (restart-case | |
447 | (funcall constructor class | |
448 | name-a name-b init | |
81054f01 MW |
449 | sub-pset |
450 | :location scanner) | |
8152ead4 MW |
451 | (continue () :report "Continue"))) |
452 | (skip-until () #\, #\;)) | |
b2983f35 | 453 | #\,) |
8152ead4 | 454 | (must #\;))))) |
c91b90c3 MW |
455 | |
456 | (class-item-dispatch (sub-pset base-type type name) | |
457 | ;; Logically part of `parse-raw-class-item', but the | |
458 | ;; indentation was getting crazy. We're currently at | |
459 | ;; | |
460 | ;; raw-class-item ::= | |
461 | ;; declspec+ (declarator | dotted-declarator) -!- ... | |
462 | ;; | other-items | |
463 | ;; | |
464 | ;; If the declarator is dotted then this must be a method | |
465 | ;; definition; otherwise it might be a message or slot. | |
466 | (cond ((not (typep type 'c-function-type)) | |
467 | (when (consp name) | |
65eebc3b | 468 | (cerror* |
a1985b3c | 469 | "Method declarations must have function type") |
c91b90c3 MW |
470 | (setf name (cdr name))) |
471 | (parse-slot-item sub-pset base-type type name)) | |
472 | ((consp name) | |
473 | (parse-method-item sub-pset type | |
474 | (car name) (cdr name))) | |
475 | (t | |
476 | (parse-message-item sub-pset type name)))) | |
477 | ||
478 | (parse-raw-class-item (sub-pset) | |
479 | ;; raw-class-item ::= | |
480 | ;; message-item | |
481 | ;; | method-item | |
482 | ;; | slot-item | |
483 | ;; | initializer-item | |
a42893dd | 484 | ;; | initfrag-item |
c91b90c3 MW |
485 | ;; |
486 | ;; Most of the above begin with declspecs and a declarator | |
487 | ;; (which might be dotted). So we parse that here and | |
488 | ;; dispatch based on what we find. | |
048d0b2d | 489 | (parse (or (plug class-item scanner class sub-pset) |
db2abd9d | 490 | (peek |
c91b90c3 MW |
491 | (seq ((ds (parse-c-type scanner)) |
492 | (dc (parse-maybe-dotted-declarator ds)) | |
65b1d9d7 | 493 | (nil (commit)) |
048d0b2d MW |
494 | (nil (class-item-dispatch sub-pset |
495 | ds | |
496 | (car dc) | |
db2abd9d | 497 | (cdr dc)))))) |
c91b90c3 | 498 | (and "class" |
5445420e | 499 | (parse-initializer-item sub-pset t |
c91b90c3 | 500 | #'make-sod-class-initializer)) |
5445420e | 501 | (parse-initializer-item sub-pset nil |
c91b90c3 MW |
502 | #'make-sod-instance-initializer))))) |
503 | ||
8152ead4 | 504 | (parse (seq ((nil (must #\{)) |
048d0b2d MW |
505 | (nil (skip-many () |
506 | (seq ((sub-pset (parse-property-set scanner)) | |
9ec578d9 | 507 | (nil (parse-raw-class-item sub-pset))) |
048d0b2d | 508 | (check-unused-properties sub-pset)))) |
8152ead4 | 509 | (nil (must #\}))) |
e45a106d MW |
510 | (unless (finalize-sod-class class) |
511 | (setf duff t)) | |
70b33a78 MW |
512 | (unless duff |
513 | (add-to-module *module* class)))))))) | |
048d0b2d MW |
514 | |
515 | (define-pluggable-parser module class (scanner pset) | |
ceed01af | 516 | ;; `class' id `:' list[id] class-body |
c91b90c3 | 517 | ;; `class' id `;' |
bf090e02 | 518 | (with-parser-context (token-scanner-context :scanner scanner) |
c91b90c3 | 519 | (parse (seq ("class" |
6362119e | 520 | (name (must :id)) |
c91b90c3 | 521 | (nil (or (seq (#\;) |
6362119e MW |
522 | (when name (make-class-type name))) |
523 | (seq ((supers (must (seq (#\: | |
524 | (ids (list () :id #\,))) | |
525 | ids))) | |
c91b90c3 MW |
526 | (nil (parse-class-body |
527 | scanner | |
528 | pset name supers))))))))))) | |
529 | ||
bf090e02 | 530 | ;;;----- That's all, folks -------------------------------------------------- |