add module alias support to ocamldep

1 files changed, 105 insertions, 35 deletions

diff --git a/tools/ocamldep.ml b/tools/ocamldep.ml
index 94fda41c0a..b14d5d1aa1 100644
--- a/tools/ocamldep.ml
+++ b/tools/ocamldep.ml
@@ -12,6 +12,7 @@
 
 open Compenv
 open Parsetree
+module StringMap = Depend.StringMap
 
 let ppf = Format.err_formatter
 (* Print the dependencies *)
@@ -29,6 +30,9 @@ let all_dependencies = ref false
 let one_line = ref false
 let files = ref []
 let allow_approximation = ref false
+let map_files = ref []
+let module_map = ref StringMap.empty
+let debug = ref false
 
 (* Fix path to use '/' as directory separator instead of '\'.
    Only under Windows. *)
@@ -40,7 +44,6 @@ let fix_slash s =
 
 (* Since we reinitialize load_path after reading OCAMLCOMP,
   we must use a cache instead of calling Sys.readdir too often. *)
-module StringMap = Map.Make(String)
 let dirs = ref StringMap.empty
 let readdir dir =
   try
@@ -105,6 +108,7 @@ let find_dependency target_kind modname (byt_deps, opt_deps) =
     let filename = find_file_in_list candidates in
     let basename = Filename.chop_extension filename in
     let cmi_file = basename ^ ".cmi" in
+    let cmx_file = basename ^ ".cmx" in
     let ml_exists =
       List.exists (fun ext -> Sys.file_exists (basename ^ ext)) !ml_synonyms in
     let new_opt_dep =
@@ -112,12 +116,12 @@ let find_dependency target_kind modname (byt_deps, opt_deps) =
         match target_kind with
         | MLI -> [ cmi_file ]
         | ML  ->
-          cmi_file :: (if ml_exists then [ basename ^ ".cmx"] else [])
+          cmi_file :: (if ml_exists then [ cmx_file ] else [])
       else
         (* this is a make-specific hack that makes .cmx to be a 'proxy'
            target that would force the dependency on .cmi via transitivity *)
         if ml_exists
-        then [ basename ^ ".cmx" ]
+        then [ cmx_file ]
         else [ cmi_file ]
     in
     ( cmi_file :: byt_deps, new_opt_dep @ opt_deps)
@@ -127,20 +131,22 @@ let find_dependency target_kind modname (byt_deps, opt_deps) =
     let candidates = List.map ((^) modname) !ml_synonyms in
     let filename = find_file_in_list candidates in
     let basename = Filename.chop_extension filename in
+    let cmi_file = basename ^ ".cmi" in
+    let cmx_file = basename ^ ".cmx" in
     let bytenames =
       if !all_dependencies then
         match target_kind with
-        | MLI -> [basename ^ ".cmi"]
-        | ML  -> [basename ^ ".cmi";]
+        | MLI -> [ cmi_file ]
+        | ML  -> [ cmi_file ]
       else
         (* again, make-specific hack *)
         [basename ^ (if !native_only then ".cmx" else ".cmo")] in
     let optnames =
       if !all_dependencies
       then match target_kind with
-        | MLI -> [basename ^ ".cmi"]
-        | ML  -> [basename ^ ".cmi"; basename ^ ".cmx"]
-      else [ basename ^ ".cmx" ]
+        | MLI -> [ cmi_file ]
+        | ML  -> [ cmi_file; cmx_file ]
+      else [ cmx_file ]
     in
     (bytenames @ byt_deps, optnames @  opt_deps)
   with Not_found ->
@@ -269,7 +275,8 @@ let read_and_approximate inputfile =
     report_err exn;
     !Depend.free_structure_names
 
-let read_parse_and_extract parse_function extract_function magic source_file =
+let read_parse_and_extract parse_function extract_function def magic
+    source_file =
   Depend.free_structure_names := Depend.StringSet.empty;
   try
     let input_file = Pparse.preprocess source_file in
