diff --git a/Changes b/Changes index 594f1b642..6b9c6ac22 100644 --- a/Changes +++ b/Changes @@ -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 diff --git a/ocamldoc/odoc_dep.ml b/ocamldoc/odoc_dep.ml index e6fd16e3b..ab027d8d4 100644 --- a/ocamldoc/odoc_dep.ml +++ b/ocamldoc/odoc_dep.ml @@ -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 diff --git a/testsuite/tests/tool-ocamldep-modalias/A.ml b/testsuite/tests/tool-ocamldep-modalias/A.ml new file mode 100644 index 000000000..9faa225ac --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/A.ml @@ -0,0 +1 @@ +let f x = x +1 diff --git a/testsuite/tests/tool-ocamldep-modalias/B.ml b/testsuite/tests/tool-ocamldep-modalias/B.ml new file mode 100644 index 000000000..17d27a3eb --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/B.ml @@ -0,0 +1,2 @@ +open Packed +let g = A.f diff --git a/testsuite/tests/tool-ocamldep-modalias/C.ml b/testsuite/tests/tool-ocamldep-modalias/C.ml new file mode 100644 index 000000000..87cb814d6 --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/C.ml @@ -0,0 +1,2 @@ +open Lib +let h x = A.f x + B.g x diff --git a/testsuite/tests/tool-ocamldep-modalias/D.ml b/testsuite/tests/tool-ocamldep-modalias/D.ml new file mode 100644 index 000000000..9f192def2 --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/D.ml @@ -0,0 +1 @@ +let z x = imp (x*2) diff --git a/testsuite/tests/tool-ocamldep-modalias/Makefile b/testsuite/tests/tool-ocamldep-modalias/Makefile new file mode 100644 index 000000000..5ebd70042 --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/Makefile @@ -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 diff --git a/testsuite/tests/tool-ocamldep-modalias/Makefile.build b/testsuite/tests/tool-ocamldep-modalias/Makefile.build new file mode 100644 index 000000000..663b158fc --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/Makefile.build @@ -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 diff --git a/testsuite/tests/tool-ocamldep-modalias/Makefile.build2 b/testsuite/tests/tool-ocamldep-modalias/Makefile.build2 new file mode 100644 index 000000000..a75477b96 --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/Makefile.build2 @@ -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) diff --git a/testsuite/tests/tool-ocamldep-modalias/depend.mk.reference b/testsuite/tests/tool-ocamldep-modalias/depend.mk.reference new file mode 100644 index 000000000..951b5d268 --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/depend.mk.reference @@ -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 diff --git a/testsuite/tests/tool-ocamldep-modalias/depend.mk2.reference b/testsuite/tests/tool-ocamldep-modalias/depend.mk2.reference new file mode 100644 index 000000000..a3f73b5ed --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/depend.mk2.reference @@ -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 diff --git a/testsuite/tests/tool-ocamldep-modalias/depend.mod.reference b/testsuite/tests/tool-ocamldep-modalias/depend.mod.reference new file mode 100644 index 000000000..37a3cea2d --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/depend.mod.reference @@ -0,0 +1,6 @@ +lib.ml: +lib.mli: +LibA.ml: Lib +LibB.ml: Lib LibA +LibC.ml: Lib LibA LibB +LibD.ml: Lib diff --git a/testsuite/tests/tool-ocamldep-modalias/depend.mod2.reference b/testsuite/tests/tool-ocamldep-modalias/depend.mod2.reference new file mode 100644 index 000000000..7ec54741d --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/depend.mod2.reference @@ -0,0 +1,4 @@ +LibA.ml: +LibB.ml: A Packed +LibC.ml: Lib LibA LibB +LibD.ml: diff --git a/testsuite/tests/tool-ocamldep-modalias/depend.mod3.reference b/testsuite/tests/tool-ocamldep-modalias/depend.mod3.reference new file mode 100644 index 000000000..8ab7ed953 --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/depend.mod3.reference @@ -0,0 +1,4 @@ +LibA.ml: Lib +LibB.ml: Lib LibA +LibC.ml: Lib LibA LibB +LibD.ml: Lib diff --git a/testsuite/tests/tool-ocamldep-modalias/lib.mli b/testsuite/tests/tool-ocamldep-modalias/lib.mli new file mode 100644 index 000000000..2334c2b6d --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/lib.mli @@ -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 diff --git a/testsuite/tests/tool-ocamldep-modalias/lib_impl.ml b/testsuite/tests/tool-ocamldep-modalias/lib_impl.ml new file mode 100644 index 000000000..fc8581ada --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/lib_impl.ml @@ -0,0 +1,8 @@ +module Packed = struct + module A = LibA + module B = LibB + module C = LibC +end +include Packed + +let imp x = x+1 diff --git a/testsuite/tests/tool-ocamldep-modalias/main.ml b/testsuite/tests/tool-ocamldep-modalias/main.ml new file mode 100644 index 000000000..946689127 --- /dev/null +++ b/testsuite/tests/tool-ocamldep-modalias/main.ml @@ -0,0 +1,3 @@ +open Lib + +let () = Printf.printf "B.g 3 = %d\n%!" (B.g 3) diff --git a/tools/depend.ml b/tools/depend.ml index 92b6cdc9a..8b46882b9 100644 --- a/tools/depend.ml +++ b/tools/depend.ml @@ -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 diff --git a/tools/depend.mli b/tools/depend.mli index 93fc084f7..feec759b8 100644 --- a/tools/depend.mli +++ b/tools/depend.mli @@ -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 diff --git a/tools/ocamldep.ml b/tools/ocamldep.ml index 94fda41c0..b14d5d1aa 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 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 "@ @[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 "@[%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), " Add to the list of include directories"; "-impl", Arg.String (file_dependencies_as ML), " Process as a .ml file"; "-intf", Arg.String (file_dependencies_as MLI), " Process as a .mli file"; - "-allow-approx", Arg.Set allow_approximation, - " Fallback to a lexer-based approximation on unparseable files."; + "-map", Arg.String parse_map, + " Read and propagate delayed dependencies to following files"; "-ml-synonym", Arg.String(add_to_synonym_list ml_synonyms), " Consider as a synonym of the .ml extension"; "-mli-synonym", Arg.String(add_to_synonym_list mli_synonyms),