X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/add6883c4623cc42552bc3587aad866184f37c06..64cbfb65118395be4d6628a2ba9d5b2bd95663e0:/src/module-parse.lisp

diff --git a/src/module-parse.lisp b/src/module-parse.lisp
index 15bfe87..c5b28a6 100644
--- a/src/module-parse.lisp
+++ b/src/module-parse.lisp
@@ -277,23 +277,26 @@
 				  pset scanner))
 	   (nick (sod-class-nickname class)))
 
-      (labels ((parse-maybe-dotted-declarator (base-type)
-		 ;; Parse a declarator or dotted-declarator, i.e., one whose
-		 ;; centre is
-		 ;;
-		 ;; maybe-dotted-identifier ::= [id `.'] id
+      (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-declarator
-		  scanner base-type
-		  :keywordp t
-		  :kernel (parser ()
-			    (seq ((name-a :id)
-				  (name-b (? (seq (#\. (id :id)) id))))
-			      (if name-b (cons name-a name-b)
-				  name-a)))))
+		 (parse (seq ((name-a (must-id))
+			      (name-b (? (seq (#\. (id (must-id))) id))))
+			  (if name-b (cons name-a name-b)
+			      name-a))))
+
+	       (parse-maybe-dotted-declarator (base-type)
+		 ;; Parse a declarator or dotted-declarator, i.e., one whose
+		 ;; centre is maybe-dotted-name above.
+		 (parse-declarator scanner base-type
+				   :keywordp t
+				   :kernel #'parse-maybe-dotted-name))
 
 	       (parse-message-item (sub-pset type name)
 		 ;; message-item ::=
@@ -327,7 +330,7 @@
 		 ;;
 		 ;; Return a VALUE, ready for passing to a `sod-initializer'
 		 ;; constructor.
-		 (parse-delimited-fragment scanner #\= (list #\, #\;)
+		 (parse-delimited-fragment scanner #\= '(#\, #\;)
 					   :keep-end t))
 
 	       (parse-slot-item (sub-pset base-type type name)
@@ -348,15 +351,19 @@
 								 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 @@
 		 (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 @@
 			    (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