src/utilities.lisp (once-only): Ensure that the BINDS argument is a list.

[sod] / src / module-parse.lisp

diff --git a/src/module-parse.lisp b/src/module-parse.lisp
index fb60b4947b3b12d331372ded8fab51659da60277..c5b28a610e59fc8a9068e73317087a9a27fcd0fc 100644 (file)
--- 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)))
 
                                  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.
                 ;; 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))))
 
                          (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"))))
                                                                 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 ()
                               (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 ::=
 
               (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 ()
                 (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
 
               (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-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 (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
                 (unless (finalize-sod-class class)
                   (setf duff t))
                 (unless duff