matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Change Module.File.name to Module.File.path 

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
Jeremie Dimino 2018-07-11 15:55:44 +01:00 committed by Jérémie Dimino
parent b8679d2791
commit 4d4eb5919e
15 changed files with 90 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
src/gen_rules.ml
View File

@ -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

8
src/inline_tests.ml
View File

@ -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 ->

2
src/install_rules.ml
View File

@ -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 ]

12
src/module.ml
View File

@ -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)

10
src/module.mli
View File

@ -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

5
src/module_compilation.ml
View File

@ -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

7
src/ocamldep.ml
View File

@ -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

54
src/preprocessing.ml
View File

@ -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

2
src/stdune/path.ml
View File

@ -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 ->

4
src/utop.ml
View File

@ -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)

6
test/blackbox-tests/test-cases/dune-ppx-driver-system/run.t
View File

@ -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]

16
test/blackbox-tests/test-cases/js_of_ocaml/run.t
View File

@ -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}

4
test/blackbox-tests/test-cases/ppx-rewriter/run.t
View File

@ -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

8
test/blackbox-tests/test-cases/private-public-overlap/run.t
View File

@ -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

4
test/blackbox-tests/test-cases/scope-ppx-bug/run.t
View File

@ -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}