X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/ceed01afc84505ed0d116ee7a00e8b4a1a4bed6c..ea4843d5bc48fb15f209a6ccd32db4b4ffab0eb7:/src/module-parse.lisp diff --git a/src/module-parse.lisp b/src/module-parse.lisp index 4d4d818..142992e 100644 --- a/src/module-parse.lisp +++ b/src/module-parse.lisp @@ -35,15 +35,18 @@ (define-pluggable-parser module typename (scanner pset) (declare (ignore pset)) (with-parser-context (token-scanner-context :scanner scanner) (parse (and "typename" - (skip-many (:min 1) - (seq ((id :id)) - (if (gethash id *module-type-map*) - (cerror* "Type `~A' already defined" id) - (add-to-module *module* - (make-instance 'type-item - :name id)))) + (skip-many () + (error () + (seq ((id :id)) + (if (or (gethash id *module-type-map*) + (find-simple-c-type id)) + (cerror* "Type `~A' already defined" id) + (add-to-module *module* + (make-instance 'type-item + :name id)))) + (skip-until () #\, #\;)) #\,) - #\;)))) + (must #\;))))) ;;; Fragments. @@ -63,23 +66,28 @@ (define-pluggable-parser module code (scanner pset) (seq (#\( (names (list (:min 1) (kw))) #\)) names))))) (parse (seq ("code" - (reason (kw)) - #\: - (name (item)) + (reason (must (kw))) + (nil (must #\:)) + (name (must (item))) (constraints (? (seq (#\[ - (constraints (list (:min 1) - (list (:min 1) - (item)) - #\,)) + (constraints + (list () + (list (:min 1) + (error (:ignore-unconsumed t) + (item) + (skip-until () + :id #\( #\, #\]))) + #\,)) #\]) constraints))) (fragment (parse-delimited-fragment scanner #\{ #\}))) - (add-to-module *module* - (make-instance 'code-fragment-item - :fragment fragment - :constraints constraints - :reason reason - :name name))))))) + (when name + (add-to-module *module* + (make-instance 'code-fragment-item + :fragment fragment + :constraints constraints + :reason reason + :name name)))))))) ;;; External files. @@ -103,7 +111,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 +121,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))))))))) @@ -175,10 +186,10 @@ (define-pluggable-parser module set (scanner pset) :location (p-location prop)) (setf (p-seenp prop) t)) pset)) - (parse (skip-many (:min 0) + (parse (skip-many (:min (if pset 0 1)) (error (:ignore-unconsumed t) (parse-property scanner module-pset) - (skip-until (:keep-end t) #\, #\;)) + (skip-until () #\, #\;)) #\,)))) #\;)))) @@ -351,8 +362,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))