Revert "MPR#7643, ocamldep: fix nested structures blowup"revert-1377-ocamldep_nested_include_fix

3 files changed, 33 insertions, 32 deletions

diff --git a/.mailmap b/.mailmap
index ddef8bb838..772aac57ce 100644
--- a/.mailmap
+++ b/.mailmap
@@ -67,7 +67,6 @@ Stephen Dolan <stedolan>
 Junsong Li <lijunsong@mantis>
 Junsong Li <ljs.darkfish@gmail.com>
 Christophe Raffali <craff@mantis>
-Christophe Raffali <ChriChri@mantis>
 Anton Bachin <antron@mantis>
 Reed Wilson <omion>
 David Scott <djs55>
diff --git a/Changes b/Changes
index dd220e5d33..d289d9e779 100644
--- a/Changes
+++ b/Changes
@@ -344,10 +344,6 @@ Release branch for 4.06:
   and module type elements
   (Florian Angeletti, review by Yawar Amin and Gabriel Scherer)
 
-- MPR#7643, GPR#1377: ocamldep, fix an exponential blowup in presence of nested
-  structures and signatures (e.g. "include struct … include(struct … end) … end")
-  (Florian Angeletti, review by Gabriel Scherer, report by Christophe Raffalli)
-
 - GPR#681: Introduce ocamltest, a new test driver for the
   OCaml compiler testsuite
   (Sébastien Hinderer, review by Damien Doligez)
diff --git a/parsing/depend.ml b/parsing/depend.ml
index 9e872fbc40..e0851d7610 100644
--- a/parsing/depend.ml
+++ b/parsing/depend.ml
@@ -87,7 +87,7 @@ let add_parent bv lid =
 
 let add = add_parent
 
-let add_module_path bv lid = add_path bv lid.txt
+let addmodule bv lid = add_path bv lid.txt
 
 let handle_extension ext =
   match (fst ext).txt with
@@ -266,7 +266,7 @@ let rec add_expr bv exp =
   | Pexp_object { pcstr_self = pat; pcstr_fields = fieldl } ->
       let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
   | Pexp_newtype (_, e) -> add_expr bv e
