diff --git a/src/artifacts.mli b/src/artifacts.mli index a1bc674f..3786bb85 100644 --- a/src/artifacts.mli +++ b/src/artifacts.mli @@ -6,7 +6,7 @@ val create : Context.t -> public_libs:Lib.DB.t -> 'a list - -> f:('a -> Jbuild.Stanza.t list) + -> f:('a -> Stanza.t list) -> t (** A named artifact that is looked up in the PATH if not found in the tree diff --git a/src/compilation_context.ml b/src/compilation_context.ml new file mode 100644 index 00000000..550289cf --- /dev/null +++ b/src/compilation_context.ml @@ -0,0 +1,84 @@ +open Import + +module SC = Super_context + +module Includes = struct + type t = string list Arg_spec.t Cm_kind.Dict.t + + let make sctx ~requires : _ Cm_kind.Dict.t = + match requires with + | Error exn -> Cm_kind.Dict.make_all (Arg_spec.Dyn (fun _ -> raise exn)) + | Ok libs -> + let iflags = + Lib.L.include_flags libs ~stdlib_dir:(SC.context sctx).stdlib_dir + in + let cmi_includes = + Arg_spec.S [ iflags + ; Hidden_deps + (SC.Libs.file_deps sctx libs ~ext:".cmi") + ] + in + let cmi_and_cmx_includes = + Arg_spec.S [ iflags + ; Hidden_deps + (SC.Libs.file_deps sctx libs ~ext:".cmi-and-.cmx") + ] + in + { cmi = cmi_includes + ; cmo = cmi_includes + ; cmx = cmi_and_cmx_includes + } + + let empty = + Cm_kind.Dict.make_all (Arg_spec.As []) +end + +type t = + { super_context : Super_context.t + ; scope : Scope.t + ; dir : Path.t + ; obj_dir : Path.t + ; modules : Module.t Module.Name.Map.t + ; alias_module : Module.t option + ; lib_interface_module : Module.t option + ; flags : Ocaml_flags.t + ; requires : Lib.t list Or_exn.t + ; includes : Includes.t + ; preprocessing : Preprocessing.t + } + +let super_context t = t.super_context +let scope t = t.scope +let dir t = t.dir +let obj_dir t = t.obj_dir +let modules t = t.modules +let alias_module t = t.alias_module +let lib_interface_module t = t.lib_interface_module +let flags t = t.flags +let requires t = t.requires +let includes t = t.includes +let preprocessing t = t.preprocessing + +let create ~super_context ~scope ~dir ?(obj_dir=dir) ~modules ?alias_module + ?lib_interface_module ~flags ~requires + ?(preprocessing=Preprocessing.dummy) () = + { super_context + ; scope + ; dir + ; obj_dir + ; modules + ; alias_module + ; lib_interface_module + ; flags + ; requires + ; includes = Includes.make super_context ~requires + ; preprocessing + } + +let for_alias_module t = + let flags = Ocaml_flags.default ~profile:(SC.profile t.super_context) in + { t with + flags = Ocaml_flags.append_common flags ["-w"; "-49"] + ; includes = Includes.empty + ; alias_module = None + } diff --git a/src/compilation_context.mli b/src/compilation_context.mli new file mode 100644 index 00000000..1f3b1dbd --- /dev/null +++ b/src/compilation_context.mli @@ -0,0 +1,42 @@ +(** High-level API for compiling OCaml files *) + +open Import + +(** Represent a compilation context. + + A compilation context contains all the necessary information to + preprocess and compile OCaml source files. Exactly one compilation + context is associated to each library, executable and executbales + stanza. +*) +type t + +(** Create a compilation context. *) +val create + : super_context : Super_context.t + -> scope : Scope.t + -> dir : Path.t + -> ?obj_dir : Path.t + -> modules : Module.t Module.Name.Map.t + -> ?alias_module : Module.t + -> ?lib_interface_module : Module.t + -> flags : Ocaml_flags.t + -> requires : Lib.t list Or_exn.t + -> ?preprocessing : Preprocessing.t + -> unit + -> t + +(** Return a compilation context suitable for compiling the alias module. *) +val for_alias_module : t -> t + +val super_context : t -> Super_context.t +val scope : t -> Scope.t +val dir : t -> Path.t +val obj_dir : t -> Path.t +val modules : t -> Module.t Module.Name.Map.t +val alias_module : t -> Module.t option +val lib_interface_module : t -> Module.t option +val flags : t -> Ocaml_flags.t +val requires : t -> Lib.t list Or_exn.t +val includes : t -> string list Arg_spec.t Cm_kind.Dict.t +val preprocessing : t -> Preprocessing.t diff --git a/src/exe.ml b/src/exe.ml index 33541366..ebf90424 100644 --- a/src/exe.ml +++ b/src/exe.ml @@ -1,6 +1,7 @@ open Import open Build.O +module CC = Compilation_context module SC = Super_context module Program = struct @@ -103,19 +104,18 @@ module Linkage = struct end let link_exe - ~dir - ~obj_dir - ~scope - ~requires ~name ~(linkage:Linkage.t) ~top_sorted_modules - ?(flags=Ocaml_flags.empty) ?(link_flags=Build.arr (fun _ -> [])) ?(js_of_ocaml=Jbuild.Js_of_ocaml.default) - sctx + cctx = - let ctx = SC.context sctx in + let sctx = CC.super_context cctx in + let ctx = SC.context sctx in + let dir = CC.dir cctx in + let obj_dir = CC.obj_dir cctx in + let requires = CC.requires cctx in let mode = linkage.mode in let exe = Path.relative dir (name ^ linkage.ext) in let compiler = Option.value_exn (Context.compiler ctx mode) in @@ -139,7 +139,7 @@ let link_exe SC.add_rule sctx (Build.fanout3 (register_native_objs_deps modules_and_cm_files >>^ snd) - (Ocaml_flags.get flags mode) + (Ocaml_flags.get (CC.flags cctx) mode) link_flags >>> Build.of_result_map requires ~f:(fun libs -> @@ -162,56 +162,39 @@ let link_exe let cm_and_flags = Build.fanout (modules_and_cm_files >>^ snd) - (SC.expand_and_eval_set sctx ~scope ~dir js_of_ocaml.flags + (SC.expand_and_eval_set sctx ~scope:(CC.scope cctx) ~dir + js_of_ocaml.flags ~standard:(Build.return (Js_of_ocaml_rules.standard sctx))) in SC.add_rules sctx (List.map rules ~f:(fun r -> cm_and_flags >>> r)) let build_and_link_many - ~dir ~obj_dir ~programs ~modules - ~scope + ~programs ~linkages - ?(requires=Ok []) ?already_used - ?(flags=Ocaml_flags.empty) ?link_flags ?(js_of_ocaml=Jbuild.Js_of_ocaml.default) - sctx + cctx = - let modules = - Module.Name.Map.map modules ~f:(Module.set_obj_name ~wrapper:None) - in - - let dep_graphs = - Ocamldep.rules sctx ~dir ~modules ?already_used - ~alias_module:None ~lib_interface_module:None - in + let dep_graphs = Ocamldep.rules cctx ?already_used in (* CR-someday jdimino: this should probably say [~dynlink:false] *) - Module_compilation.build_modules sctx - ~js_of_ocaml - ~dynlink:true ~flags ~scope ~dir ~obj_dir ~dep_graphs ~modules - ~requires ~alias_module:None; + Module_compilation.build_modules cctx ~js_of_ocaml ~dep_graphs; List.iter programs ~f:(fun { Program.name; main_module_name } -> let top_sorted_modules = let main = Option.value_exn - (Module.Name.Map.find modules main_module_name) in + (Module.Name.Map.find (CC.modules cctx) main_module_name) in Ocamldep.Dep_graph.top_closed_implementations dep_graphs.impl [main] in List.iter linkages ~f:(fun linkage -> - link_exe sctx - ~dir - ~obj_dir - ~scope - ~requires + link_exe cctx ~name ~linkage ~top_sorted_modules ~js_of_ocaml - ~flags ?link_flags)) -let build_and_link ~dir ~obj_dir ~program = - build_and_link_many ~dir ~obj_dir ~programs:[program] +let build_and_link ~program = + build_and_link_many ~programs:[program] diff --git a/src/exe.mli b/src/exe.mli index b82f0229..7509d9e0 100644 --- a/src/exe.mli +++ b/src/exe.mli @@ -1,7 +1,5 @@ (** Compilation and linking of executables *) -open Import - module Program : sig type t = { name : string @@ -39,48 +37,31 @@ end (** Build and link one or more executables *) val build_and_link - : dir:Path.t - -> obj_dir:Path.t - -> program:Program.t - -> modules:Module.t Module.Name.Map.t - -> scope:Scope.t + : program:Program.t -> linkages:Linkage.t list - -> ?requires:Lib.t list Or_exn.t -> ?already_used:Module.Name.Set.t - -> ?flags:Ocaml_flags.t -> ?link_flags:(unit, string list) Build.t -> ?js_of_ocaml:Jbuild.Js_of_ocaml.t - -> Super_context.t + -> Compilation_context.t -> unit val build_and_link_many - : dir:Path.t - -> obj_dir:Path.t - -> programs:Program.t list - -> modules:Module.t Module.Name.Map.t - -> scope:Scope.t + : programs:Program.t list -> linkages:Linkage.t list - -> ?requires:Lib.t list Or_exn.t -> ?already_used:Module.Name.Set.t - -> ?flags:Ocaml_flags.t -> ?link_flags:(unit, string list) Build.t -> ?js_of_ocaml:Jbuild.Js_of_ocaml.t - -> Super_context.t + -> Compilation_context.t -> unit (** {1 Low-level functions} *) (** Link a single executable *) val link_exe - : dir:Path.t - -> obj_dir:Path.t - -> scope:Scope.t - -> requires:Lib.t list Or_exn.t - -> name:string + : name:string -> linkage:Linkage.t -> top_sorted_modules:(unit, Module.t list) Build.t - -> ?flags:Ocaml_flags.t -> ?link_flags:(unit, string list) Build.t -> ?js_of_ocaml:Jbuild.Js_of_ocaml.t - -> Super_context.t + -> Compilation_context.t -> unit diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 501956a4..bd48a3cd 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -10,6 +10,7 @@ open! No_io module Gen(P : Install_rules.Params) = struct module Alias = Build_system.Alias + module CC = Compilation_context module SC = Super_context module Odoc = Odoc.Gen(P) @@ -253,8 +254,7 @@ module Gen(P : Install_rules.Params) = struct List.concat_map stanzas ~f:(fun stanza -> match (stanza : Stanza.t) with | Menhir menhir -> - Menhir_rules.gen_rules sctx ~dir ~scope menhir - |> List.map ~f:Path.basename + Menhir_rules.targets menhir | Rule rule -> List.map (user_rule rule ~dir ~scope) ~f:Path.basename | Copy_files def -> @@ -267,8 +267,7 @@ module Gen(P : Install_rules.Params) = struct match (dep : Jbuild.Lib_dep.t) with | Direct _ -> None | Select s -> Some s.result_fn) - | Documentation _ | Alias _ | Provides _ | Install _ - | Env _ -> []) + | _ -> []) |> String.Set.of_list in String.Set.union generated_files @@ -550,14 +549,10 @@ module Gen(P : Install_rules.Params) = struct let flags = SC.ocaml_flags sctx ~scope ~dir lib.buildable in let { modules; main_module_name; alias_module } = modules_by_lib ~dir lib in let source_modules = modules in - let already_used = - Modules_partitioner.acknowledge modules_partitioner - ~loc:lib.buildable.loc ~modules - in (* Preprocess before adding the alias module as it doesn't need preprocessing *) - let modules = - Preprocessing.pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~scope + let pp = + Preprocessing.make sctx ~dir ~dep_kind ~scope ~preprocess:lib.buildable.preprocess ~preprocessor_deps: (SC.Deps.interpret sctx ~scope ~dir @@ -565,6 +560,7 @@ module Gen(P : Install_rules.Params) = struct ~lint:lib.buildable.lint ~lib_name:(Some lib.name) in + let modules = Preprocessing.pp_modules pp modules in let modules = match alias_module with @@ -572,14 +568,31 @@ module Gen(P : Install_rules.Params) = struct | Some m -> Module.Name.Map.add modules m.name m in - let dep_graphs = - Ocamldep.rules sctx ~dir ~modules ~already_used ~alias_module - ~lib_interface_module:( - if lib.wrapped then - Module.Name.Map.find modules main_module_name - else - None) + let lib_interface_module = + if lib.wrapped then + Module.Name.Map.find modules main_module_name + else + None in + let cctx = + Compilation_context.create () + ~super_context:sctx + ~scope + ~dir + ~obj_dir + ~modules + ?alias_module + ?lib_interface_module + ~flags + ~requires + ~preprocessing:pp + in + + let already_used = + Modules_partitioner.acknowledge modules_partitioner cctx + ~loc:lib.buildable.loc ~modules:source_modules + in + let dep_graphs = Ocamldep.rules cctx ~already_used in Option.iter alias_module ~f:(fun m -> let file = @@ -604,22 +617,14 @@ module Gen(P : Install_rules.Params) = struct let dynlink = lib.dynlink in let js_of_ocaml = lib.buildable.js_of_ocaml in - Module_compilation.build_modules sctx - ~js_of_ocaml ~dynlink ~flags ~scope ~dir ~obj_dir ~dep_graphs - ~modules ~requires ~alias_module; + Module_compilation.build_modules cctx ~js_of_ocaml ~dynlink ~dep_graphs; Option.iter alias_module ~f:(fun m -> - let flags = Ocaml_flags.default ~profile:(SC.profile sctx) in - Module_compilation.build_module sctx m + let cctx = Compilation_context.for_alias_module cctx in + Module_compilation.build_module cctx m ~js_of_ocaml ~dynlink ~sandbox:alias_module_build_sandbox - ~flags:(Ocaml_flags.append_common flags ["-w"; "-49"]) - ~scope - ~dir - ~obj_dir - ~dep_graphs:(Ocamldep.Dep_graphs.dummy m) - ~includes:(Cm_kind.Dict.make_all (Arg_spec.As [])) - ~alias_module:None); + ~dep_graphs:(Ocamldep.Dep_graphs.dummy m)); if Library.has_stubs lib then begin let h_files = @@ -799,32 +804,30 @@ module Gen(P : Install_rules.Params) = struct +-----------------------------------------------------------------+ *) let executables_rules ~dir ~all_modules - ?modules_partitioner ~scope ~compile_info + ~modules_partitioner ~scope ~compile_info (exes : Executables.t) = let requires = Lib.Compile.requires compile_info in let modules = parse_modules ~all_modules ~buildable:exes.buildable in - let already_used = - match modules_partitioner with - | None -> Module.Name.Set.empty - | Some mp -> - Modules_partitioner.acknowledge mp - ~loc:exes.buildable.loc ~modules - in - let modules = - let preprocessor_deps = - SC.Deps.interpret sctx exes.buildable.preprocessor_deps - ~scope ~dir - in - Preprocessing.pp_and_lint_modules sctx ~dir ~dep_kind:Required ~modules + let preprocessor_deps = + SC.Deps.interpret sctx exes.buildable.preprocessor_deps + ~scope ~dir + in + let pp = + Preprocessing.make sctx ~dir ~dep_kind:Required ~scope ~preprocess:exes.buildable.preprocess ~preprocessor_deps ~lint:exes.buildable.lint ~lib_name:None in + let modules = + Module.Name.Map.map modules ~f:(fun m -> + Preprocessing.pp_module_as pp m.name m + |> Module.set_obj_name ~wrapper:None) + in let programs = List.map exes.names ~f:(fun (loc, name) -> @@ -873,16 +876,27 @@ module Gen(P : Install_rules.Params) = struct let obj_dir = Utils.executable_object_directory ~dir (List.hd programs).name in - Exe.build_and_link_many sctx - ~dir - ~obj_dir + + let cctx = + Compilation_context.create () + ~super_context:sctx + ~scope + ~dir + ~obj_dir + ~modules + ~flags + ~requires + ~preprocessing:pp + in + let already_used = + Modules_partitioner.acknowledge modules_partitioner cctx + ~loc:exes.buildable.loc ~modules + in + + Exe.build_and_link_many cctx ~programs - ~modules ~already_used - ~scope ~linkages - ~requires - ~flags ~link_flags ~js_of_ocaml:exes.buildable.js_of_ocaml; @@ -893,7 +907,7 @@ module Gen(P : Install_rules.Params) = struct ~objs_dirs:(Path.Set.singleton obj_dir) let executables_rules ~dir ~all_modules - ?modules_partitioner ~scope (exes : Executables.t) = + ~modules_partitioner ~scope (exes : Executables.t) = let compile_info = Lib.DB.resolve_user_written_deps (Scope.libs scope) exes.buildable.libraries @@ -904,7 +918,7 @@ module Gen(P : Install_rules.Params) = struct SC.Libs.with_lib_deps sctx compile_info ~dir ~f:(fun () -> executables_rules exes ~dir ~all_modules - ?modules_partitioner ~scope ~compile_info) + ~modules_partitioner ~scope ~compile_info) (* +-----------------------------------------------------------------+ | Aliases | @@ -951,39 +965,56 @@ module Gen(P : Install_rules.Params) = struct (* This interprets "rule" and "copy_files" stanzas. *) let files = text_files ~dir:ctx_dir in let all_modules = modules_by_dir ~dir:ctx_dir in - let modules_partitioner = Modules_partitioner.create ~all_modules in - List.filter_map stanzas ~f:(fun stanza -> - let dir = ctx_dir in - match (stanza : Stanza.t) with - | Library lib -> - Some (library_rules lib ~dir ~files ~scope ~modules_partitioner) - | Executables exes -> - Some (executables_rules exes ~dir ~all_modules ~scope - ~modules_partitioner) - | Alias alias -> - alias_rules alias ~dir ~scope; - None - | Copy_files { glob; _ } -> - let src_dir = - let loc = String_with_vars.loc glob in - let src_glob = SC.expand_vars sctx ~dir glob ~scope in - Path.parent_exn (Path.relative src_dir src_glob ~error_loc:loc) - in - Some - (Merlin.make () - ~source_dirs:(Path.Set.singleton src_dir)) - | _ -> None) - |> Merlin.merge_all - |> Option.map ~f:(fun m -> Merlin.add_source_dir m src_dir) - |> Option.iter ~f:(Merlin.add_rules sctx ~dir:ctx_dir ~scope); - Utop.setup sctx ~dir:ctx_dir ~libs:( - List.filter_map stanzas ~f:(function - | Stanza.Library lib -> Some lib + let modules_partitioner = Modules_partitioner.create () in + let merlins = + List.filter_map stanzas ~f:(fun stanza -> + let dir = ctx_dir in + match (stanza : Stanza.t) with + | Library lib -> + Some (library_rules lib ~dir ~files ~scope ~modules_partitioner) + | Executables exes -> + Some (executables_rules exes ~dir ~all_modules ~scope + ~modules_partitioner) + | Alias alias -> + alias_rules alias ~dir ~scope; + None + | Copy_files { glob; _ } -> + let src_dir = + let loc = String_with_vars.loc glob in + let src_glob = SC.expand_vars sctx ~dir glob ~scope in + Path.parent_exn (Path.relative src_dir src_glob ~error_loc:loc) + in + Some + (Merlin.make () + ~source_dirs:(Path.Set.singleton src_dir)) | _ -> None) - ) ~scope; + in + Option.iter (Merlin.merge_all merlins) ~f:(fun m -> + Merlin.add_rules sctx ~dir:ctx_dir ~scope + (Merlin.add_source_dir m src_dir)); + Utop.setup sctx ~dir:ctx_dir ~scope ~libs:( + List.filter_map stanzas ~f:(function + | Library lib -> Some lib + | _ -> None)); + List.iter stanzas ~f:(fun stanza -> + match (stanza : Stanza.t) with + | Menhir m -> + let cctx = + match + List.find_map (Menhir_rules.module_names m) + ~f:(Modules_partitioner.find modules_partitioner) + with + | None -> + Loc.fail m.loc + "I can't determine what library/executable the files produced \ + by this stanza are part of." + | Some cctx -> cctx + in + Menhir_rules.gen_rules cctx m + | _ -> ()); Modules_partitioner.emit_warnings modules_partitioner - let gen_rules ~dir components : Build_system.extra_sub_directories_to_keep = + let gen_rules ~dir components : Build_system.extra_sub_directories_to_keep = (match components with | ".js" :: rest -> Js_of_ocaml_rules.setup_separate_compilation_rules sctx rest diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 05d4efc2..31d9ea5b 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -185,7 +185,7 @@ include Sub_system.Register_end_point( ; syntax = OCaml } ; intf = None - ; obj_name = "" + ; obj_name = name } in @@ -239,16 +239,19 @@ include Sub_system.Register_end_point( >>> Build.action_dyn ~targets:[target] ()); - Exe.build_and_link sctx - ~dir:inline_test_dir - ~obj_dir:inline_test_dir + let cctx = + Compilation_context.create () + ~super_context:sctx + ~scope + ~dir:inline_test_dir + ~modules + ~requires:runner_libs + ~flags:(Ocaml_flags.of_list ["-w"; "-24"]); + in + Exe.build_and_link cctx ~program:{ name; main_module_name } - ~modules - ~scope ~linkages:[Exe.Linkage.native_or_custom (SC.context sctx)] - ~requires:runner_libs - ~link_flags:(Build.return ["-linkall"]) - ~flags:(Ocaml_flags.of_list ["-w"; "-24"]); + ~link_flags:(Build.return ["-linkall"]); let flags = let flags = diff --git a/src/jbuild.ml b/src/jbuild.ml index efc6082d..61a5ca6d 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -1217,27 +1217,23 @@ module Env = struct "S-expression of the form ( ) expected" end -module Stanza = struct - type t = - | Library of Library.t - | Executables of Executables.t - | Rule of Rule.t - | Provides of Provides.t - | Install of Install_conf.t - | Alias of Alias_conf.t - | Copy_files of Copy_files.t - | Menhir of Menhir.t - | Documentation of Documentation.t - | Env of Env.t -end +type Stanza.t += + | Library of Library.t + | Executables of Executables.t + | Rule of Rule.t + | Provides of Provides.t + | Install of Install_conf.t + | Alias of Alias_conf.t + | Copy_files of Copy_files.t + | Menhir of Menhir.t + | Documentation of Documentation.t + | Env of Env.t module Stanzas = struct type t = Stanza.t list type syntax = OCaml | Plain - open Stanza - let rules l = List.map l ~f:(fun x -> Rule x) let execs (exe, install) = @@ -1245,9 +1241,9 @@ module Stanzas = struct | None -> [Executables exe] | Some i -> [Executables exe; Install i] - exception Include_loop of Path.t * (Loc.t * Path.t) list + type Stanza.t += Include of Loc.t * string - let rec v1 project ~file ~include_stack : Stanza.t list Sexp.Of_sexp.t = + let t project : Stanza.t list Sexp.Of_sexp.t = sum [ cstr "library" (Library.v1 project @> nil) (fun x -> [Library x]) ; cstr "executable" (Executables.v1_single project @> nil) execs @@ -1270,70 +1266,55 @@ module Stanzas = struct (* Just for validation and error messages *) ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> []) ; cstr "include" (cstr_loc (relative_file @> nil)) (fun loc fn -> - let include_stack = (loc, file) :: include_stack in - let dir = Path.parent_exn file in - let file = Path.relative dir fn in - if not (Path.exists file) then - Loc.fail loc "File %s doesn't exist." - (Path.to_string_maybe_quoted file); - if List.exists include_stack ~f:(fun (_, f) -> f = file) then - raise (Include_loop (file, include_stack)); - let sexps = Io.Sexp.load file ~mode:Many in - parse project sexps ~default_version:Jbuild_version.V1 ~file ~include_stack) + [Include (loc, fn)]) ; cstr "documentation" (Documentation.v1 project @> nil) (fun d -> [Documentation d]) ] - and select - : Jbuild_version.t - -> Dune_project.t - -> file:Path.t - -> include_stack:(Loc.t * Path.t) list - -> Stanza.t list Sexp.Of_sexp.t = function - | V1 -> v1 + exception Include_loop of Path.t * (Loc.t * Path.t) list - and parse ~default_version ~file ~include_stack project sexps = - let versions, sexps = - List.partition_map sexps ~f:(function - | List (loc, [Atom (_, A "jbuild_version"); ver]) -> - Left (Jbuild_version.t ver, loc) - | sexp -> Right sexp) + let rec parse t ~current_file ~include_stack sexps = + List.concat_map sexps ~f:t + |> List.concat_map ~f:(function + | Include (loc, fn) -> + let include_stack = (loc, current_file) :: include_stack in + let dir = Path.parent_exn current_file in + let current_file = Path.relative dir fn in + if not (Path.exists current_file) then + Loc.fail loc "File %s doesn't exist." + (Path.to_string_maybe_quoted current_file); + if List.exists include_stack ~f:(fun (_, f) -> f = current_file) then + raise (Include_loop (current_file, include_stack)); + let sexps = Io.Sexp.load current_file ~mode:Many in + parse t sexps ~current_file ~include_stack + | stanza -> [stanza]) + + let parse ~file project sexps = + let stanzas = + try + parse (t project) sexps ~include_stack:[] ~current_file:file + with + | Include_loop (_, []) -> assert false + | Include_loop (file, last :: rest) -> + let loc = fst (Option.value (List.last rest) ~default:last) in + let line_loc (loc, file) = + sprintf "%s:%d" + (Path.to_string_maybe_quoted file) + loc.Loc.start.pos_lnum + in + Loc.fail loc + "Recursive inclusion of jbuild files detected:\n\ + File %s is included from %s%s" + (Path.to_string_maybe_quoted file) + (line_loc last) + (String.concat ~sep:"" + (List.map rest ~f:(fun x -> + sprintf + "\n--> included from %s" + (line_loc x)))) in - let version = - match versions with - | [] -> default_version - | [(v, _)] -> v - | _ :: (_, loc) :: _ -> - Loc.fail loc "jbuild_version specified too many times" - in - let l = - List.concat_map sexps ~f:(select version project ~file ~include_stack) - in - match List.filter_map l ~f:(function Env e -> Some e | _ -> None) with + match List.filter_map stanzas ~f:(function Env e -> Some e | _ -> None) with | _ :: e :: _ -> Loc.fail e.loc "The 'env' stanza cannot appear more than once" - | _ -> l - - let parse ?(default_version=Jbuild_version.latest_stable) ~file project sexps = - try - parse project sexps ~default_version ~include_stack:[] ~file - with - | Include_loop (_, []) -> assert false - | Include_loop (file, last :: rest) -> - let loc = fst (Option.value (List.last rest) ~default:last) in - let line_loc (loc, file) = - sprintf "%s:%d" - (Path.to_string_maybe_quoted file) - loc.Loc.start.pos_lnum - in - Loc.fail loc - "Recursive inclusion of jbuild files detected:\n\ - File %s is included from %s%s" - (Path.to_string_maybe_quoted file) - (line_loc last) - (String.concat ~sep:"" - (List.map rest ~f:(fun x -> - sprintf - "\n--> included from %s" - (line_loc x)))) + | _ -> stanzas end diff --git a/src/jbuild.mli b/src/jbuild.mli index a3f7f727..cc633719 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -352,19 +352,17 @@ module Env : sig } end -module Stanza : sig - type t = - | Library of Library.t - | Executables of Executables.t - | Rule of Rule.t - | Provides of Provides.t - | Install of Install_conf.t - | Alias of Alias_conf.t - | Copy_files of Copy_files.t - | Menhir of Menhir.t - | Documentation of Documentation.t - | Env of Env.t -end +type Stanza.t += + | Library of Library.t + | Executables of Executables.t + | Rule of Rule.t + | Provides of Provides.t + | Install of Install_conf.t + | Alias of Alias_conf.t + | Copy_files of Copy_files.t + | Menhir of Menhir.t + | Documentation of Documentation.t + | Env of Env.t module Stanzas : sig type t = Stanza.t list @@ -372,8 +370,7 @@ module Stanzas : sig type syntax = OCaml | Plain val parse - : ?default_version:Jbuild_version.t - -> file:Path.t + : file:Path.t -> Dune_project.t -> Sexp.Ast.t list -> t diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 6ece5b24..5c390f7b 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -4,7 +4,7 @@ open Jbuild let filter_stanzas ~ignore_promoted_rules stanzas = if ignore_promoted_rules then List.filter stanzas ~f:(function - | Stanza.Rule { mode = Promote; _ } -> false + | Rule { mode = Promote; _ } -> false | _ -> true) else stanzas diff --git a/src/menhir.ml b/src/menhir.ml index 5c3e6146..0aa756cc 100644 --- a/src/menhir.ml +++ b/src/menhir.ml @@ -80,10 +80,8 @@ module Run (P : PARAMS) = struct let menhir (args : args) = flags >>> Build.run menhir_binary ~dir ~context args - (* The function [rule] adds a rule and returns the list of its targets. *) - - let rule : (unit, Action.t) Build.t -> Path.t list = - SC.add_rule_get_targets sctx ~mode:stanza.mode ~loc:stanza.loc + let rule : (unit, Action.t) Build.t -> unit = + SC.add_rule sctx ~mode:stanza.mode ~loc:stanza.loc (* If there is no [base] clause, then a stanza that mentions several modules is equivalent to a list of stanzas, each of which mentions one module, so @@ -119,7 +117,7 @@ module Run (P : PARAMS) = struct *) - let process (stanza : stanza) : Path.t list = + let process (stanza : stanza) = let base : string = Option.value_exn stanza.merge_into in let args : args = [ Dyn (fun flags -> As flags) @@ -132,8 +130,8 @@ module Run (P : PARAMS) = struct (* The main side effect. *) - let targets = - List.concat_map ~f:process stanzas + let () = + List.iter ~f:process stanzas end @@ -141,11 +139,22 @@ end (* The final glue. *) -let gen_rules sctx ~dir ~scope stanza = +let targets (stanza : Jbuild.Menhir.t) = + let f m = [m ^ ".ml"; m ^ ".mli"] in + match stanza.merge_into with + | Some m -> f m + | None -> List.concat_map stanza.modules ~f + +let module_names (stanza : Jbuild.Menhir.t) = + match stanza.merge_into with + | Some m -> [Module.Name.of_string m] + | None -> List.map stanza.modules ~f:Module.Name.of_string + +let gen_rules cctx stanza = let module R = Run(struct - let sctx = sctx - let dir = dir - let scope = scope + let sctx = Compilation_context.super_context cctx + let dir = Compilation_context.dir cctx + let scope = Compilation_context.scope cctx let stanza = stanza end) in - R.targets + () diff --git a/src/menhir.mli b/src/menhir.mli index 23f9ab24..36c5c6af 100644 --- a/src/menhir.mli +++ b/src/menhir.mli @@ -1,14 +1,15 @@ (** Menhir rules *) -open Stdune +(** Return the list of targets that are generated by this stanza. This + list of targets is used by the code that computes the list of + modules in the directory. *) +val targets : Jbuild.Menhir.t -> string list -(** Generate the rules for a [(menhir ...)] stanza. Return the list of - targets that are generated by these rules. This list of targets is - used by the code that computes the list of modules in the - directory. *) +(** Return the list of modules that are generated by this stanza. *) +val module_names : Jbuild.Menhir.t -> Module.Name.t list + +(** Generate the rules for a [(menhir ...)] stanza. *) val gen_rules - : Super_context.t - -> dir:Path.t - -> scope:Scope.t + : Compilation_context.t -> Jbuild.Menhir.t - -> Path.t list + -> unit diff --git a/src/module_compilation.ml b/src/module_compilation.ml index 399ef1e6..7736e5bd 100644 --- a/src/module_compilation.ml +++ b/src/module_compilation.ml @@ -2,6 +2,7 @@ open Import open Build.O open! No_io +module CC = Compilation_context module SC = Super_context module Target : sig @@ -18,9 +19,11 @@ end = struct let file dir t = Path.append dir t end -let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~dep_graphs - ~includes ~dir ~obj_dir ~alias_module (m : Module.t) = - let ctx = SC.context sctx in +let build_cm cctx ?sandbox ?(dynlink=true) ~dep_graphs ~cm_kind (m : Module.t) = + 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 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 -> let ml_kind = Cm_kind.source cm_kind in @@ -89,16 +92,16 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~dep_graphs SC.add_rule sctx ?sandbox (Build.paths extra_deps >>> other_cm_files >>> - Ocaml_flags.get_for_cm flags ~cm_kind >>> + Ocaml_flags.get_for_cm (CC.flags cctx) ~cm_kind >>> Build.run ~context:ctx (Ok compiler) [ Dyn (fun ocaml_flags -> As ocaml_flags) ; cmt_args ; A "-I"; Path obj_dir - ; includes + ; Cm_kind.Dict.get (CC.includes cctx) cm_kind ; As extra_args ; if dynlink || cm_kind <> Cmx then As [] else A "-nodynlink" ; A "-no-alias-deps"; opaque - ; (match alias_module with + ; (match CC.alias_module cctx with | None -> S [] | Some (m : Module.t) -> As ["-open"; Module.Name.to_string m.name]) @@ -107,51 +110,56 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~dep_graphs ; Hidden_targets hidden_targets ]))) -let build_module sctx ?sandbox ~dynlink ~js_of_ocaml ~flags m ~scope ~dir - ~obj_dir ~dep_graphs ~includes ~alias_module = +let build_module ?sandbox ?js_of_ocaml ?dynlink ~dep_graphs cctx m = List.iter Cm_kind.all ~f:(fun cm_kind -> - let includes = Cm_kind.Dict.get includes cm_kind in - build_cm sctx ?sandbox ~dynlink ~flags ~dir ~obj_dir ~dep_graphs m ~cm_kind - ~includes ~alias_module); - (* Build *.cmo.js *) - let src = Module.cm_file_unsafe m ~obj_dir Cm_kind.Cmo in - let target = - Path.extend_basename (Module.cm_file_unsafe m ~obj_dir:dir Cm_kind.Cmo) - ~suffix:".js" - in - SC.add_rules sctx - (Js_of_ocaml_rules.build_cm sctx ~scope ~dir ~js_of_ocaml ~src ~target) + build_cm cctx m ?sandbox ?dynlink ~dep_graphs ~cm_kind); + Option.iter js_of_ocaml ~f:(fun js_of_ocaml -> + (* Build *.cmo.js *) + let sctx = CC.super_context cctx in + let scope = CC.scope cctx in + let dir = CC.dir cctx in + let obj_dir = CC.obj_dir cctx in + let src = Module.cm_file_unsafe m ~obj_dir Cm_kind.Cmo in + let target = + Path.extend_basename (Module.cm_file_unsafe m ~obj_dir:dir Cm_kind.Cmo) + ~suffix:".js" + in + SC.add_rules sctx + (Js_of_ocaml_rules.build_cm sctx ~scope ~dir ~js_of_ocaml ~src ~target)) -let build_modules sctx ~dynlink ~js_of_ocaml ~flags ~scope ~dir ~obj_dir - ~dep_graphs ~modules ~requires ~alias_module = - let includes : _ Cm_kind.Dict.t = - match requires with - | Error exn -> Cm_kind.Dict.make_all (Arg_spec.Dyn (fun _ -> raise exn)) - | Ok libs -> - let iflags = - Lib.L.include_flags libs ~stdlib_dir:(SC.context sctx).stdlib_dir - in - let cmi_includes = - Arg_spec.S [ iflags - ; Hidden_deps - (SC.Libs.file_deps sctx libs ~ext:".cmi") - ] - in - let cmi_and_cmx_includes = - Arg_spec.S [ iflags - ; Hidden_deps - (SC.Libs.file_deps sctx libs ~ext:".cmi-and-.cmx") - ] - in - { cmi = cmi_includes - ; cmo = cmi_includes - ; cmx = cmi_and_cmx_includes - } - in +let build_modules ?sandbox ?js_of_ocaml ?dynlink ~dep_graphs cctx = Module.Name.Map.iter - (match alias_module with - | None -> modules - | Some (m : Module.t) -> Module.Name.Map.remove modules m.name) - ~f:(fun m -> - build_module sctx m ~dynlink ~js_of_ocaml ~flags ~scope ~dir ~obj_dir - ~dep_graphs ~includes ~alias_module) + (match CC.alias_module cctx with + | None -> CC.modules cctx + | Some (m : Module.t) -> Module.Name.Map.remove (CC.modules cctx) m.name) + ~f:(build_module cctx ?sandbox ?js_of_ocaml ?dynlink ~dep_graphs) + +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 dep_graph = Ml_kind.Dict.get dep_graphs Impl in + let cm_deps = + Build.dyn_paths + (Ocamldep.Dep_graph.deps_of dep_graph m >>^ fun deps -> + List.concat_map deps + ~f:(fun m -> [Module.cm_file_unsafe m ~obj_dir Cmi])) + in + SC.add_rule sctx ?sandbox + (cm_deps >>> + Ocaml_flags.get_for_cm (CC.flags cctx) ~cm_kind:Cmo >>> + Build.run ~context:ctx (Ok ctx.ocamlc) + [ Dyn (fun ocaml_flags -> As ocaml_flags) + ; A "-I"; Path obj_dir + ; Cm_kind.Dict.get (CC.includes cctx) Cmo + ; (match CC.alias_module cctx with + | None -> S [] + | Some (m : Module.t) -> + As ["-open"; Module.Name.to_string m.name]) + ; As flags + ; A "-i"; Ml_kind.flag Impl; Dep src + ] + >>^ (fun act -> Action.with_stdout_to output act) + >>> Build.action_dyn () ~targets:[output]) diff --git a/src/module_compilation.mli b/src/module_compilation.mli index 172fb92e..e57bda36 100644 --- a/src/module_compilation.mli +++ b/src/module_compilation.mli @@ -4,31 +4,28 @@ open Import (** Setup rules to build a single module. *) val build_module - : Super_context.t - -> ?sandbox:bool - -> dynlink:bool - -> js_of_ocaml:Jbuild.Js_of_ocaml.t - -> flags:Ocaml_flags.t - -> Module.t - -> scope:Scope.t - -> dir:Path.t - -> obj_dir:Path.t + : ?sandbox:bool + -> ?js_of_ocaml:Jbuild.Js_of_ocaml.t + -> ?dynlink:bool -> dep_graphs:Ocamldep.Dep_graphs.t - -> includes:string list Arg_spec.t Cm_kind.Dict.t - -> alias_module:Module.t option + -> Compilation_context.t + -> Module.t -> unit -(** Setup rules to build all of [modules] *) +(** Setup rules to build all of the modules in the compilation context. *) val build_modules - : Super_context.t - -> dynlink:bool - -> js_of_ocaml:Jbuild.Js_of_ocaml.t - -> flags:Ocaml_flags.t - -> scope:Scope.t - -> dir:Path.t - -> obj_dir:Path.t + : ?sandbox:bool + -> ?js_of_ocaml:Jbuild.Js_of_ocaml.t + -> ?dynlink:bool -> dep_graphs:Ocamldep.Dep_graphs.t - -> modules:Module.t Module.Name.Map.t - -> requires:Lib.t list Or_exn.t - -> alias_module:Module.t option + -> Compilation_context.t + -> unit + +val ocamlc_i + : ?sandbox:bool + -> ?flags:string list + -> dep_graphs:Ocamldep.Dep_graphs.t + -> Compilation_context.t + -> Module.t + -> output:Path.t -> unit diff --git a/src/modules_partitioner.ml b/src/modules_partitioner.ml index 4ffd49f2..c0ce4802 100644 --- a/src/modules_partitioner.ml +++ b/src/modules_partitioner.ml @@ -1,16 +1,14 @@ open Import -type t = - { all_modules : Module.t Module.Name.Map.t - ; mutable used : Loc.t list Module.Name.Map.t +type 'a t = + { mutable used : ('a * Loc.t list) Module.Name.Map.t } -let create ~all_modules = - { all_modules - ; used = Module.Name.Map.empty +let create () = + { used = Module.Name.Map.empty } -let acknowledge t ~loc ~modules = +let acknowledge t part ~loc ~modules = let already_used = Module.Name.Map.merge modules t.used ~f:(fun _name x l -> Option.some_if (Option.is_some x && Option.is_some l) ()) @@ -18,14 +16,20 @@ let acknowledge t ~loc ~modules = |> Module.Name.Set.of_list in t.used <- - Module.Name.Map.merge modules t.used ~f:(fun _name x l -> + Module.Name.Map.merge modules t.used ~f:(fun _name x y -> match x with - | None -> l - | Some _ -> Some (loc :: Option.value l ~default:[])); + | None -> y + | Some _ -> + Some (part, + loc :: match y with + | None -> [] + | Some (_, l) -> l)); already_used +let find t name = Option.map (Module.Name.Map.find t.used name) ~f:fst + let emit_warnings t = - Module.Name.Map.iteri t.used ~f:(fun name locs -> + Module.Name.Map.iteri t.used ~f:(fun name (_, locs) -> match locs with | [] | [_] -> () | loc :: _ -> diff --git a/src/modules_partitioner.mli b/src/modules_partitioner.mli index 8e9d3a27..ae05eb15 100644 --- a/src/modules_partitioner.mli +++ b/src/modules_partitioner.mli @@ -2,24 +2,26 @@ open! Stdune -type t +type 'a t -val create - : all_modules:Module.t Module.Name.Map.t - -> t +val create : unit -> 'a t -(** [acknowledge t ~loc ~modules] registers the fact that [modules] +(** [acknowledge t partition ~loc ~modules] registers the fact that [modules] are associated with [loc]. Returns the set of modules that are already used at another location. *) val acknowledge - : t + : 'a t + -> 'a -> loc:Loc.t -> modules:Module.t Module.Name.Map.t -> Module.Name.Set.t +(** Find which partition a module is part of *) +val find : 'a t -> Module.Name.t -> 'a option + (** To be called after processing a directory. Emit warnings about detected problems *) -val emit_warnings : t -> unit +val emit_warnings : _ t -> unit diff --git a/src/ocamldep.ml b/src/ocamldep.ml index 0ef535cc..da2db71c 100644 --- a/src/ocamldep.ml +++ b/src/ocamldep.ml @@ -1,6 +1,7 @@ open Import open Build.O +module CC = Compilation_context module SC = Super_context module Dep_graph = struct @@ -66,8 +67,16 @@ let parse_module_names ~(unit : Module.t) ~modules words = else Module.Name.Map.find modules m) -let parse_deps ~dir ~file ~unit - ~modules ~alias_module ~lib_interface_module lines = +let is_alias_module cctx (m : Module.t) = + match CC.alias_module cctx with + | None -> false + | Some alias -> alias.name = m.name + +let parse_deps cctx ~file ~unit lines = + let dir = CC.dir cctx in + let alias_module = CC.alias_module cctx in + let lib_interface_module = CC.lib_interface_module cctx in + let modules = CC.modules cctx in let invalid () = die "ocamldep returned unexpected output for %s:\n\ %s" @@ -94,12 +103,7 @@ let parse_deps ~dir ~file ~unit (match lib_interface_module with | None -> () | Some (m : Module.t) -> - let is_alias_module = - match alias_module with - | None -> false - | Some (m : Module.t) -> unit.name = m.name - in - if unit.name <> m.name && not is_alias_module && + if unit.name <> m.name && not (is_alias_module cctx unit) && List.exists deps ~f:(fun x -> Module.name x = m.name) then die "Module %a in directory %s depends on %a.\n\ This doesn't make sense to me.\n\ @@ -116,66 +120,70 @@ let parse_deps ~dir ~file ~unit | None -> deps | Some m -> m :: deps -let rules ~(ml_kind:Ml_kind.t) ~dir ~modules - ?(already_used=Module.Name.Set.empty) - ~alias_module ~lib_interface_module sctx = - let is_alias_module (m : Module.t) = - match alias_module with - | None -> false - | Some (alias : Module.t) -> alias.name = m.name - in - let per_module = - Module.Name.Map.map modules ~f:(fun unit -> - match Module.file ~dir unit ml_kind with - | _ when is_alias_module unit -> Build.return [] - | None -> Build.return [] - | Some file -> - let all_deps_path file = - Path.extend_basename file ~suffix:".all-deps" - in - let context = SC.context sctx in - let all_deps_file = all_deps_path file in - let ocamldep_output = Path.extend_basename file ~suffix:".d" in - if not (Module.Name.Set.mem already_used unit.name) then - begin - SC.add_rule sctx - ( Build.run ~context (Ok context.ocamldep) - [A "-modules"; Ml_kind.flag ml_kind; Dep file] - ~stdout_to:ocamldep_output - ); - let build_paths dependencies = - let dependency_file_path m = - let path = +let deps_of cctx ~ml_kind ~already_used 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 + | None -> Build.return [] + | Some file -> + let all_deps_path file = + Path.extend_basename file ~suffix:".all-deps" + in + let context = SC.context sctx in + let all_deps_file = all_deps_path file in + let ocamldep_output = Path.extend_basename file ~suffix:".d" in + if not (Module.Name.Set.mem already_used unit.name) then + begin + SC.add_rule sctx + ( Build.run ~context (Ok context.ocamldep) + [A "-modules"; Ml_kind.flag ml_kind; Dep file] + ~stdout_to:ocamldep_output + ); + let build_paths dependencies = + let dependency_file_path m = + let path = + if is_alias_module cctx m then + None + else match Module.file ~dir m Ml_kind.Intf with - | _ when is_alias_module m -> None | Some _ as x -> x | None -> Module.file ~dir m Ml_kind.Impl - in - Option.map path ~f:all_deps_path in - List.filter_map dependencies ~f:dependency_file_path + Option.map path ~f:all_deps_path in - SC.add_rule sctx - ( Build.lines_of ocamldep_output - >>^ parse_deps - ~dir ~file ~unit ~modules ~alias_module - ~lib_interface_module - >>^ (fun modules -> - (build_paths modules, - List.map modules ~f:(fun m -> - Module.Name.to_string (Module.name m)) - )) - >>> Build.merge_files_dyn ~target:all_deps_file) - end; - Build.memoize (Path.to_string all_deps_file) - ( Build.lines_of all_deps_file - >>^ parse_module_names ~unit ~modules)) - in - { Dep_graph. - dir - ; per_module - } + List.filter_map dependencies ~f:dependency_file_path + in + SC.add_rule sctx + ( Build.lines_of ocamldep_output + >>^ parse_deps cctx ~file ~unit + >>^ (fun modules -> + (build_paths modules, + List.map modules ~f:(fun m -> + Module.Name.to_string (Module.name m)) + )) + >>> Build.merge_files_dyn ~target:all_deps_file) + end; + Build.memoize (Path.to_string all_deps_file) + ( Build.lines_of all_deps_file + >>^ parse_module_names ~unit ~modules:(CC.modules cctx)) -let rules ~dir ~modules ?already_used ~alias_module ~lib_interface_module sctx = - Ml_kind.Dict.of_func (rules sctx ~dir ~modules ?already_used ~alias_module - ~lib_interface_module) +let rules_generic ?(already_used=Module.Name.Set.empty) cctx ~modules = + Ml_kind.Dict.of_func + (fun ~ml_kind -> + let per_module = + Module.Name.Map.map modules + ~f:(deps_of cctx ~already_used ~ml_kind) + in + { Dep_graph. + dir = CC.dir cctx + ; per_module + }) + +let rules ?already_used cctx = + rules_generic ?already_used cctx ~modules:(CC.modules cctx) + +let rules_for_auxiliary_module cctx (m : Module.t) = + rules_generic cctx ~modules:(Module.Name.Map.singleton m.name m) diff --git a/src/ocamldep.mli b/src/ocamldep.mli index c350c20e..cf8f48a3 100644 --- a/src/ocamldep.mli +++ b/src/ocamldep.mli @@ -1,7 +1,5 @@ (** ocamldep management *) -open Stdune - module Dep_graph : sig type t @@ -22,23 +20,18 @@ module Dep_graphs : sig val dummy : Module.t -> t end -(** Generate ocamldep rules for the given modules. [item] is either - the internal name of a library of the first name of a list of - executables. - - For wrapped libraries, [lib_interface_module] is the main module - of the library. +(** Generate ocamldep rules for all the modules in the context. [already_used] represents the modules that are used by another stanzas in the same directory. No [.d] rule will be generated for - such modules. - - Return arrows that evaluate to the dependency graphs. *) + such modules. *) val rules - : dir:Path.t - -> modules:Module.t Module.Name.Map.t - -> ?already_used:Module.Name.Set.t - -> alias_module:Module.t option - -> lib_interface_module:Module.t option - -> Super_context.t + : ?already_used:Module.Name.Set.t + -> Compilation_context.t + -> Dep_graphs.t + +(** Compute the dependencies of an auxiliary module. *) +val rules_for_auxiliary_module + : Compilation_context.t + -> Module.t -> Dep_graphs.t diff --git a/src/odoc.ml b/src/odoc.ml index 5e620be6..d4e7bfc6 100644 --- a/src/odoc.ml +++ b/src/odoc.ml @@ -471,7 +471,7 @@ module Gen (S : sig val sctx : SC.t end) = struct SC.stanzas sctx |> List.concat_map ~f:(fun (w : SC.Dir_with_jbuild.t) -> List.filter_map w.stanzas ~f:(function - | Jbuild.Stanza.Documentation (d : Jbuild.Documentation.t) -> + | Documentation (d : Jbuild.Documentation.t) -> Some (d.package.name, (w.ctx_dir, d)) | _ -> None @@ -494,7 +494,7 @@ module Gen (S : sig val sctx : SC.t end) = struct SC.stanzas sctx |> List.concat_map ~f:(fun (w : SC.Dir_with_jbuild.t) -> List.filter_map w.stanzas ~f:(function - | Jbuild.Stanza.Library (l : Library.t) -> + | Jbuild.Library (l : Library.t) -> Some ((w.ctx_dir, Library.best_name l), l) | _ -> None @@ -532,7 +532,7 @@ module Gen (S : sig val sctx : SC.t end) = struct (SC.stanzas sctx |> List.concat_map ~f:(fun (w : SC.Dir_with_jbuild.t) -> List.filter_map w.stanzas ~f:(function - | Jbuild.Stanza.Library (l : Jbuild.Library.t) -> + | Jbuild.Library (l : Jbuild.Library.t) -> begin match l.public with | Some _ -> None | None -> @@ -541,7 +541,7 @@ module Gen (S : sig val sctx : SC.t end) = struct Lib.DB.find_even_when_hidden (Scope.libs scope) l.name) ) end - | (_ : Jbuild.Stanza.t) -> None + | _ -> None )) |> List.map ~f:(fun (lib : Lib.t) -> Build_system.Alias.stamp_file (Dep.alias (Lib lib))) diff --git a/src/preprocessing.ml b/src/preprocessing.ml index a933cc93..a56e188c 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -293,9 +293,11 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope = Staged.stage ( fun ~(source : Module.t) ~ast -> Per_module.get lint source.name ~source ~ast) -(* Generate rules to build the .pp files and return a new module map - where all filenames point to the .pp files *) -let pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~lint ~preprocess +type t = (Module.t -> lint:bool -> Module.t) Per_module.t + +let dummy = Per_module.for_all (fun m ~lint:_ -> m) + +let make sctx ~dir ~dep_kind ~lint ~preprocess ~preprocessor_deps ~lib_name ~scope = let preprocessor_deps = Build.memoize "preprocessor deps" preprocessor_deps @@ -303,62 +305,65 @@ let pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~lint ~preprocess let lint_module = Staged.unstage (lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope) in - let preprocess = - Per_module.map preprocess ~f:(function - | Preprocess.No_preprocessing -> - (fun m -> - let ast = setup_reason_rules sctx ~dir m in - lint_module ~ast ~source:m; - ast) - | Action (loc, action) -> - (fun m -> - let ast = - pped_module m ~dir ~f:(fun _kind src dst -> - SC.add_rule sctx - (preprocessor_deps - >>> - Build.path src - >>^ (fun _ -> [src]) - >>> - SC.Action.run sctx - (Redirect - (Stdout, - target_var, - Chdir (root_var, - action))) - ~loc - ~dir - ~dep_kind - ~targets:(Static [dst]) - ~scope)) - |> setup_reason_rules sctx ~dir in - lint_module ~ast ~source:m; - ast) - | Pps { pps; flags } -> - let ppx_exe = get_ppx_driver sctx ~scope pps in - let uses_ppx_driver = uses_ppx_driver ~pps in - let args : _ Arg_spec.t = - S [ As flags - ; A "--dump-ast" - ; As (cookie_library_name lib_name) - ; As (if uses_ppx_driver then ["-diff-cmd"; "-"] else []) - ] - in - (fun m -> - let ast = setup_reason_rules sctx ~dir m in - lint_module ~ast ~source:m; - pped_module ast ~dir ~f:(fun kind src dst -> + Per_module.map preprocess ~f:(function + | Preprocess.No_preprocessing -> + (fun m ~lint -> + let ast = setup_reason_rules sctx ~dir 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 -> SC.add_rule sctx - (promote_correction ~uses_ppx_driver - (Option.value_exn (Module.file m ~dir kind)) - (preprocessor_deps - >>> - Build.run ~context:(SC.context sctx) - (Ok ppx_exe) - [ args - ; A "-o"; Target dst - ; Ml_kind.ppx_driver_flag kind; Dep src - ]))))) - in - Module.Name.Map.map modules ~f:(fun (m : Module.t) -> - Per_module.get preprocess m.name m) + (preprocessor_deps + >>> + Build.path src + >>^ (fun _ -> [src]) + >>> + SC.Action.run sctx + (Redirect + (Stdout, + target_var, + Chdir (root_var, + action))) + ~loc + ~dir + ~dep_kind + ~targets:(Static [dst]) + ~scope)) + |> setup_reason_rules sctx ~dir in + if lint then lint_module ~ast ~source:m; + ast) + | Pps { pps; flags } -> + let ppx_exe = get_ppx_driver sctx ~scope pps in + let uses_ppx_driver = uses_ppx_driver ~pps in + let args : _ Arg_spec.t = + S [ As flags + ; A "--dump-ast" + ; As (cookie_library_name lib_name) + ; As (if uses_ppx_driver then ["-diff-cmd"; "-"] else []) + ] + in + (fun m ~lint -> + let ast = setup_reason_rules sctx ~dir m in + if lint then lint_module ~ast ~source:m; + pped_module ast ~dir ~f:(fun kind src dst -> + SC.add_rule sctx + (promote_correction ~uses_ppx_driver + (Option.value_exn (Module.file m ~dir kind)) + (preprocessor_deps + >>> + Build.run ~context:(SC.context sctx) + (Ok ppx_exe) + [ args + ; A "-o"; Target dst + ; Ml_kind.ppx_driver_flag kind; Dep src + ]))))) + +let pp_modules t ?(lint=true) modules = + Module.Name.Map.map modules ~f:(fun (m : Module.t) -> + Per_module.get t m.name m ~lint) + +let pp_module_as t ?(lint=true) name m = + Per_module.get t name m ~lint diff --git a/src/preprocessing.mli b/src/preprocessing.mli index a323b19a..a9db9201 100644 --- a/src/preprocessing.mli +++ b/src/preprocessing.mli @@ -2,19 +2,38 @@ open! Import -(** Setup pre-processing and linting rules and return the list of - pre-processed modules *) -val pp_and_lint_modules +(** Preprocessing object *) +type t + +val dummy : t + +val make : Super_context.t -> dir:Path.t -> dep_kind:Build.lib_dep_kind - -> modules:Module.t Module.Name.Map.t -> lint:Jbuild.Preprocess_map.t -> preprocess:Jbuild.Preprocess_map.t -> preprocessor_deps:(unit, Path.t list) Build.t -> lib_name:string option -> scope:Scope.t - -> Module.t Module.Name.Map.t + -> t + +(** Setup the preprocessing rules for the following modules and + returns the translated modules *) +val pp_modules + : t + -> ?lint:bool + -> Module.t Module.Name.Map.t + -> Module.t Module.Name.Map.t + +(** Preprocess a single module, using the configuration for the given + module name. *) +val pp_module_as + : t + -> ?lint:bool + -> Module.Name.t + -> Module.t + -> Module.t (** Get a path to a cached ppx driver *) val get_ppx_driver diff --git a/src/stanza.ml b/src/stanza.ml new file mode 100644 index 00000000..b84af253 --- /dev/null +++ b/src/stanza.ml @@ -0,0 +1 @@ +type t = .. diff --git a/src/stanza.mli b/src/stanza.mli new file mode 100644 index 00000000..577690cb --- /dev/null +++ b/src/stanza.mli @@ -0,0 +1,3 @@ +(** Stanza in dune/jbuild files *) + +type t = .. diff --git a/src/super_context.ml b/src/super_context.ml index 01ab9de5..bbc2f7b1 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -60,7 +60,7 @@ let internal_lib_names t = List.fold_left t.stanzas ~init:String.Set.empty ~f:(fun acc { Dir_with_jbuild. stanzas; _ } -> List.fold_left stanzas ~init:acc ~f:(fun acc -> function - | Stanza.Library lib -> + | Library lib -> String.Set.add (match lib.public with | None -> acc @@ -331,7 +331,7 @@ let create List.iter stanzas ~f:(fun { Dir_with_jbuild. ctx_dir; scope; stanzas; _ } -> List.iter stanzas ~f:(function - | Stanza.Env config -> + | Env config -> let inherit_from = if ctx_dir = Scope.root scope then None diff --git a/src/utop.ml b/src/utop.ml index b8ab074e..82a17d02 100644 --- a/src/utop.ml +++ b/src/utop.ml @@ -62,7 +62,7 @@ let setup sctx ~dir ~(libs : Library.t list) ~scope = ; syntax = Module.Syntax.OCaml } ; intf = None - ; obj_name = "" } in + ; obj_name = exe_name } in let utop_exe_dir = utop_exe_dir ~dir in let requires = let open Result.O in @@ -70,16 +70,19 @@ let setup sctx ~dir ~(libs : Library.t list) ~scope = ("utop" :: List.map libs ~f:(fun (lib : Library.t) -> lib.name)) >>= Lib.closure in - Exe.build_and_link sctx - ~dir:utop_exe_dir - ~obj_dir:utop_exe_dir + let cctx = + Compilation_context.create () + ~super_context:sctx + ~scope + ~dir:utop_exe_dir + ~modules + ~requires + ~flags:(Ocaml_flags.append_common + (Ocaml_flags.default ~profile:(Super_context.profile sctx)) + ["-w"; "-24"]) + in + Exe.build_and_link cctx ~program:{ name = exe_name ; main_module_name } - ~modules - ~scope ~linkages:[Exe.Linkage.custom] - ~requires - ~flags:(Ocaml_flags.append_common - (Ocaml_flags.default ~profile:(Super_context.profile sctx)) - ["-w"; "-24"]) ~link_flags:(Build.return ["-linkall"; "-warn-error"; "-31"]); add_module_rules sctx ~dir:utop_exe_dir requires