From 4d4eb5919eb92033387322fd7f6939497defb9bb Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Wed, 11 Jul 2018 15:55:44 +0100 Subject: [PATCH] Change Module.File.name to Module.File.path Signed-off-by: Jeremie Dimino --- src/gen_rules.ml | 37 +++++++------ src/inline_tests.ml | 8 +-- src/install_rules.ml | 2 +- src/module.ml | 12 +++-- src/module.mli | 10 ++-- src/module_compilation.ml | 5 +- src/ocamldep.ml | 7 ++- src/preprocessing.ml | 54 +++++++++---------- src/stdune/path.ml | 2 +- src/utop.ml | 4 +- .../test-cases/dune-ppx-driver-system/run.t | 6 +-- .../test-cases/js_of_ocaml/run.t | 16 +++--- .../test-cases/ppx-rewriter/run.t | 4 +- .../test-cases/private-public-overlap/run.t | 8 +-- .../test-cases/scope-ppx-bug/run.t | 4 +- 15 files changed, 90 insertions(+), 89 deletions(-) diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 363573e2..a2b5934f 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -279,29 +279,36 @@ module Gen(P : Install_rules.Params) = struct +-----------------------------------------------------------------+ *) let guess_modules ~dir ~files = + let make_file syntax fn = + Module.File.make syntax (Path.relative dir fn) + in let impl_files, intf_files = String.Set.to_list files |> List.filter_partition_map ~f:(fun fn -> (* we aren't using Filename.extension because we want to handle filenames such as foo.cppo.ml *) match String.lsplit2 fn ~on:'.' with - | Some (_, "ml") -> Left { Module.File.syntax=OCaml ; name=fn } - | Some (_, "re") -> Left { Module.File.syntax=Reason ; name=fn } - | Some (_, "mli") -> Right { Module.File.syntax=OCaml ; name=fn } - | Some (_, "rei") -> Right { Module.File.syntax=Reason ; name=fn } + | Some (s, "ml" ) -> Left (s, make_file OCaml fn) + | Some (s, "re" ) -> Left (s, make_file Reason fn) + | Some (s, "mli") -> Right (s, make_file OCaml fn) + | Some (s, "rei") -> Right (s, make_file Reason fn) | _ -> Skip) in let parse_one_set files = - List.map files ~f:(fun (f : Module.File.t) -> - (Module.Name.of_string (Filename.chop_extension f.name), f)) + List.map files ~f:(fun (base, (f : Module.File.t)) -> + (Module.Name.of_string base, f)) |> Module.Name.Map.of_list |> function | Ok x -> x | Error (name, f1, f2) -> let src_dir = Path.drop_build_context_exn dir in - die "too many files for module %a in %s: %s and %s" - Module.Name.pp name (Path.to_string src_dir) - f1.name f2.name + die "Too many files for module %a in %a:\ + \n- %a\ + \n- %a" + Module.Name.pp name + Path.pp src_dir + Path.pp f1.path + Path.pp f2.path in let impls = parse_one_set impl_files in let intfs = parse_one_set intf_files in @@ -374,16 +381,14 @@ module Gen(P : Install_rules.Params) = struct https://github.com/ocaml/dune/issues/567 *) Some (Module.make (Module.Name.add_suffix main_module_name "__") - ~impl:{ name = sprintf "%s__.ml-gen" lib.name - ; syntax = OCaml - } + ~impl:(Module.File.make OCaml + (Path.relative dir (sprintf "%s__.ml-gen" lib.name))) ~obj_name:(lib.name ^ "__")) else Some (Module.make main_module_name - ~impl:{ name = lib.name ^ ".ml-gen" - ; syntax = OCaml - } + ~impl:(Module.File.make OCaml + (Path.relative dir (lib.name ^ ".ml-gen"))) ~obj_name:lib.name) in { modules; alias_module; main_module_name }) @@ -604,7 +609,7 @@ module Gen(P : Install_rules.Params) = struct (Module.Name.to_string (Module.real_unit_name m)) ) |> String.concat ~sep:"\n") - >>> Build.write_file_dyn (Path.relative dir file.name))); + >>> Build.write_file_dyn file.path)); let dynlink = lib.dynlink in diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 8792fbbb..ee9d6b3e 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -173,7 +173,7 @@ include Sub_system.Register_end_point( let modules = Module.Name.Map.singleton main_module_name (Module.make main_module_name - ~impl:{ name = main_module_filename + ~impl:{ path = Path.relative inline_test_dir main_module_filename ; syntax = OCaml } ~obj_name:name) @@ -205,7 +205,7 @@ include Sub_system.Register_end_point( let files ml_kind = Pform.Var.Values (Value.L.paths ( List.filter_map source_modules ~f:(fun m -> - Module.file m ~dir ml_kind))) + Module.file m ml_kind))) in let bindings = Pform.Map.of_list_exn @@ -273,8 +273,8 @@ include Sub_system.Register_end_point( (A.run (Ok exe) flags :: (Module.Name.Map.values source_modules |> List.concat_map ~f:(fun m -> - [ Module.file m ~dir Impl - ; Module.file m ~dir Intf + [ Module.file m Impl + ; Module.file m Intf ]) |> List.filter_map ~f:(fun x -> x) |> List.map ~f:(fun fn -> diff --git a/src/install_rules.ml b/src/install_rules.ml index e0625ec6..f8959e0c 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -164,7 +164,7 @@ module Gen(P : Install_params) = struct ; List.filter_map Ml_kind.all ~f:(Module.cmt_file m ~obj_dir) ; List.filter_map [m.intf;m.impl] ~f:(function | None -> None - | Some f -> Some (Path.relative dir f.name)) + | Some f -> Some f.path) ]) ; if_ byte [ lib_archive ~dir lib ~ext:".cma" ] ; if_ (Library.has_stubs lib) [ stubs_archive ~dir lib ] diff --git a/src/module.ml b/src/module.ml index 01b18181..29de6356 100644 --- a/src/module.ml +++ b/src/module.ml @@ -25,9 +25,11 @@ end module File = struct type t = - { name : string + { path : Path.t ; syntax : Syntax.t } + + let make syntax path = { syntax; path } end type t = @@ -55,7 +57,7 @@ let make ?impl ?intf ?obj_name name = match obj_name with | Some s -> s | None -> - let fn = file.name in + let fn = Path.basename file.path in match String.index fn '.' with | None -> fn | Some i -> String.sub fn ~pos:0 ~len:i @@ -70,17 +72,17 @@ let real_unit_name t = Name.of_string (Filename.basename t.obj_name) let has_impl t = Option.is_some t.impl -let file t ~dir (kind : Ml_kind.t) = +let file t (kind : Ml_kind.t) = let file = match kind with | Impl -> t.impl | Intf -> t.intf in - Option.map file ~f:(fun f -> Path.relative dir f.name) + Option.map file ~f:(fun f -> f.path) let obj_file t ~obj_dir ~ext = Path.relative obj_dir (t.obj_name ^ ext) -let cm_source t ~dir kind = file t ~dir (Cm_kind.source kind) +let cm_source t kind = file t (Cm_kind.source kind) let cm_file_unsafe t ~obj_dir kind = obj_file t ~obj_dir ~ext:(Cm_kind.ext kind) diff --git a/src/module.mli b/src/module.mli index c47c8335..4e4f88b7 100644 --- a/src/module.mli +++ b/src/module.mli @@ -25,9 +25,11 @@ end module File : sig type t = - { name : string - ; syntax: Syntax.t + { path : Path.t + ; syntax : Syntax.t } + + val make : Syntax.t -> Path.t -> t end (** Representation of a module. It is guaranteed that at least one of @@ -54,8 +56,8 @@ val name : t -> Name.t (** Real unit name once wrapped. This is always a valid module name. *) val real_unit_name : t -> Name.t -val file : t -> dir: Path.t -> Ml_kind.t -> Path.t option -val cm_source : t -> dir: Path.t -> Cm_kind.t -> Path.t option +val file : t -> Ml_kind.t -> Path.t option +val cm_source : t -> Cm_kind.t -> Path.t option val cm_file : t -> obj_dir:Path.t -> Cm_kind.t -> Path.t option val cmt_file : t -> obj_dir:Path.t -> Ml_kind.t -> Path.t option diff --git a/src/module_compilation.ml b/src/module_compilation.ml index aaeaa1e9..d7dccb7b 100644 --- a/src/module_compilation.ml +++ b/src/module_compilation.ml @@ -36,7 +36,7 @@ let build_cm cctx ?sandbox ?(dynlink=true) ~dep_graphs ~cm_kind (m : Module.t) = let obj_dir = CC.obj_dir cctx in let ctx = SC.context sctx in Option.iter (Mode.of_cm_kind cm_kind |> Context.compiler ctx) ~f:(fun compiler -> - Option.iter (Module.cm_source ~dir m cm_kind) ~f:(fun src -> + Option.iter (Module.cm_source m cm_kind) ~f:(fun src -> let ml_kind = Cm_kind.source cm_kind in let dst = Module.cm_file_unsafe m ~obj_dir cm_kind in let extra_args, extra_deps, other_targets = @@ -149,10 +149,9 @@ let build_modules ?sandbox ?js_of_ocaml ?dynlink ~dep_graphs cctx = let ocamlc_i ?sandbox ?(flags=[]) ~dep_graphs cctx (m : Module.t) ~output = let sctx = CC.super_context cctx in - let dir = CC.dir cctx in let obj_dir = CC.obj_dir cctx in let ctx = SC.context sctx in - let src = Option.value_exn (Module.file ~dir m Impl) in + let src = Option.value_exn (Module.file m Impl) in let dep_graph = Ml_kind.Dict.get dep_graphs Impl in let cm_deps = Build.dyn_paths diff --git a/src/ocamldep.ml b/src/ocamldep.ml index c47604a1..3769a0a6 100644 --- a/src/ocamldep.ml +++ b/src/ocamldep.ml @@ -122,11 +122,10 @@ let parse_deps cctx ~file ~unit lines = let deps_of cctx ~ml_kind unit = let sctx = CC.super_context cctx in - let dir = CC.dir cctx in if is_alias_module cctx unit then Build.return [] else - match Module.file ~dir unit ml_kind with + match Module.file unit ml_kind with | None -> Build.return [] | Some file -> let file_in_obj_dir ~suffix file = @@ -148,9 +147,9 @@ let deps_of cctx ~ml_kind unit = if is_alias_module cctx m then None else - match Module.file ~dir m Ml_kind.Intf with + match Module.file m Ml_kind.Intf with | Some _ as x -> x - | None -> Module.file ~dir m Ml_kind.Impl + | None -> Module.file m Ml_kind.Impl in Option.map path ~f:all_deps_path in diff --git a/src/preprocessing.ml b/src/preprocessing.ml index 4e8824aa..daef1ef7 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -4,17 +4,11 @@ open Jbuild module SC = Super_context -let pp_fname fn = - let fn, ext = Filename.split_extension fn in - (* We need to to put the .pp before the .ml so that the compiler realises that - [foo.pp.mli] is the interface for [foo.pp.ml] *) - fn ^ ".pp" ^ ext - -let pped_module ~dir m ~f = +let pped_module m ~f = Module.map_files m ~f:(fun kind file -> - let pp_fname = pp_fname file.name in - f kind (Path.relative dir file.name) (Path.relative dir pp_fname); - { file with name = pp_fname }) + let pp_fname = Path.extend_basename file.path ~suffix:".pp" in + f kind file.path pp_fname; + { file with path = pp_fname }) module Driver = struct module M = struct @@ -407,17 +401,18 @@ let cookie_library_name lib_name = (* Generate rules for the reason modules in [modules] and return a a new module with only OCaml sources *) -let setup_reason_rules sctx ~dir (m : Module.t) = +let setup_reason_rules sctx (m : Module.t) = let ctx = SC.context sctx in let refmt = Artifacts.binary (SC.artifacts sctx) "refmt" ~hint:"opam install reason" in let rule src target = - let src_path = Path.relative dir src in Build.run ~context:ctx refmt [ A "--print" ; A "binary" - ; Dep src_path ] - ~stdout_to:(Path.relative dir target) in + ; Dep src + ] + ~stdout_to:target + in Module.map_files m ~f:(fun _ f -> match f.syntax with | OCaml -> f @@ -425,10 +420,10 @@ let setup_reason_rules sctx ~dir (m : Module.t) = let ml = { Module.File. syntax = OCaml - ; name = f.name ^ ".ast" + ; path = Path.extend_basename f.path ~suffix:".ast" } in - SC.add_rule sctx (rule f.name ml.name); + SC.add_rule sctx (rule f.path ml.path); ml) let promote_correction fn build ~suffix = @@ -447,7 +442,7 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind = SC.add_alias_action sctx alias build ~stamp:(List [ Sexp.unsafe_atom_of_string "lint" ; Sexp.To_sexp.(option string) lib_name - ; Sexp.atom fn + ; Path.sexp_of_t fn ]) in let lint = @@ -458,10 +453,9 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind = (fun ~source ~ast:_ -> let action = Action.Unexpanded.Chdir (workspace_root_var, action) in Module.iter source ~f:(fun _ (src : Module.File.t) -> - let src_path = Path.relative dir src.name in - let bindings = Pform.Map.input_file src_path in - add_alias src.name - (Build.path src_path + let bindings = Pform.Map.input_file src.path in + add_alias src.path + (Build.path src.path >>^ (fun _ -> Jbuild.Bindings.empty) >>> SC.Action.run sctx action @@ -496,16 +490,16 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind = in (fun ~source ~ast -> Module.iter ast ~f:(fun kind src -> - add_alias src.name + add_alias src.path (promote_correction ~suffix:corrected_suffix - (Option.value_exn (Module.file ~dir source kind)) + (Option.value_exn (Module.file source kind)) (Build.of_result_map driver_and_flags ~f:(fun (exe, flags) -> flags >>> Build.run ~context:(SC.context sctx) (Ok exe) [ args ; Ml_kind.ppx_driver_flag kind - ; Dep (Path.relative dir src.name) + ; Dep src.path ; Dyn (fun x -> As x) ])))))) in @@ -528,13 +522,13 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess Per_module.map preprocess ~f:(function | Preprocess.No_preprocessing -> (fun m ~lint -> - let ast = setup_reason_rules sctx ~dir m in + let ast = setup_reason_rules sctx m in if lint then lint_module ~ast ~source:m; ast) | Action (loc, action) -> (fun m ~lint -> let ast = - pped_module m ~dir ~f:(fun _kind src dst -> + pped_module m ~f:(fun _kind src dst -> let bindings = Pform.Map.input_file src in SC.add_rule sctx (preprocessor_deps @@ -554,7 +548,7 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess ~bindings ~targets:(Static [dst]) ~scope)) - |> setup_reason_rules sctx ~dir in + |> setup_reason_rules sctx in if lint then lint_module ~ast ~source:m; ast) | Pps { loc; pps; flags } -> @@ -580,12 +574,12 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess ~standard:(Build.return []))) in (fun m ~lint -> - let ast = setup_reason_rules sctx ~dir m in + let ast = setup_reason_rules sctx m in if lint then lint_module ~ast ~source:m; - pped_module ast ~dir ~f:(fun kind src dst -> + pped_module ast ~f:(fun kind src dst -> SC.add_rule sctx (promote_correction ~suffix:corrected_suffix - (Option.value_exn (Module.file m ~dir kind)) + (Option.value_exn (Module.file m kind)) (preprocessor_deps >>^ ignore >>> Build.of_result_map driver_and_flags diff --git a/src/stdune/path.ml b/src/stdune/path.ml index d19410c3..33939e30 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -903,7 +903,7 @@ let compare x y = let extension t = Filename.extension (to_string t) -let pp ppf t = Format.pp_print_string ppf (to_string t) +let pp ppf t = Format.pp_print_string ppf (to_string_maybe_quoted t) let pp_debug ppf = function | In_source_tree s -> diff --git a/src/utop.ml b/src/utop.ml index 5895da9b..1f83de66 100644 --- a/src/utop.ml +++ b/src/utop.ml @@ -51,16 +51,16 @@ let setup sctx ~dir ~(libs : Library.t list) ~scope = match libs with | [] -> () | _ :: _ -> + let utop_exe_dir = utop_exe_dir ~dir in let modules = Module.Name.Map.singleton main_module_name (Module.make main_module_name - ~impl:{ name = main_module_filename + ~impl:{ path = Path.relative utop_exe_dir main_module_filename ; syntax = Module.Syntax.OCaml } ~obj_name:exe_name) in - let utop_exe_dir = utop_exe_dir ~dir in let requires = let open Result.O in Lib.DB.find_many (Scope.libs scope) diff --git a/test/blackbox-tests/test-cases/dune-ppx-driver-system/run.t b/test/blackbox-tests/test-cases/dune-ppx-driver-system/run.t index 018d203e..5f5fedcc 100644 --- a/test/blackbox-tests/test-cases/dune-ppx-driver-system/run.t +++ b/test/blackbox-tests/test-cases/dune-ppx-driver-system/run.t @@ -41,7 +41,7 @@ Same, but with error pointing to .ppx Test the argument syntax $ dune build test_ppx_args.cma - ppx test_ppx_args.pp.ml + ppx test_ppx_args.ml.pp .ppx/driver_print_args@foo/ppx.exe -arg1 -arg2 @@ -50,9 +50,9 @@ Test the argument syntax --cookie library-name="test_ppx_args" -o - test_ppx_args.pp.ml + test_ppx_args.ml.pp --impl test_ppx_args.ml Error: Rule failed to generate the following targets: - - test_ppx_args.pp.ml + - test_ppx_args.ml.pp [1] diff --git a/test/blackbox-tests/test-cases/js_of_ocaml/run.t b/test/blackbox-tests/test-cases/js_of_ocaml/run.t index f046a83e..cfae4289 100644 --- a/test/blackbox-tests/test-cases/js_of_ocaml/run.t +++ b/test/blackbox-tests/test-cases/js_of_ocaml/run.t @@ -2,18 +2,18 @@ ocamlc lib/stubs$ext_obj ocamlmklib lib/dllx_stubs$ext_dll,lib/libx_stubs$ext_lib ocamlopt .ppx/js_of_ocaml-ppx/ppx.exe - ppx lib/x.pp.ml - ocamldep lib/.x.objs/x.pp.ml.d + ppx lib/x.ml.pp + ocamldep lib/.x.objs/x.ml.pp.d ocamlc lib/.x.objs/x__.{cmi,cmo,cmt} ocamlopt lib/.x.objs/x__.{cmx,o} - ppx lib/y.pp.ml - ocamldep lib/.x.objs/y.pp.ml.d + ppx lib/y.ml.pp + ocamldep lib/.x.objs/y.ml.pp.d ocamlc lib/.x.objs/x__Y.{cmi,cmo,cmt} ocamlopt lib/.x.objs/x__Y.{cmx,o} - ppx bin/technologic.pp.ml - ocamldep bin/.technologic.eobjs/technologic.pp.ml.d - ppx bin/z.pp.ml - ocamldep bin/.technologic.eobjs/z.pp.ml.d + ppx bin/technologic.ml.pp + ocamldep bin/.technologic.eobjs/technologic.ml.pp.d + ppx bin/z.ml.pp + ocamldep bin/.technologic.eobjs/z.ml.pp.d js_of_ocaml .js/js_of_ocaml/js_of_ocaml.cma.js js_of_ocaml lib/.x.objs/x__Y.cmo.js ocamlc lib/.x.objs/x.{cmi,cmo,cmt} diff --git a/test/blackbox-tests/test-cases/ppx-rewriter/run.t b/test/blackbox-tests/test-cases/ppx-rewriter/run.t index bb670e8c..911b3a66 100644 --- a/test/blackbox-tests/test-cases/ppx-rewriter/run.t +++ b/test/blackbox-tests/test-cases/ppx-rewriter/run.t @@ -4,8 +4,8 @@ ocamlopt ppx/.fooppx.objs/fooppx.{cmx,o} ocamlopt ppx/fooppx.{a,cmxa} ocamlopt .ppx/jbuild/fooppx/ppx.exe - ppx w_omp_driver.pp.ml - ocamldep .w_omp_driver.eobjs/w_omp_driver.pp.ml.d + ppx w_omp_driver.ml.pp + ocamldep .w_omp_driver.eobjs/w_omp_driver.ml.pp.d ocamlc .w_omp_driver.eobjs/w_omp_driver.{cmi,cmo,cmt} ocamlopt .w_omp_driver.eobjs/w_omp_driver.{cmx,o} ocamlopt w_omp_driver.exe diff --git a/test/blackbox-tests/test-cases/private-public-overlap/run.t b/test/blackbox-tests/test-cases/private-public-overlap/run.t index e2f4d2bd..81516c4f 100644 --- a/test/blackbox-tests/test-cases/private-public-overlap/run.t +++ b/test/blackbox-tests/test-cases/private-public-overlap/run.t @@ -15,8 +15,8 @@ On the other hand, public libraries may have private preprocessors ocamlopt .ppx_internal.objs/ppx_internal.{cmx,o} ocamlopt ppx_internal.{a,cmxa} ocamlopt .ppx/jbuild/ppx_internal@mylib/ppx.exe - ppx mylib.pp.ml - ocamldep .mylib.objs/mylib.pp.ml.d + ppx mylib.ml.pp + ocamldep .mylib.objs/mylib.ml.pp.d ocamlc .mylib.objs/mylib.{cmi,cmo,cmt} ocamlopt .mylib.objs/mylib.{cmx,o} ocamlopt mylib.{a,cmxa} @@ -33,8 +33,8 @@ Unless they introduce private runtime dependencies: ocamlopt .private_ppx.objs/private_ppx.{cmx,o} ocamlopt private_ppx.{a,cmxa} ocamlopt .ppx/jbuild/private_ppx@mylib/ppx.exe - ppx mylib.pp.ml - ocamldep .mylib.objs/mylib.pp.ml.d + ppx mylib.ml.pp + ocamldep .mylib.objs/mylib.ml.pp.d [1] However, public binaries may accept private dependencies diff --git a/test/blackbox-tests/test-cases/scope-ppx-bug/run.t b/test/blackbox-tests/test-cases/scope-ppx-bug/run.t index cb655b6e..9f9c86d0 100644 --- a/test/blackbox-tests/test-cases/scope-ppx-bug/run.t +++ b/test/blackbox-tests/test-cases/scope-ppx-bug/run.t @@ -11,8 +11,8 @@ ocamlc a/kernel/a_kernel.cma ocamlopt .ppx/jbuild/a.kernel/ppx.exe ocamlopt .ppx/jbuild/a/ppx.exe - ppx b/b.pp.ml - ocamldep b/.b.objs/b.pp.ml.d + ppx b/b.ml.pp + ocamldep b/.b.objs/b.ml.pp.d ocamlc b/.b.objs/b.{cmi,cmo,cmt} ocamlopt b/.b.objs/b.{cmx,o} ocamlopt b/b.{a,cmxa}