@@ -67,8 +67,9 @@ type int attribute-type.
6767type string attribute-type.
6868type bool attribute-type.
6969type oneof list attribute-mapping -> attribute-type.
70- type attmap attribute-type.
71- type attlist attribute-type.
70+ type attmap attribute-type. % #[map(k1="v1",k2="v2")]
71+ type attlist attribute-type. % #[set(b1,b2,b3)]
72+ type attlabel attribute-type. % #[label( a(..), b, .. )] if #[label(a, b), a(..), ..]
7273type loc attribute-type.
7374
7475kind attribute-mapping type.
@@ -123,6 +124,9 @@ pred append-string i:string, i:string, o:string.
123124append-string "" A A :- !.
124125append-string A B R :- R is A ^ "." ^ B.
125126
127+ pred keep-only-label i:attribute, o:attribute.
128+ keep-only-label (attribute L _) (attribute L (leaf-str "")).
129+
126130coq.parse-attributes L S O :-
127131 std.map S (x\r\ r = supported-attribute x) CS,
128132 CS => parse-attributes.aux L "" O, !.
@@ -137,6 +141,13 @@ parse-attributes.aux [attribute S (node L)|AS] Prefix R :-
137141 parse-attributes.aux AS Prefix R1,
138142 (pi x\ supported-attribute (att x string) :- !) => parse-attributes.aux L "" Map,
139143 std.append R1 [get-option PS Map] R.
144+ parse-attributes.aux [attribute S (node L)|AS] Prefix R :-
145+ append-string Prefix S PS, supported-attribute (att PS attlabel), !,
146+ parse-attributes.aux AS Prefix R1,
147+ std.map L keep-only-label Ll,
148+ (pi x\ supported-attribute (att x bool) :- !) => parse-attributes.aux Ll "" Map,
149+ parse-attributes.aux L Prefix R2,
150+ std.append R1 [get-option PS Map|R2] R.
140151parse-attributes.aux [attribute S (node L)|AS] Prefix R :- !,
141152 parse-attributes.aux AS Prefix R1,
142153 append-string Prefix S PS,
0 commit comments