X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/634c11b088818386ab98ad2282d56d20195cc2de..05d59b98c98f1b970112ef5c82f5816770881ea0:/src/module-parse.lisp diff --git a/src/module-parse.lisp b/src/module-parse.lisp index aa7e9f4..028ad87 100644 --- a/src/module-parse.lisp +++ b/src/module-parse.lisp @@ -245,18 +245,32 @@ (car declarator) pset init scanner)) #\,)) - #\;))))) + (nil (must #\;))))))) + +(defun synthetic-name () + "Return an obviously bogus synthetic not-identifier." + (let ((ix *temporary-index*)) + (incf *temporary-index*) + (make-instance 'temporary-variable :tag (format nil "%%#~A" ix)))) (defun parse-class-body (scanner pset name supers) ;; class-body ::= `{' class-item* `}' ;; ;; class-item ::= property-set raw-class-item (with-parser-context (token-scanner-context :scanner scanner) - (make-class-type name) - (let* ((duff nil) - (class (make-sod-class name + (when name (make-class-type name)) + (let* ((duff (null name)) + (synthetic-name (or name + (let ((var (synthetic-name))) + (unless pset + (setf pset (make-property-set))) + (unless (pset-get pset "nick") + (add-property pset "nick" var :type :id)) + var))) + (class (make-sod-class synthetic-name (restart-case - (mapcar #'find-sod-class supers) + (mapcar #'find-sod-class + (or supers (list "SodObject"))) (continue () (setf duff t) (list (find-sod-class "SodObject")))) @@ -320,24 +334,24 @@ ;; [`,' list[init-declarator]] `;' ;; ;; init-declarator ::= declarator [initializer] - (parse (and (seq ((init (? (parse-initializer)))) - (make-sod-slot class name type - sub-pset scanner) - (when init - (make-sod-instance-initializer - class nick name init sub-pset scanner))) - (skip-many () - (seq (#\, - (ds (parse-declarator scanner - base-type)) - (init (? (parse-initializer)))) - (make-sod-slot class (cdr ds) (car ds) - sub-pset scanner) - (when init - (make-sod-instance-initializer - class nick (cdr ds) init - sub-pset scanner)))) - #\;))) + (flet ((make-it (name type init) + (make-sod-slot class name type + sub-pset scanner) + (when init + (make-sod-instance-initializer class + nick name + init + sub-pset + scanner)))) + (parse (and (seq ((init (? (parse-initializer)))) + (make-it name type init)) + (skip-many () + (seq (#\, + (ds (parse-declarator scanner + base-type)) + (init (? (parse-initializer)))) + (make-it (cdr ds) (car ds) init))) + #\;)))) (parse-initializer-item (sub-pset must-init-p constructor) ;; initializer-item ::= @@ -419,11 +433,12 @@ ;; `class' id `;' (with-parser-context (token-scanner-context :scanner scanner) (parse (seq ("class" - (name :id) + (name (must :id)) (nil (or (seq (#\;) - (make-class-type name)) - (seq ((supers (seq (#\: (ids (list () :id #\,))) - ids)) + (when name (make-class-type name))) + (seq ((supers (must (seq (#\: + (ids (list () :id #\,))) + ids))) (nil (parse-class-body scanner pset name supers)))))))))))