@@ -278,13 +285,15 @@ let read_parse_and_extract parse_function extract_function magic source_file =
         Pparse.file ~tool_name Format.err_formatter
                     input_file parse_function magic
       in
-      let bound_vars = Depend.StringSet.empty in
-      List.iter (fun modname ->
-        Depend.open_module bound_vars (Longident.Lident modname)
-      ) !Clflags.open_modules;
-      extract_function bound_vars ast;
+      let bound_vars =
+        List.fold_left
+          (fun bv modname ->
+            Depend.open_module bv (Longident.Lident modname))
+          !module_map !Clflags.open_modules
+      in
+      let r = extract_function bound_vars ast in
       Pparse.remove_preprocessed input_file;
-      !Depend.free_structure_names
+      (!Depend.free_structure_names, r)
     with x ->
       Pparse.remove_preprocessed input_file;
       raise x
@@ -292,8 +301,8 @@ let read_parse_and_extract parse_function extract_function magic source_file =
   with x -> begin
     report_err x;
     if not !allow_approximation
-    then Depend.StringSet.empty
-    else read_and_approximate source_file
+    then (Depend.StringSet.empty, def)
+    else (read_and_approximate source_file, def)
   end
 
 let ml_file_dependencies source_file =
@@ -305,8 +314,8 @@ let ml_file_dependencies source_file =
     in
     List.flatten (List.map f (Parse.use_file lexbuf))
   in
-  let extracted_deps =
-    read_parse_and_extract parse_use_file_as_impl Depend.add_implementation
+  let (extracted_deps, ()) =
+    read_parse_and_extract parse_use_file_as_impl Depend.add_implementation ()
                            Config.ast_impl_magic_number source_file
   in
   if !sort_files then
@@ -333,13 +342,14 @@ let ml_file_dependencies source_file =
       let (byt_deps, native_deps) =
         Depend.StringSet.fold (find_dependency ML)
           extracted_deps init_deps in
-      print_dependencies (byte_targets @ extra_targets) byt_deps;
+      if not !native_only then
+        print_dependencies (byte_targets @ extra_targets) byt_deps;
       print_dependencies (native_targets @ extra_targets) native_deps;
     end
 
 let mli_file_dependencies source_file =
-  let extracted_deps =
-    read_parse_and_extract Parse.interface Depend.add_signature
+  let (extracted_deps, ()) =
+    read_parse_and_extract Parse.interface Depend.add_signature ()
                            Config.ast_intf_magic_number source_file
   in
   if !sort_files then
@@ -355,7 +365,7 @@ let mli_file_dependencies source_file =
       print_dependencies [basename ^ ".cmi"] byt_deps
     end
 
-let file_dependencies_as kind source_file =
+let process_file_as process_fun def source_file =
   Compenv.readenv ppf Before_compile;
   load_path := [];
   List.iter add_to_load_path (
@@ -365,19 +375,25 @@ let file_dependencies_as kind source_file =
       ));
   Location.input_name := source_file;
   try
-    if Sys.file_exists source_file then begin
-      match kind with
-      | ML -> ml_file_dependencies source_file
-      | MLI -> mli_file_dependencies source_file
-    end
-  with x -> report_err x
+    if Sys.file_exists source_file then process_fun source_file else def
+  with x -> report_err x; def
 
-let file_dependencies source_file =
+let process_file source_file ~ml_file ~mli_file ~def =
   if List.exists (Filename.check_suffix source_file) !ml_synonyms then
-    file_dependencies_as ML source_file
+    process_file_as ml_file def source_file
   else if List.exists (Filename.check_suffix source_file) !mli_synonyms then
