Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add module alias support to ocamldep

master
Jacques Garrigue 2015-12-01 00:07:36 +09:00
parent 9a09b322a5
commit 381328e92e
20 changed files with 507 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Changes
View File

@ -230,6 +230,10 @@ OCamlbuild:
- PR#6605, GPR#117: use ocamlfind, if available, to discover camlp4 path
(Vincent Laporte)
OCamldep:
- GRP#286: add support for module aliases
(jacques Garrigue)
Manual:
- GPR#302: The OCaml reference manual is now included in the manual/
subdirectory of the main OCaml source repository. Contributions to

5
ocamldoc/odoc_dep.ml
View File

@ -13,6 +13,7 @@
(** Top modules dependencies. *)
module StrS = Depend.StringSet
module StrM = Depend.StringMap
module Module = Odoc_module
module Type = Odoc_type
@ -23,12 +24,12 @@ let set_to_list s =
let impl_dependencies ast =
Depend.free_structure_names := StrS.empty;
Depend.add_use_file StrS.empty [Parsetree.Ptop_def ast];
Depend.add_use_file StrM.empty [Parsetree.Ptop_def ast];
set_to_list !Depend.free_structure_names
let intf_dependencies ast =
Depend.free_structure_names := StrS.empty;
Depend.add_signature StrS.empty ast;
Depend.add_signature StrM.empty ast;
set_to_list !Depend.free_structure_names

1
testsuite/tests/tool-ocamldep-modalias/A.ml Normal file
View File

@ -0,0 +1 @@
let f x = x +1

2
testsuite/tests/tool-ocamldep-modalias/B.ml Normal file
View File

@ -0,0 +1,2 @@
open Packed
let g = A.f

2
testsuite/tests/tool-ocamldep-modalias/C.ml Normal file
View File

@ -0,0 +1,2 @@
open Lib
let h x = A.f x + B.g x

1
testsuite/tests/tool-ocamldep-modalias/D.ml Normal file
View File

@ -0,0 +1 @@
let z x = imp (x*2)

73
testsuite/tests/tool-ocamldep-modalias/Makefile Normal file
View File

@ -0,0 +1,73 @@
# Test for ocamldep and -no-alias-deps
# There are two versions:
# Makefile.build uses -no-alias-deps only for lib.ml/mli
# Makefile.build2 has no lib.ml, and uses -no-alias-deps for components too
OCAMLDEP=$(OCAMLRUN) $(OTOPDIR)/tools/ocamldep
SOURCES = A.ml B.ml C.ml D.ml
LINKS = $(SOURCES:%=Lib%)
DEPENDS = depend.mk depend.mk2 depend.mod depend.mod2 depend.mod3
all: clean
@$(MAKE) build > /dev/null
@$(MAKE) $(DEPENDS) > /dev/null
@$(MAKE) compare
build: depend.mk depend.mk2
rm -f $(LINKS)
if $(NATIVECODE_ONLY); then : ; else \
$(MAKE) -f Makefile.build byte; \
rm -f *.cm* lib.ml; \
$(MAKE) -f Makefile.build2 byte; fi
if $(BYTECODE_ONLY); then :; else \
$(MAKE) -f Makefile.build opt; \
rm -f *.cm* lib.ml; \
$(MAKE) -f Makefile.build2 opt; fi
# Create links for prefixed versions of the components
Lib%.ml: %.ml
ln -s $< $@
# Dependencies for Makefile.build, compiling and linking lib.cmo
depend.mk: $(LINKS)
ln -s lib_impl.ml lib.ml
$(OCAMLDEP) -as-map lib.ml lib.mli > $@
$(OCAMLDEP) -map lib.ml -open Lib $(LINKS) >> $@
# Dependencies for Makefile.build2, not compiling lib.cmo
depend.mk2: $(LINKS)
rm -f lib.ml
$(OCAMLDEP) -map lib.mli -open Lib \
$(LINKS) > $@
# Others tests for ocamldep
depend.mod: $(LINKS)
ln -s lib_impl.ml lib.ml
$(OCAMLDEP) -as-map -modules lib.ml lib.mli > $@
$(OCAMLDEP) -modules -map lib.ml -open Lib $(LINKS) >> $@
depend.mod2: $(LINKS)
rm -f lib.ml
$(OCAMLDEP) -modules -map lib.mli $(LINKS) > $@
depend.mod3: $(LINKS)
rm -f lib.ml
$(OCAMLDEP) -modules -as-map -map lib.mli -open Lib \
$(LINKS) > $@
promote:
for i in $(DEPENDS); do cp $$i $$i.reference; done
compare: $(DEPENDS)
@rm -f $(LINKS) lib.ml
@for i in $(DEPENDS); do \
printf " ... testing '$$i':"; \
$(DIFF) $$i.reference $$i > /dev/null \
&& echo " => passed" || echo " => failed"; \
done
clean:
@rm -f *.cm* *.o *.a $(DEPENDS) $(LINKS) lib.ml *~ *.byt* *.opt*
BASEDIR=../..
include $(BASEDIR)/makefiles/Makefile.common

