2424
2525type label = Types .label_description
2626
27- let fn = (fun (attr : Parsetree.attribute ) ->
28- match attr with
29- | {txt = "bs.as" } , PStr
30- [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (s,_))},_ )}] ->
31- (* Bs_ast_invariant.mark_used_bs_attribute attr; *)
27+ let find_name (attr : Parsetree.attribute ) =
28+ match attr with
29+ | {txt = " bs.as" }, PStr
30+ [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (s,_))},_ )}] ->
3231 Some s
33- | _ -> None
34- )
32+ | _ -> None
33+
34+
35+ let find_name_with_loc (attr : Parsetree.attribute ) :
36+ string Asttypes. loc option =
37+ match attr with
38+ | {txt = " bs.as" ;loc}, PStr
39+ [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (s,_))},_ )}] ->
40+ Some {txt = s; loc}
41+ | _ -> None
42+
3543
3644let fld_record (lbl : label ) =
3745 Lambda. Fld_record
38- {name = Ext_list. find_def lbl.lbl_attributes fn lbl.lbl_name; mutable_flag = lbl.Types. lbl_mut}
46+ {name = Ext_list. find_def lbl.lbl_attributes find_name lbl.lbl_name; mutable_flag = lbl.Types. lbl_mut}
3947
4048let fld_record_set (lbl : label ) =
4149 Lambda. Fld_record_set
42- (Ext_list. find_def lbl.lbl_attributes fn lbl.lbl_name)
50+ (Ext_list. find_def lbl.lbl_attributes find_name lbl.lbl_name)
4351
4452let blk_record fields =
4553 let all_labels_info =
4654 Ext_array. map fields
4755 (fun ((lbl : label ),_ ) ->
48- Ext_list. find_def lbl.Types. lbl_attributes fn lbl.lbl_name) in
56+ Ext_list. find_def lbl.Types. lbl_attributes find_name lbl.lbl_name) in
4957 Lambda. Blk_record all_labels_info
5058
5159let check_bs_attributes_inclusion
5260 (attrs1 : Parsetree.attributes )
5361 (attrs2 : Parsetree.attributes )
5462 lbl_name =
55- let a = Ext_list. find_def attrs1 fn lbl_name in
56- let b = Ext_list. find_def attrs2 fn lbl_name in
63+ let a = Ext_list. find_def attrs1 find_name lbl_name in
64+ let b = Ext_list. find_def attrs2 find_name lbl_name in
5765 if a = b then None
5866 else Some (a,b)
5967
68+ let rec check_duplicated_labels_aux
69+ (lbls : Parsetree.label_declaration list )
70+ (coll : String_set.t ) =
71+ match lbls with
72+ | [] -> None
73+ | {pld_name = ({txt} as pld_name ); pld_attributes} ::rest ->
74+ if String_set. mem coll txt then Some pld_name
75+ else
76+ let coll = String_set. add coll txt in
77+ match Ext_list. find_opt pld_attributes find_name_with_loc with
78+ | None -> check_duplicated_labels_aux rest coll
79+ | Some ({txt = s ;} as l ) ->
80+ if String_set. mem coll s then
81+ Some l
82+ else
83+ check_duplicated_labels_aux rest (String_set. add coll s)
6084
61-
85+ let check_duplicated_labels lbls =
86+ check_duplicated_labels_aux lbls String_set. empty
0 commit comments