1. camlspotter
  2. mutated_ocaml

Commits

camlspotter  committed 66eb6d0

redundant open location is reported

  • Participants
  • Parent commits efe7f18
  • Branches redundant_open

Comments (0)

Files changed (5)

File typing/env.ml

View file
  • Ignore whitespace
 (* Lookup by name *)
 
 let modules_opened_but_not_used_yet = Hashtbl.create 103
+
 (* CR jfuruse: not sure about the place. debugger/Makefile.shared required additional modules for this *)
 let check_modules_opened_but_not_used_yet () =
-  Hashtbl.iter (fun k _ ->
-    match k with
-    | Pident id when Ident.name id = "Pervasives" -> () (* CR jfuruse: this is bogus *)
+  let loc_paths = 
+    List.sort (fun (l1, _) (l2, _) -> compare l1 l2)
+      (Hashtbl.fold (fun k locs st -> List.map (fun loc -> loc, k) locs @ st) modules_opened_but_not_used_yet [])
+  in
+  Hashtbl.clear modules_opened_but_not_used_yet;
+  List.iter (fun (loc, path) ->
+    match path with
+    | Pident id when Ident.name id = "Pervasives" -> () (* CR jfuruse: this is not precise *)
     | _ -> 
-        Location.prerr_warning Location.none (Warnings.Opened_module_is_never_used (Path.name k))) 
-    modules_opened_but_not_used_yet;
-  Hashtbl.clear modules_opened_but_not_used_yet
+        Location.prerr_warning loc (Warnings.Opened_module_is_never_used (Path.name path)))
+    loc_paths
+
+let add_opened_module loc p =
+  let locs = loc :: try Hashtbl.find modules_opened_but_not_used_yet p with Not_found -> [] in
+  Hashtbl.replace modules_opened_but_not_used_yet p locs
 
 let mark_opened_module (v, open_info) =
   begin match open_info with
 
 (* Open a signature path *)
 
-let open_signature root sg env =
+let open_signature loc root sg env =
   (* Format.eprintf "%a %s@." format_longident lid (Path.unique_name p); *)
   (* jfuruse Format.eprintf "open %s@." (Path.unique_name root); *)
-  Hashtbl.replace modules_opened_but_not_used_yet root ();
+  add_opened_module loc root;
 
   (* First build the paths and substitution *)
   let (pl, sub) = prefix_idents root 0 Subst.identity sg in
 
 let open_pers_signature name env =
   let ps = find_pers_struct name in
-  open_signature (Pident(Ident.create_persistent name)) ps.ps_sig env
+  open_signature Location.none (Pident(Ident.create_persistent name)) ps.ps_sig env
 
 (* Read a signature from a file *)
 

File typing/env.mli

View file
  • Ignore whitespace
 (* Insertion of all fields of a signature, relative to the given path.
    Used to implement open. *)
 
-val open_signature: Path.t -> signature -> t -> t
+val open_signature: Location.t -> Path.t -> signature -> t -> t
 val open_pers_signature: string -> t -> t
 
 (* Insertion by name *)

File typing/typecore.ml

View file
  • Ignore whitespace
   | Pexp_open (lid, e) ->
       (* workaround to get better location *)
       let loc = Spot.Location_bound.upperbound loc e.pexp_loc in
-      let _path, env = !type_open env loc lid in
-      type_exp env e
+      type_exp (!type_open env loc lid) e
 
 and type_label_exp create env loc ty (lid, sarg) =
   let label = Typetexp.find_label env sarg.pexp_loc lid in

File typing/typecore.mli

View file
  • Ignore whitespace
 (* Forward declaration, to be filled in by Typemod.type_module *)
 val type_module: (Env.t -> Parsetree.module_expr -> Typedtree.module_expr) ref
 (* Forward declaration, to be filled in by Typemod.type_open *)
-val type_open: (Env.t -> Location.t -> Longident.t -> Path.t * Env.t) ref
+val type_open: (Env.t -> Location.t -> Longident.t -> Env.t) ref
 (* Forward declaration, to be filled in by Typeclass.class_structure *)
 val type_object:
   (Env.t -> Location.t -> Parsetree.class_structure ->

File typing/typemod.ml

View file
  • Ignore whitespace
   let (path, mty) = Typetexp.find_module env loc lid in
   Spot.Annot.record loc (Spot.Annot.Use (Spot.Kind.Module, path));
   let sg = extract_sig_open env loc mty in
-  path, Env.open_signature path sg env
+  Env.open_signature loc path sg env
 
 (* Record a module type *)
 let rm node =
           let (id, newenv) = Env.enter_modtype name info env in
           Tsig_modtype(id, info) :: approx_sig newenv srem
       | Psig_open lid ->
-          let _path, env = type_open env item.psig_loc lid in
-          approx_sig env srem
+          approx_sig (type_open env item.psig_loc lid ) srem
       | Psig_include smty ->
           let mty = approx_modtype env smty in
           let sg = Subst.signature Subst.identity
             let rem = transl_sig newenv srem in
             Tsig_modtype(id, info) :: rem
         | Psig_open lid ->
-            let _path, env = type_open env item.psig_loc lid in
-            transl_sig env srem
+            transl_sig (type_open env item.psig_loc lid ) srem
         | Psig_include smty ->
             let mty = transl_modtype env smty in
             let sg = Subst.signature Subst.identity
          Tsig_modtype(id, Tmodtype_manifest mty) :: sig_rem,
          final_env)
     | {pstr_desc = Pstr_open lid; pstr_loc = loc} :: srem ->
-        let _path, env = type_open env loc lid in
-        type_struct env srem
+        type_struct (type_open env loc lid) srem
     | {pstr_desc = Pstr_class cl; pstr_loc = loc} :: srem ->
          List.iter
            (fun {pci_name = name} -> check "type" loc type_names name)