43
testsuite/tests/tool-ocamldep-modalias/Makefile.build Normal file
View File

@ -0,0 +1,43 @@
# Makefile using -no-alias-deps only for lib.ml/mli
SOURCES = A.ml B.ml C.ml D.ml
OBJECTS = lib.cmo $(SOURCES:%.ml=Lib%.cmo)
NOBJECTS = $(OBJECTS:%.cmo=%.cmx)
byte: main.byt
opt: main.opt
main.byt: lib.cma main.cmo
$(OCAMLC) lib.cma main.cmo -o $@
lib.ml: lib_impl.ml
ln -s $< $@
lib.cma: $(OBJECTS)
$(OCAMLC) -a -o $@ $(OBJECTS)
lib.cmi: lib.mli
$(OCAMLC) -c -no-alias-deps -w -49 $<
lib.cmo: lib.ml
$(OCAMLC) -c -no-alias-deps -w -49 $<
Lib%.cmo: %.ml
$(OCAMLC) -c -open Lib -o $@ $<
main.opt: lib.cmxa main.cmx
$(OCAMLOPT) lib.cmxa main.cmx -o $@
lib.cmxa: $(NOBJECTS)
$(OCAMLOPT) -a -o $@ $(NOBJECTS)
lib.cmx: lib.ml
$(OCAMLOPT) -c -no-alias-deps -w -49 $<
Lib%.cmx: %.ml
$(OCAMLOPT) -c -open Lib -o $@ $<
include depend.mk
BASEDIR=../..
include $(BASEDIR)/makefiles/Makefile.common

38
testsuite/tests/tool-ocamldep-modalias/Makefile.build2 Normal file
View File

@ -0,0 +1,38 @@
# Makefile using -no-alias-deps for all files, no need to link lib.cmo
SOURCES = A.ml B.ml C.ml
OBJECTS = $(SOURCES:%.ml=Lib%.cmo)
NOBJECTS = $(OBJECTS:%.cmo=%.cmx)
byte: main.byt2
opt: main.opt2
main.byt2: lib2.cma main.cmo
$(OCAMLC) lib2.cma main.cmo -o $@
lib2.cma: $(OBJECTS)
$(OCAMLC) -a -o $@ $(OBJECTS)
lib.cmi: lib.mli
$(OCAMLC) -c -w -49 $<
Lib%.cmo: %.ml
$(OCAMLC) -c -open Lib -o $@ $<
main.opt2: lib.cmxa main.cmx
$(OCAMLOPT) lib.cmxa main.cmx -o $@
lib.cmxa: $(NOBJECTS)
$(OCAMLOPT) -a -o $@ $(NOBJECTS)
lib.cmx: lib.ml
$(OCAMLOPT) -c -no-alias-deps -w -49 $<
Lib%.cmx: %.ml
$(OCAMLOPT) -c -open Lib -o $@ $<
include depend.mk2
BASEDIR=../..
include $(BASEDIR)/makefiles/Makefile.common
COMPFLAGS = -no-alias-deps # Used by $(OCAMLC)

11
testsuite/tests/tool-ocamldep-modalias/depend.mk.reference Normal file
View File

