X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/5445420ed4158d4cd7aae4a4bb52f4a4e22ed1a2..e783e65bc434b69ad73684c035aac345878ba6e9:/src/module-parse.lisp?ds=sidebyside diff --git a/src/module-parse.lisp b/src/module-parse.lisp index a339682..f90f360 100644 --- a/src/module-parse.lisp +++ b/src/module-parse.lisp @@ -31,11 +31,11 @@ (in-package #:sod) ;;; Type names. (define-pluggable-parser module typename (scanner pset) - ;; `typename' id ( `,' id )* `;' + ;; `typename' list[id] `;' (declare (ignore pset)) (with-parser-context (token-scanner-context :scanner scanner) (parse (and "typename" - (skip-many (:min 1) + (skip-many () (seq ((id :id)) (if (gethash id *module-type-map*) (cerror* "Type `~A' already defined" id) @@ -50,7 +50,7 @@ (define-pluggable-parser module typename (scanner pset) (define-pluggable-parser module code (scanner pset) ;; `code' id `:' item-name [constraints] `{' c-fragment `}' ;; - ;; constrains ::= `[' constraint-list `]' + ;; constraints ::= `[' list[constraint] `]' ;; constraint ::= item-name+ ;; item-name ::= id | `(' id+ `)' (declare (ignore pset)) @@ -103,7 +103,8 @@ (define-module (pathname :location location :truename truename) (let* ((*readtable* (copy-readtable)) (*package* (find-package '#:sod-user)) (char-scanner (make-instance 'charbuf-scanner - :stream f-stream)) + :stream f-stream + :filename (namestring pathname))) (scanner (make-instance 'sod-token-scanner :char-scanner char-scanner))) (with-default-error-location (scanner) @@ -112,7 +113,9 @@ (define-module (pathname :location location :truename truename) (parse (skip-many () (seq ((pset (parse-property-set scanner)) (nil (error () - (plug module scanner pset)))) + (plug module scanner pset) + (skip-until (:keep-end nil) + #\; #\})))) (check-unused-properties pset)))) (declare (ignore consumedp)) (unless winp (syntax-error scanner result))))))))) @@ -162,7 +165,7 @@ (define-pluggable-parser module file (scanner pset) ;;; Setting properties. (define-pluggable-parser module set (scanner pset) - ;; `set' property-list `;' + ;; `set' list[property] `;' (with-parser-context (token-scanner-context :scanner scanner) (parse (and "set" (lisp (let ((module-pset (module-pset *module*))) @@ -178,7 +181,7 @@ (define-pluggable-parser module set (scanner pset) (parse (skip-many (:min 0) (error (:ignore-unconsumed t) (parse-property scanner module-pset) - (skip-until (:keep-end t) #\, #\;)) + (skip-until () #\, #\;)) #\,)))) #\;)))) @@ -213,7 +216,7 @@ (define-pluggable-parser class-item initfrags (scanner class pset) (funcall make class frag pset scanner))))) (define-pluggable-parser class-item initargs (scanner class pset) - ;; initarg-item ::= `initarg' declspec+ init-declarator-list + ;; initarg-item ::= `initarg' declspec+ list[init-declarator] ;; init-declarator ::= declarator [`=' initializer] (with-parser-context (token-scanner-context :scanner scanner) (parse (seq ("initarg" @@ -301,10 +304,9 @@ (defun parse-class-body (scanner pset name supers) (parse-slot-item (sub-pset base-type type name) ;; slot-item ::= ;; declspec+ declarator -!- [initializer] - ;; [`,' init-declarator-list] `;' + ;; [`,' list[init-declarator]] `;' ;; - ;; init-declarator-list ::= - ;; declarator [initializer] [`,' init-declarator-list] + ;; init-declarator ::= declarator [initializer] (parse (and (seq ((init (? (parse-initializer)))) (make-sod-slot class name type sub-pset scanner) @@ -326,7 +328,7 @@ (defun parse-class-body (scanner pset name supers) (parse-initializer-item (sub-pset must-init-p constructor) ;; initializer-item ::= - ;; [`class'] -!- slot-initializer-list `;' + ;; [`class'] -!- list[slot-initializer] `;' ;; ;; slot-initializer ::= id `.' id [initializer] (let ((parse-init (if must-init-p #'parse-initializer @@ -352,8 +354,7 @@ (defun parse-class-body (scanner pset name supers) ;; definition; otherwise it might be a message or slot. (cond ((not (typep type 'c-function-type)) (when (consp name) - (cerror*-with-location - scanner + (cerror* "Method declarations must have function type") (setf name (cdr name))) (parse-slot-item sub-pset base-type type name)) @@ -401,7 +402,7 @@ (defun parse-class-body (scanner pset name supers) (add-to-module *module* class)))))))) (define-pluggable-parser module class (scanner pset) - ;; `class' id `:' id-list class-body + ;; `class' id `:' list[id] class-body ;; `class' id `;' (with-parser-context (token-scanner-context :scanner scanner) (parse (seq ("class"