-    file_dependencies_as MLI source_file
-  else ()
+    process_file_as mli_file def source_file
+  else def
+
+let file_dependencies source_file =
+  process_file source_file ~def:()
+    ~ml_file:ml_file_dependencies
+    ~mli_file:mli_file_dependencies
+
+let file_dependencies_as kind =
+  match kind with
+  | ML -> process_file_as mli_file_dependencies ()
+  | MLI -> process_file_as mli_file_dependencies ()
 
 let sort_files_by_dependencies files =
   let h = Hashtbl.create 31 in
@@ -457,6 +473,53 @@ let sort_files_by_dependencies files =
   Printf.printf "\n%!";
   ()
 
+(* Map *)
+
+let rec dump_map s0 ppf m =
+  let open Depend in
+  StringMap.iter
+    (fun key (Node(s1,m')) ->
+      let s = StringSet.diff s1 s0 in
+      if StringSet.is_empty s then
+        Format.fprintf ppf "@ @[<hv2>module %s : sig%a@;<1 -2>end@]"
+          key (dump_map (StringSet.union s1 s0)) m'
+      else
+        Format.fprintf ppf "@ module %s = %s" key (StringSet.choose s))
+    m
+
+let process_ml_map =
+  read_parse_and_extract Parse.implementation Depend.add_implementation_binding
+                         StringMap.empty Config.ast_impl_magic_number
+
+let process_mli_map =
+  read_parse_and_extract Parse.interface Depend.add_signature_binding
+                         StringMap.empty Config.ast_intf_magic_number
+
+let parse_map fname =
+  map_files := fname :: !map_files ;
+  let old_transp = !Clflags.transparent_modules in
+  Clflags.transparent_modules := true;
+  let (deps, m) =
+    process_file fname ~def:(Depend.StringSet.empty, StringMap.empty)
+      ~ml_file:process_ml_map
+      ~mli_file:process_mli_map
+  in
+  Clflags.transparent_modules := old_transp;
+  let modname =
+    String.capitalize_ascii
+      (Filename.basename (Filename.chop_extension fname)) in
+  if StringMap.is_empty m then
+    report_err (Failure (fname ^ " : empty map file or parse error"));
+  let mm = Depend.make_node m in
+  if !debug then begin
+    Format.printf "@[<v>%s:%t%a@]@." fname
+      (fun ppf -> Depend.StringSet.iter (Format.fprintf ppf " %s") deps)
+      (dump_map deps) (StringMap.add modname mm StringMap.empty)
+  end;
+  let mm = Depend.(weaken_map (StringSet.singleton modname) mm) in
+  module_map := StringMap.add modname mm !module_map
+;;
+
 
 (* Entry point *)
 
@@ -481,14 +544,21 @@ let _ =
         " Show absolute filenames in error messages";
      "-all", Arg.Set all_dependencies,
         " Generate dependencies on all files";
+     "-allow-approx", Arg.Set allow_approximation,
+        " Fallback to a lexer-based approximation on unparseable files";
+     "-as-map", Arg.Set Clflags.transparent_modules,
+      " Omit delayed dependencies for module aliases (-no-alias-deps -w -49)";
+      (* "compiler uses -no-alias-deps, and no module is coerced"; *)
+     "-debug-map", Arg.Set debug,
+        " Dump the delayed dependency map for each map file";
      "-I", Arg.String (add_to_list Clflags.include_dirs),
         "<dir>  Add <dir> to the list of include directories";
      "-impl", Arg.String (file_dependencies_as ML),
         "<f>  Process <f> as a .ml file";
      "-intf", Arg.String (file_dependencies_as MLI),
         "<f>  Process <f> as a .mli file";
-     "-allow-approx", Arg.Set allow_approximation,
-        " Fallback to a lexer-based approximation on unparseable files.";
+     "-map", Arg.String parse_map,
+        "<f>  Read <f> and propagate delayed dependencies to following files";
      "-ml-synonym", Arg.String(add_to_synonym_list ml_synonyms),
         "<e>  Consider <e> as a synonym of the .ml extension";
      "-mli-synonym", Arg.String(add_to_synonym_list mli_synonyms),