@ -0,0 +1,11 @@
lib.cmo : lib.cmi
lib.cmx : lib.cmi
lib.cmi :
LibA.cmo : lib.cmi
LibA.cmx : lib.cmx
LibB.cmo : LibA.cmo lib.cmi
LibB.cmx : LibA.cmx lib.cmx
LibC.cmo : LibB.cmo LibA.cmo lib.cmi
LibC.cmx : LibB.cmx LibA.cmx lib.cmx
LibD.cmo : lib.cmi
LibD.cmx : lib.cmx

8
testsuite/tests/tool-ocamldep-modalias/depend.mk2.reference Normal file
View File

@ -0,0 +1,8 @@
LibA.cmo : lib.cmi
LibA.cmx : lib.cmi
LibB.cmo : LibA.cmo lib.cmi
LibB.cmx : LibA.cmx lib.cmi
LibC.cmo : LibB.cmo LibA.cmo lib.cmi
LibC.cmx : LibB.cmx LibA.cmx lib.cmi
LibD.cmo : lib.cmi
LibD.cmx : lib.cmi

6
testsuite/tests/tool-ocamldep-modalias/depend.mod.reference Normal file
View File

@ -0,0 +1,6 @@
lib.ml:
lib.mli:
LibA.ml: Lib
LibB.ml: Lib LibA
LibC.ml: Lib LibA LibB
LibD.ml: Lib

4
testsuite/tests/tool-ocamldep-modalias/depend.mod2.reference Normal file
View File

@ -0,0 +1,4 @@
LibA.ml:
LibB.ml: A Packed
LibC.ml: Lib LibA LibB
LibD.ml:

4
testsuite/tests/tool-ocamldep-modalias/depend.mod3.reference Normal file
View File

@ -0,0 +1,4 @@
LibA.ml: Lib
LibB.ml: Lib LibA
LibC.ml: Lib LibA LibB
LibD.ml: Lib

8
testsuite/tests/tool-ocamldep-modalias/lib.mli Normal file
View File

@ -0,0 +1,8 @@
module Packed : sig
module A = LibA
module B = LibB
module C = LibC
end
include (module type of struct include Packed end)
val imp : int -> int

8
testsuite/tests/tool-ocamldep-modalias/lib_impl.ml Normal file
View File

@ -0,0 +1,8 @@
module Packed = struct
module A = LibA
module B = LibB
module C = LibC
end
include Packed
let imp x = x+1

3
testsuite/tests/tool-ocamldep-modalias/main.ml Normal file
View File

@ -0,0 +1,3 @@
open Lib
let () = Printf.printf "B.g 3 = %d\n%!" (B.g 3)

224
tools/depend.ml
View File

