src/c-types-parse.lisp: Improve handling of compatibility keywords.

[sod] / src / module-parse.lisp

diff --git a/src/module-parse.lisp b/src/module-parse.lisp
index a42c31fc804ce6ecba9d9bc55cdbe0a7edd81153..e33b6d3bc3ba342969f838b4e3769a334d57e71b 100644 (file)
--- a/src/module-parse.lisp
+++ b/src/module-parse.lisp
@@ -48,21 +48,28 @@ (define-pluggable-parser module typename (scanner pset)
 ;;; Fragments.
 
 (define-pluggable-parser module code (scanner pset)
 ;;; Fragments.
 
 (define-pluggable-parser module code (scanner pset)

-  ;; `code' id `:' id [constraints] `{' c-fragment `}'
+  ;; `code' id `:' item-name [constraints] `{' c-fragment `}'

   ;;
   ;; constrains ::= `[' constraint-list `]'
   ;;
   ;; constrains ::= `[' constraint-list `]'

-  ;; constraint ::= id+
+  ;; constraint ::= item-name+
+  ;; item-name ::= id | `(' id+ `)'

   (declare (ignore pset))
   (with-parser-context (token-scanner-context :scanner scanner)
   (declare (ignore pset))
   (with-parser-context (token-scanner-context :scanner scanner)

-    (flet ((kw ()
-            (parse (seq ((kw :id)) (intern (string-upcase kw) 'keyword)))))
+    (labels ((kw ()
+              (parse (seq ((kw :id))
+                       (intern (frob-identifier kw) 'keyword))))
+            (item ()
+              (parse (or (kw)
+                         (seq (#\( (names (list (:min 1) (kw))) #\))
+                           names)))))

       (parse (seq ("code"
                   (reason (kw))
                   #\:
       (parse (seq ("code"
                   (reason (kw))
                   #\:

-                  (name (kw))
+                  (name (item))

                   (constraints (? (seq (#\[
                                         (constraints (list (:min 1)
                   (constraints (? (seq (#\[
                                         (constraints (list (:min 1)

-                                                       (list (:min 1) (kw))
+                                                       (list (:min 1)
+                                                         (item))

                                                        #\,))
                                         #\])
                                     constraints)))
                                                        #\,))
                                         #\])
                                     constraints)))


@@ -370,6 +377,7 @@ (defun parse-class-body (scanner pset name supers)
                            (peek
                             (seq ((ds (parse-c-type scanner))
                                   (dc (parse-maybe-dotted-declarator ds))
                            (peek
                             (seq ((ds (parse-c-type scanner))
                                   (dc (parse-maybe-dotted-declarator ds))

+                                  (nil (commit))

                                   (nil (class-item-dispatch sub-pset
                                                             ds
                                                             (car dc)
                                   (nil (class-item-dispatch sub-pset
                                                             ds
                                                             (car dc)