-  | Pexp_pack m -> add_module_expr bv m
+  | Pexp_pack m -> add_module bv m
   | Pexp_open (_ovf, m, e) ->
       let bv = open_module bv m.txt in add_expr bv e
   | Pexp_extension (({ txt = ("ocaml.extension_constructor"|
@@ -296,7 +296,7 @@ and add_bindings recf bv pel =
 and add_modtype bv mty =
   match mty.pmty_desc with
     Pmty_ident l -> add bv l
-  | Pmty_alias l -> add_module_path bv l
+  | Pmty_alias l -> addmodule bv l
   | Pmty_signature s -> add_signature bv s
   | Pmty_functor(id, mty1, mty2) ->
       Misc.may (add_modtype bv) mty1;
@@ -306,26 +306,25 @@ and add_modtype bv mty =
       List.iter
         (function
           | Pwith_type (_, td) -> add_type_declaration bv td
-          | Pwith_module (_, lid) -> add_module_path bv lid
+          | Pwith_module (_, lid) -> addmodule bv lid
           | Pwith_typesubst (_, td) -> add_type_declaration bv td
-          | Pwith_modsubst (_, lid) -> add_module_path bv lid
+          | Pwith_modsubst (_, lid) -> addmodule bv lid
         )
         cstrl
-  | Pmty_typeof m -> add_module_expr bv m
+  | Pmty_typeof m -> add_module bv m
   | Pmty_extension e -> handle_extension e
 
 and add_module_alias bv l =
-  (* If we are in delayed dependencies mode, we delay the dependencies
-       induced by "Lident s" *)
-  (if !Clflags.transparent_modules then add_parent else add_module_path) bv l;
   try
+    add_parent bv l;
     lookup_map l.txt bv
   with Not_found ->
     match l.txt with
       Lident s -> make_leaf s
-    | _ -> add_module_path bv l; bound (* cannot delay *)
+    | _ -> addmodule bv l; bound (* cannot delay *)
 
 and add_modtype_binding bv mty =
+  if not !Clflags.transparent_modules then add_modtype bv mty;
   match mty.pmty_desc with
     Pmty_alias l ->
       add_module_alias bv l
@@ -334,7 +333,7 @@ and add_modtype_binding bv mty =
   | Pmty_typeof modl ->
       add_module_binding bv modl
   | _ ->
-      add_modtype bv mty; bound
+      if !Clflags.transparent_modules then add_modtype bv mty; bound
 
 and add_signature bv sg =
   ignore (add_signature_binding bv sg)
@@ -387,23 +386,33 @@ and add_sig_item (bv, m) item =
       (bv, m)
 
 and add_module_binding bv modl =
+  if not !Clflags.transparent_modules then add_module bv modl;
   match modl.pmod_desc with
-    Pmod_ident l -> add_module_alias bv l
+    Pmod_ident l ->
+      begin try
+        add_parent bv l;
+        lookup_map l.txt bv
+      with Not_found ->
+        match l.txt with
+          Lident s -> make_leaf s
+        | _ ->  addmodule bv l; bound
+      end
   | Pmod_structure s ->
-     make_node (snd @@ add_structure_binding bv s)
-  | _ -> add_module_expr bv modl; bound
+      make_node (snd (add_structure_binding bv s))
+  | _ ->
+      if !Clflags.transparent_modules then add_module bv modl; bound
 
-and add_module_expr bv modl =
+and add_module bv modl =
   match modl.pmod_desc with
-    Pmod_ident l -> add_module_path bv l
+    Pmod_ident l -> addmodule bv l
   | Pmod_structure s -> ignore (add_structure bv s)
   | Pmod_functor(id, mty, modl) ->
       Misc.may (add_modtype bv) mty;
-      add_module_expr (StringMap.add id.txt bound bv) modl
+      add_module (StringMap.add id.txt bound bv) modl
   | Pmod_apply(mod1, mod2) ->
-      add_module_expr bv mod1; add_module_expr bv mod2
+      add_module bv mod1; add_module bv mod2
   | Pmod_constraint(modl, mty) ->
-      add_module_expr bv modl; add_modtype bv mty
+      add_module bv modl; add_modtype bv mty
   | Pmod_unpack(e) ->
       add_expr bv e
   | Pmod_extension e ->
@@ -442,7 +451,7 @@ and add_struct_item (bv, m) item : _ StringMap.t * _ StringMap.t =
       in
       let bv' = add bv and m = add m in
       List.iter
-        (fun x -> add_module_expr bv' x.pmb_expr)
+        (fun x -> add_module bv' x.pmb_expr)
         bindings;
       (bv', m)
   | Pstr_modtype x ->
@@ -458,13 +467,8 @@ and add_struct_item (bv, m) item : _ StringMap.t * _ StringMap.t =
   | Pstr_class_type cdtl ->
       List.iter (add_class_type_declaration bv) cdtl; (bv, m)
   | Pstr_include incl ->
-      let Node (s, m') as n = add_module_binding bv incl.pincl_mod in
-      if !Clflags.transparent_modules then
-        add_names s
-      else
-        (* If we are not in the delayed dependency mode, we need to
-           collect all delayed dependencies imported by the include statement *)
-        add_names (collect_free n);
+      let Node (s, m') = add_module_binding bv incl.pincl_mod in
+      add_names s;
       let add = StringMap.fold StringMap.add m' in
       (add bv, add m)
   | Pstr_attribute _ -> (bv, m)
@@ -476,7 +480,9 @@ and add_use_file bv top_phrs =
   ignore (List.fold_left add_top_phrase bv top_phrs)
 
 and add_implementation bv l =
+  if !Clflags.transparent_modules then
     ignore (add_structure_binding bv l)
+  else ignore (add_structure bv l)
 
 and add_implementation_binding bv l =
   snd (add_structure_binding bv l)