@ -16,25 +16,72 @@ open Longident
open Parsetree
module StringSet = Set.Make(struct type t = string let compare = compare end)
module StringMap = Map.Make(String)
(* Module resolution map *)
(* Node (set of imports for this path, map for submodules) *)
type map_tree = Node of StringSet.t * bound_map
and bound_map = map_tree StringMap.t
let bound = Node (StringSet.empty, StringMap.empty)
(*let get_free (Node (s, _m)) = s*)
let get_map (Node (_s, m)) = m
let make_leaf s = Node (StringSet.singleton s, StringMap.empty)
let make_node m = Node (StringSet.empty, m)
let rec weaken_map s (Node(s0,m0)) =
Node (StringSet.union s s0, StringMap.map (weaken_map s) m0)
let rec collect_free (Node (s, m)) =
StringMap.fold (fun _ n -> StringSet.union (collect_free n)) m s
(* Returns the imports required to access the structure at path p *)
(* Only raises Not_found if the head of p is not in the toplevel map *)
let rec lookup_free p m =
match p with
[] -> raise Not_found
| s::p ->
let Node (f, m') = StringMap.find s m in
try lookup_free p m' with Not_found -> f
(* Returns the node corresponding to the structure at path p *)
let rec lookup_map lid m =
match lid with
Lident s -> StringMap.find s m
| Ldot (l, s) -> StringMap.find s (get_map (lookup_map l m))
| Lapply _ -> raise Not_found
(* Collect free module identifiers in the a.s.t. *)
let free_structure_names = ref StringSet.empty
let rec add_path bv = function
let add_names s =
free_structure_names := StringSet.union s !free_structure_names
let rec add_path bv ?(p=[]) = function
| Lident s ->
if not (StringSet.mem s bv)
then free_structure_names := StringSet.add s !free_structure_names
| Ldot(l, _s) -> add_path bv l
let free =
try lookup_free (s::p) bv with Not_found -> StringSet.singleton s
in
(*StringSet.iter (fun s -> Printf.eprintf "%s " s) free;
prerr_endline "";*)
add_names free
| Ldot(l, s) -> add_path bv ~p:(s::p) l
| Lapply(l1, l2) -> add_path bv l1; add_path bv l2
let open_module bv lid = add_path bv lid
let open_module bv lid =
match lookup_map lid bv with
| Node (s, m) ->
add_names s;
StringMap.fold StringMap.add m bv
| exception Not_found ->
add_path bv lid; bv
let add bv lid =
let add_parent bv lid =
match lid.txt with
Ldot(l, _s) -> add_path bv l
| _ -> ()
let add = add_parent
let addmodule bv lid = add_path bv lid.txt
let rec add_type bv ty =
@ -122,7 +169,7 @@ let add_class_description bv infos =
let add_class_type_declaration = add_class_description
let pattern_bv = ref StringSet.empty
let pattern_bv = ref StringMap.empty
let rec add_pattern bv pat =
match pat.ppat_desc with
@ -141,7 +188,7 @@ let rec add_pattern bv pat =
| Ppat_variant(_, op) -> add_opt add_pattern bv op
| Ppat_type li -> add bv li
| Ppat_lazy p -> add_pattern bv p
| Ppat_unpack id -> pattern_bv := StringSet.add id.txt !pattern_bv
| Ppat_unpack id -> pattern_bv := StringMap.add id.txt bound !pattern_bv
| Ppat_exception p -> add_pattern bv p
| Ppat_extension _ -> ()
@ -191,7 +238,8 @@ let rec add_expr bv exp =
| Pexp_setinstvar(_v, e) -> add_expr bv e
| Pexp_override sel -> List.iter (fun (_s, e) -> add_expr bv e) sel
| Pexp_letmodule(id, m, e) ->
add_module bv m; add_expr (StringSet.add id.txt bv) e
let b = add_module_binding bv m in
add_expr (StringMap.add id.txt b bv) e
| Pexp_assert (e) -> add_expr bv e
| Pexp_lazy (e) -> add_expr bv e
| Pexp_poly (e, t) -> add_expr bv e; add_opt add_type bv t
@ -199,13 +247,15 @@ let rec add_expr bv exp =
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 bv m
| Pexp_open (_ovf, m, e) -> open_module bv m.txt; add_expr bv e
| Pexp_extension ({ txt = ("ocaml.extension_constructor"|"extension_constructor"); _ },
| Pexp_open (_ovf, m, e) ->
let bv = open_module bv m.txt in add_expr bv e
| Pexp_extension ({ txt = ("ocaml.extension_constructor"|
"extension_constructor"); _ },
PStr [item]) ->
begin match item.pstr_desc with
| Pstr_eval ({ pexp_desc = Pexp_construct (c, None) }, _) -> add bv c
| _ -> ()
end
begin match item.pstr_desc with
| Pstr_eval ({ pexp_desc = Pexp_construct (c, None) }, _) -> add bv c
| _ -> ()
end
| Pexp_extension _ -> ()
| Pexp_unreachable -> ()
@ -230,7 +280,7 @@ and add_modtype bv mty =
| Pmty_signature s -> add_signature bv s
| Pmty_functor(id, mty1, mty2) ->
Misc.may (add_modtype bv) mty1;
add_modtype (StringSet.add id.txt bv) mty2
add_modtype (StringMap.add id.txt bound bv) mty2
| Pmty_with(mty, cstrl) ->
add_modtype bv mty;
List.iter
@ -244,45 +294,91 @@ and add_modtype bv mty =
| Pmty_typeof m -> add_module bv m
| Pmty_extension _ -> ()
and add_signature bv = function
[] -> ()
| item :: rem -> add_signature (add_sig_item bv item) rem
and add_module_alias bv l =
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 (* cannot delay *)
and add_sig_item bv item =
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
| Pmty_signature s ->
make_node (add_signature_binding bv s)
| Pmty_typeof modl ->
add_module_binding bv modl
| _ ->
if !Clflags.transparent_modules then add_modtype bv mty; bound
and add_signature bv sg =
ignore (add_signature_binding bv sg)
and add_signature_binding bv sg =
snd (List.fold_left add_sig_item (bv, StringMap.empty) sg)
and add_sig_item (bv, m) item =
match item.psig_desc with
Psig_value vd ->
add_type bv vd.pval_type; bv
add_type bv vd.pval_type; (bv, m)
| Psig_type (_, dcls) ->
List.iter (add_type_declaration bv) dcls; bv
List.iter (add_type_declaration bv) dcls; (bv, m)
| Psig_typext te ->
add_type_extension bv te; bv
add_type_extension bv te; (bv, m)
| Psig_exception pext ->
add_extension_constructor bv pext; bv
add_extension_constructor bv pext; (bv, m)
| Psig_module pmd ->
add_modtype bv pmd.pmd_type; StringSet.add pmd.pmd_name.txt bv
let m' = add_modtype_binding bv pmd.pmd_type in
let add = StringMap.add pmd.pmd_name.txt m' in
(add bv, add m)
| Psig_recmodule decls ->
let bv' =
List.fold_right StringSet.add
(List.map (fun pmd -> pmd.pmd_name.txt) decls) bv
let add =
List.fold_right (fun pmd -> StringMap.add pmd.pmd_name.txt bound)
decls
in
let bv' = add bv and m' = add m in
List.iter (fun pmd -> add_modtype bv' pmd.pmd_type) decls;
bv'
(bv', m')
| Psig_modtype x ->
begin match x.pmtd_type with
None -> ()
| Some mty -> add_modtype bv mty
end;
bv
(bv, m)
| Psig_open od ->
open_module bv od.popen_lid.txt; bv
(open_module bv od.popen_lid.txt, m)
| Psig_include incl ->
add_modtype bv incl.pincl_mod; bv
let Node (s, m') = add_modtype_binding bv incl.pincl_mod in
add_names s;
let add = StringMap.fold StringMap.add m' in
(add bv, add m)
| Psig_class cdl ->
List.iter (add_class_description bv) cdl; bv
List.iter (add_class_description bv) cdl; (bv, m)
| Psig_class_type cdtl ->
List.iter (add_class_type_declaration bv) cdtl; bv
List.iter (add_class_type_declaration bv) cdtl; (bv, m)
| Psig_attribute _ | Psig_extension _ ->
bv
(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 ->
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))
| _ ->
if !Clflags.transparent_modules then add_module bv modl; bound
and add_module bv modl =
match modl.pmod_desc with
@ -290,7 +386,7 @@ and add_module bv modl =
| Pmod_structure s -> ignore (add_structure bv s)
| Pmod_functor(id, mty, modl) ->
Misc.may (add_modtype bv) mty;
add_module (StringSet.add id.txt bv) modl
add_module (StringMap.add id.txt bound bv) modl
| Pmod_apply(mod1, mod2) ->
add_module bv mod1; add_module bv mod2
| Pmod_constraint(modl, mty) ->
@ -301,55 +397,71 @@ and add_module bv modl =
()
and add_structure bv item_list =
List.fold_left add_struct_item bv item_list
let (bv, m) = add_structure_binding bv item_list in
add_names (collect_free (make_node m));
bv
and add_struct_item bv item =
and add_structure_binding bv item_list =
List.fold_left add_struct_item (bv, StringMap.empty) item_list
and add_struct_item (bv, m) item : _ StringMap.t * _ StringMap.t =
match item.pstr_desc with
Pstr_eval (e, _attrs) ->
add_expr bv e; bv
add_expr bv e; (bv, m)
| Pstr_value(rf, pel) ->
let bv = add_bindings rf bv pel in bv
let bv = add_bindings rf bv pel in (bv, m)
| Pstr_primitive vd ->
add_type bv vd.pval_type; bv
add_type bv vd.pval_type; (bv, m)
| Pstr_type (_, dcls) ->
List.iter (add_type_declaration bv) dcls; bv
List.iter (add_type_declaration bv) dcls; (bv, m)
| Pstr_typext te ->
add_type_extension bv te;
bv
(bv, m)
| Pstr_exception pext ->
add_extension_constructor bv pext; bv
add_extension_constructor bv pext; (bv, m)
| Pstr_module x ->
add_module bv x.pmb_expr; StringSet.add x.pmb_name.txt bv
let b = add_module_binding bv x.pmb_expr in
let add = StringMap.add x.pmb_name.txt b in
(add bv, add m)
| Pstr_recmodule bindings ->
let bv' =
List.fold_right StringSet.add
(List.map (fun x -> x.pmb_name.txt) bindings) bv in
let add =
List.fold_right (fun x -> StringMap.add x.pmb_name.txt bound) bindings
in
let bv' = add bv and m = add m in
List.iter
(fun x -> add_module bv' x.pmb_expr)
bindings;
bv'
(bv', m)
| Pstr_modtype x ->
begin match x.pmtd_type with
None -> ()
| Some mty -> add_modtype bv mty
end;
bv
(bv, m)
| Pstr_open od ->
open_module bv od.popen_lid.txt; bv
(open_module bv od.popen_lid.txt, m)
| Pstr_class cdl ->
List.iter (add_class_declaration bv) cdl; bv
List.iter (add_class_declaration bv) cdl; (bv, m)
| Pstr_class_type cdtl ->
List.iter (add_class_type_declaration bv) cdtl; bv
List.iter (add_class_type_declaration bv) cdtl; (bv, m)
| Pstr_include incl ->
add_module bv incl.pincl_mod; bv
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 _ | Pstr_extension _ ->
bv
(bv, m)
and add_use_file bv top_phrs =
ignore (List.fold_left add_top_phrase bv top_phrs)
and add_implementation bv l =
ignore (add_structure 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)
and add_top_phrase bv = function
| Ptop_def str -> add_structure bv str

18
tools/depend.mli
View File

@ -13,13 +13,23 @@
(** Module dependencies. *)
module StringSet : Set.S with type elt = string
module StringMap : Map.S with type key = string
type map_tree = Node of StringSet.t * bound_map
and bound_map = map_tree StringMap.t
val make_leaf : string -> map_tree
val make_node : bound_map -> map_tree
val weaken_map : StringSet.t -> map_tree -> map_tree
val free_structure_names : StringSet.t ref
val open_module : StringSet.t -> Longident.t -> unit
val open_module : bound_map -> Longident.t -> bound_map
val add_use_file : StringSet.t -> Parsetree.toplevel_phrase list -> unit
val add_use_file : bound_map -> Parsetree.toplevel_phrase list -> unit
val add_signature : StringSet.t -> Parsetree.signature -> unit
val add_signature : bound_map -> Parsetree.signature -> unit
val add_implementation : StringSet.t -> Parsetree.structure -> unit
val add_implementation : bound_map -> Parsetree.structure -> unit
val add_implementation_binding : bound_map -> Parsetree.structure -> bound_map
val add_signature_binding : bound_map -> Parsetree.signature -> bound_map

142
tools/ocamldep.ml
View File

@ -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 process_file source_file ~ml_file ~mli_file ~def =
if List.exists (Filename.check_suffix source_file) !ml_synonyms then
process_file_as ml_file def source_file
else if List.exists (Filename.check_suffix source_file) !mli_synonyms then
process_file_as mli_file def source_file
else def
let file_dependencies source_file =
if List.exists (Filename.check_suffix source_file) !ml_synonyms then
file_dependencies_as ML source_file
else if List.exists (Filename.check_suffix source_file) !mli_synonyms then
file_dependencies_as MLI source_file
else ()
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),