X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/c41a95b125742d97c2d0ff782964c30421eaf5ee..7dca21e9e346a9793fa455e55111085e1174c44c:/src/module-parse.lisp diff --git a/src/module-parse.lisp b/src/module-parse.lisp index cb3fcb2..2d81de1 100644 --- a/src/module-parse.lisp +++ b/src/module-parse.lisp @@ -66,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. @@ -127,7 +132,7 @@ (define-pluggable-parser module test (scanner pset) ;; `demo' string `;' (declare (ignore pset)) (with-parser-context (token-scanner-context :scanner scanner) - (parse (seq ("demo" (string :string) #\;) + (parse (seq ("demo" (string (must :string)) (nil (must #\;))) (format t ";; DEMO ~S~%" string))))) (define-pluggable-parser module file (scanner pset) @@ -135,14 +140,15 @@ (define-pluggable-parser module file (scanner pset) ;; `load' string `;' (declare (ignore pset)) (flet ((common (name type what thunk) - (find-file scanner - (merge-pathnames name - (make-pathname :type type - :case :common)) - what - thunk))) + (when name + (find-file scanner + (merge-pathnames name + (make-pathname :type type + :case :common)) + what + thunk)))) (with-parser-context (token-scanner-context :scanner scanner) - (parse (or (seq ("import" (name :string) #\;) + (parse (or (seq ("import" (name (must :string)) (nil (must #\;))) (common name "SOD" "module" (lambda (path true) (handler-case @@ -155,8 +161,12 @@ (define-pluggable-parser module file (scanner pset) *module*)))) (file-error (error) (cerror* "Error reading module ~S: ~A" + path error)) + (error (error) + (cerror* "Unexpected error reading ~ + module ~S: ~A" path error)))))) - (seq ("load" (name :string) #\;) + (seq ("load" (name (must :string)) (nil (must #\;))) (common name "LISP" "Lisp file" (lambda (path true) (handler-case @@ -201,7 +211,7 @@ (define-pluggable-parser module lisp (scanner pset) (scanner-step scanner) (values sexp t t)) (values '((:id "lisp")) nil nil))) - #\;) + (nil (must #\;))) (eval sexp))))) ;;;-------------------------------------------------------------------------- @@ -235,7 +245,7 @@ (define-pluggable-parser class-item initargs (scanner class pset) (car declarator) pset init scanner)) #\,)) - #\;))))) + (nil (must #\;))))))) (defun parse-class-body (scanner pset name supers) ;; class-body ::= `{' class-item* `}'