[compiler] allow customized duplicate label checking

Author: bobzhang

parsing/builtin_attributes.ml

@@ -110,6 +110,10 @@ let check_bs_attributes_inclusion =
       None
     )  
 
+let check_duplicated_labels = ref (fun _lbls -> 
+  failwith "check_duplicated_label not implemented"
+)
+
 let rec deprecated_of_sig = function
   | {psig_desc = Psig_attribute a} :: tl ->
       begin match deprecated_of_attrs [a] with

parsing/builtin_attributes.mli

@@ -46,6 +46,10 @@ val check_bs_attributes_inclusion:
   (Parsetree.attributes ->
   Parsetree.attributes -> string -> (string*string) option ) ref
 
+val check_duplicated_labels: 
+  (Parsetree.label_declaration list ->
+    string Asttypes.loc option
+  ) ref    
 val error_of_extension: Parsetree.extension -> Location.error
 
 val warning_attribute: ?ppwarning:bool -> Parsetree.attribute -> unit

typing/typedecl.ml

@@ -222,13 +222,18 @@ let make_params env params =
 
 let transl_labels env closed lbls =
   assert (lbls <> []);
+  if !Clflags.bs_only then 
+    match !Builtin_attributes.check_duplicated_labels lbls with 
+    | None -> ()
+    | Some {loc;txt=name} -> raise (Error(loc,Duplicate_label name))
+  else (
   let all_labels = ref StringSet.empty in
   List.iter
     (fun {pld_name = {txt=name; loc}} ->
        if StringSet.mem name !all_labels then
          raise(Error(loc, Duplicate_label name));
        all_labels := StringSet.add name !all_labels)
-    lbls;
+    lbls);
   let mk {pld_name=name;pld_mutable=mut;pld_type=arg;pld_loc=loc;
           pld_attributes=attrs} =
     Builtin_attributes.warning_scope attrs