X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/0c289c54fb0a31491aa1d2b030851337430ccd71..7a32048d3bd7e76fd9163a381c8e210f7185fa45:/src/module-parse.lisp diff --git a/src/module-parse.lisp b/src/module-parse.lisp index 747bdf7..df058be 100644 --- a/src/module-parse.lisp +++ b/src/module-parse.lisp @@ -141,7 +141,7 @@ (declare (ignore pset)) (flet ((common (name type what thunk) (when name - (find-file scanner + (find-file (pathname (scanner-filename scanner)) (merge-pathnames name (make-pathname :type type :case :common)) @@ -226,7 +226,7 @@ (parse (seq ((make (or (seq ("init") #'make-sod-class-initfrag) (seq ("teardown") #'make-sod-class-tearfrag))) (frag (parse-delimited-fragment scanner #\{ #\}))) - (funcall make class frag pset scanner))))) + (funcall make class frag pset :location scanner))))) (define-pluggable-parser class-item initargs (scanner class pset) ;; initarg-item ::= `initarg' declspec+ list[init-declarator] @@ -243,7 +243,9 @@ (make-sod-user-initarg class (cdr declarator) (car declarator) - pset init scanner)) + pset + :default init + :location scanner)) #\,)) (nil (must #\;))))))) @@ -282,7 +284,8 @@ (unless (pset-get pset "nick") (add-property pset "nick" var :type :id)) var))) - (class (make-sod-class synthetic-name superclasses pset scanner)) + (class (make-sod-class synthetic-name superclasses pset + :location scanner)) (nick (sod-class-nickname class))) (labels ((must-id () @@ -313,8 +316,8 @@ ;; Don't allow a method-body here if the message takes a ;; varargs list, because we don't have a name for the ;; `va_list' parameter. - (let ((message (make-sod-message class name type - sub-pset scanner))) + (let ((message (make-sod-message class name type sub-pset + :location scanner))) (if (varargs-message-p message) (parse #\;) (parse (or #\; (parse-method-item sub-pset @@ -330,7 +333,8 @@ scanner #\{ #\})))) (restart-case (make-sod-method class sub-nick name type - body sub-pset scanner) + body sub-pset + :location scanner) (continue () :report "Continue"))))) (parse-initializer () @@ -350,14 +354,12 @@ (flet ((make-it (name type init) (restart-case (progn - (make-sod-slot class name type - sub-pset scanner) + (make-sod-slot class name type sub-pset + :location scanner) (when init - (make-sod-instance-initializer class - nick name - init - sub-pset - scanner))) + (make-sod-instance-initializer + class nick name init sub-pset + :location scanner))) (continue () :report "Continue")))) (parse (and (error () (seq ((init (? (parse-initializer)))) @@ -388,7 +390,8 @@ (restart-case (funcall constructor class name-a name-b init - sub-pset scanner) + sub-pset + :location scanner) (continue () :report "Continue"))) (skip-until () #\, #\;)) #\,)