From 8152ead4c5c5980414d1a4f21a98e851cc25c9b1 Mon Sep 17 00:00:00 2001
Message-Id: <8152ead4c5c5980414d1a4f21a98e851cc25c9b1.1715356592.git.mdw@distorted.org.uk>
From: Mark Wooding <mdw@chiark.greenend.org.uk>
Date: Sun, 26 Mar 2017 15:16:18 +0100
Subject: [PATCH] src/module-parse.lisp: Improve error recovery for core class
 items.
Organization: Straylight/Edgeware

From: Mark Wooding <mdw@distorted.org.uk>

---
 src/module-parse.lisp | 52 ++++++++++++++++++++++++++-----------------
 1 file changed, 31 insertions(+), 21 deletions(-)

diff --git a/src/module-parse.lisp b/src/module-parse.lisp
index fb60b49..c5b28a6 100644
--- a/src/module-parse.lisp
+++ b/src/module-parse.lisp
@@ -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
-- 
[mdw]