chiark / gitweb /
src/module-parse.lisp: Improve error recovery for core class items.
authorMark Wooding <mdw@distorted.org.uk>
Sun, 26 Mar 2017 14:16:18 +0000 (15:16 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Fri, 8 Jun 2018 18:58:28 +0000 (19:58 +0100)
src/module-parse.lisp

index fb60b4947b3b12d331372ded8fab51659da60277..c5b28a610e59fc8a9068e73317087a9a27fcd0fc 100644 (file)
@@ -277,14 +277,17 @@ (defun parse-class-body (scanner pset name supers)
                                  pset scanner))
           (nick (sod-class-nickname class)))
 
-      (labels ((parse-maybe-dotted-name ()
+      (labels ((must-id ()
+                (parse (must :id (progn (setf duff t) (synthetic-name)))))
+
+              (parse-maybe-dotted-name ()
                 ;; maybe-dotted-name ::= [id `.'] id
                 ;;
                 ;; A plain identifier is returned as a string, as usual; a
                 ;; dotted identifier is returned as a cons cell of the two
                 ;; names.
-                (parse (seq ((name-a :id)
-                             (name-b (? (seq (#\. (id :id)) id))))
+                (parse (seq ((name-a (must-id))
+                             (name-b (? (seq (#\. (id (must-id))) id))))
                          (if name-b (cons name-a name-b)
                              name-a))))
 
@@ -348,15 +351,19 @@ (defun parse-class-body (scanner pset name supers)
                                                                 sub-pset
                                                                 scanner)))
                            (continue () :report "Continue"))))
-                  (parse (and (seq ((init (? (parse-initializer))))
-                                (make-it name type init))
+                  (parse (and (error ()
+                                  (seq ((init (? (parse-initializer))))
+                                    (make-it name type init))
+                                (skip-until () #\, #\;))
                               (skip-many ()
-                                (seq (#\,
-                                      (ds (parse-declarator scanner
-                                                            base-type))
-                                      (init (? (parse-initializer))))
-                                  (make-it (cdr ds) (car ds) init)))
-                              #\;))))
+                                (error (:ignore-unconsumed t)
+                                    (seq (#\,
+                                          (ds (parse-declarator scanner
+                                                                base-type))
+                                          (init (? (parse-initializer))))
+                                      (make-it (cdr ds) (car ds) init))
+                                  (skip-until () #\, #\;)))
+                              (must #\;)))))
 
               (parse-initializer-item (sub-pset must-init-p constructor)
                 ;; initializer-item ::=
@@ -366,15 +373,18 @@ (defun parse-class-body (scanner pset name supers)
                 (let ((parse-init (if must-init-p #'parse-initializer
                                       (parser () (? (parse-initializer))))))
                   (parse (and (skip-many ()
-                                (seq ((name-a :id) #\. (name-b :id)
-                                      (init (funcall parse-init)))
-                                  (restart-case
-                                      (funcall constructor class
-                                               name-a name-b init
-                                               sub-pset scanner)
-                                    (continue () :report "Continue")))
+                                (error (:ignore-unconsumed t)
+                                    (seq ((name-a :id) #\.
+                                          (name-b (must-id))
+                                          (init (funcall parse-init)))
+                                      (restart-case
+                                          (funcall constructor class
+                                                   name-a name-b init
+                                                   sub-pset scanner)
+                                        (continue () :report "Continue")))
+                                  (skip-until () #\, #\;))
                                 #\,)
-                              #\;))))
+                              (must #\;)))))
 
               (class-item-dispatch (sub-pset base-type type name)
                 ;; Logically part of `parse-raw-class-item', but the
@@ -424,12 +434,12 @@ (defun parse-class-body (scanner pset name supers)
                            (parse-initializer-item sub-pset nil
                             #'make-sod-instance-initializer)))))
 
-       (parse (seq (#\{
+       (parse (seq ((nil (must #\{))
                     (nil (skip-many ()
                            (seq ((sub-pset (parse-property-set scanner))
                                  (nil (parse-raw-class-item sub-pset)))
                              (check-unused-properties sub-pset))))
-                    (nil (error () #\})))
+                    (nil (must #\})))
                 (unless (finalize-sod-class class)
                   (setf duff t))
                 (unless duff