Record toplevel attributes in cms files

ocaml/driver/compile_common.ml

@@ -63,7 +63,7 @@ let typecheck_intf info ast =
   Profile.(record_call typing) @@ fun () ->
   let tsg =
     ast
-    |> Typemod.type_interface info.module_name info.env
+    |> Typemod.type_interface info.source_file info.module_name info.env
     |> print_if info.ppf_dump Clflags.dump_typedtree Printtyped.interface
   in
   let sg = tsg.Typedtree.sig_type in

ocaml/ocamldoc/odoc_analyse.ml

@@ -122,7 +122,7 @@ let process_interface_file sourcefile =
     Pparse.file ~tool_name inputfile
       (no_docstring Parse.interface) Pparse.Signature
   in
-  let sg = Typemod.type_interface compilation_unit (initial_env()) ast in
+  let sg = Typemod.type_interface sourcefile compilation_unit (initial_env()) ast in
   Warnings.check_fatal ();
   (ast, sg, inputfile)
 

ocaml/typing/typemod.ml

@@ -3307,6 +3307,22 @@ let gen_annot outputprefix sourcefile annots =
   Cmt2annot.gen_annot (Some (outputprefix ^ ".annot"))
     ~sourcefile:(Some sourcefile) ~use_summaries:false annots
 
+let cms_register_toplevel_struct_attributes ~sourcefile ~uid ast =
+  (* Cms files do not store the typetree. Toplevels attributes are
+    as they are not explicitely associated with a uid so we need
+    to manually register them. *)
+  let attributes =
+    List.filter_map
+      (function
+        | { pstr_desc = Pstr_attribute attr; _ } -> Some attr
+        | _ -> None
+      )
+      ast
+  in
+  Env.register_uid uid
+    ~loc:(Location.in_file sourcefile)
+    ~attributes
+
 let type_implementation sourcefile outputprefix modulename initial_env ast =
   let error e =
     raise (Error (Location.in_file sourcefile, initial_env, e))
@@ -3322,10 +3338,10 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
       let (str, sg, names, shape, finalenv) =
         Profile.record_call "infer" (fun () ->
           type_structure initial_env ast) in
-      let shape =
-        Shape.set_uid_if_none shape
-          (Uid.of_compilation_unit_id modulename)
-      in
+      let uid = Uid.of_compilation_unit_id modulename in
+      let shape = Shape.set_uid_if_none shape uid in
+      if !Clflags.binary_annotations_cms then
+        cms_register_toplevel_struct_attributes ~sourcefile ~uid ast;
       let simple_sg = Signature_names.simplify finalenv names sg in
       if !Clflags.print_types then begin
         remove_mode_and_jkind_variables finalenv sg;
@@ -3447,10 +3463,30 @@ let save_signature modname tsg outputprefix source_file initial_env cmi =
   Cms_format.save_cms  (outputprefix ^ ".cmsi") modname
     (Some source_file) None
 
-let type_interface modulename env ast =
+let cms_register_toplevel_signature_attributes ~sourcefile ~uid ast =
+  (* Cms files do not store the typetree. Toplevels attributes are
+    as they are not explicitely associated with a uid so we need
+    to manually register them. *)
+  let attributes =
+    List.filter_map
+      (function
+        | { psig_desc = Psig_attribute attr; _ } -> Some attr
+        | _ -> None
+      )
+      ast
+  in
+  Env.register_uid uid
+    ~loc:(Location.in_file sourcefile)
+    ~attributes
+
+let type_interface sourcefile modulename env ast =
   if !Clflags.as_parameter && Compilation_unit.is_packed modulename then begin
     raise(Error(Location.none, Env.empty, Cannot_pack_parameter))
   end;
+  if !Clflags.binary_annotations_cms then begin
+    let uid = Shape.Uid.of_compilation_unit_id modulename in
+    cms_register_toplevel_signature_attributes ~uid ~sourcefile ast
+  end;
   transl_signature env ast
 
 (* "Packaging" of several compilation units into one unit

ocaml/typing/typemod.mli

@@ -42,7 +42,7 @@ val type_implementation:
   string -> string -> Compilation_unit.t -> Env.t ->
   Parsetree.structure -> Typedtree.implementation
 val type_interface:
-        Compilation_unit.t -> Env.t -> Parsetree.signature -> Typedtree.signature
+  string -> Compilation_unit.t -> Env.t -> Parsetree.signature -> Typedtree.signature
 val transl_signature:
         Env.t -> Parsetree.signature -> Typedtree.signature
 val check_nongen_signature: