From 4d8ca489beecb7cf04c75e8d4da4f81512ea71b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Fri, 4 May 2018 16:49:25 +0100 Subject: [PATCH] Add support for environment & build profiles (#419) --- CHANGES.md | 3 + bin/main.ml | 121 ++++++++-- doc/dune.inc | 9 + doc/jbuild.rst | 35 ++- doc/quick-start.rst | 21 ++ doc/terminology.rst | 16 ++ doc/usage.rst | 23 +- src/build_system.ml | 13 +- src/build_system.mli | 4 +- src/clflags.ml | 1 - src/clflags.mli | 3 - src/context.ml | 17 +- src/context.mli | 2 + src/exe.ml | 2 +- src/gen_rules.ml | 39 ++-- src/gen_rules.mli | 3 +- src/inline_tests.ml | 2 +- src/jbuild.ml | 59 +++-- src/jbuild.mli | 19 +- src/js_of_ocaml_rules.ml | 22 +- src/js_of_ocaml_rules.mli | 2 +- src/main.ml | 43 ++-- src/main.mli | 5 +- src/menhir.ml | 5 +- src/ocaml_flags.ml | 45 ++-- src/ocaml_flags.mli | 15 +- src/ordered_set_lang.ml | 14 ++ src/ordered_set_lang.mli | 2 + src/super_context.ml | 211 ++++++++++++++---- src/super_context.mli | 21 +- src/utop.ml | 4 +- src/workspace.ml | 105 ++++++--- src/workspace.mli | 20 +- test/blackbox-tests/dune.inc | 10 + test/blackbox-tests/test-cases/env/bin/jbuild | 3 + test/blackbox-tests/test-cases/env/jbuild | 3 + test/blackbox-tests/test-cases/env/run.t | 36 +++ test/blackbox-tests/test-cases/env/src/jbuild | 3 + .../test-cases/env/vendor/a/a.opam | 0 .../test-cases/env/vendor/a/jbuild | 3 + .../test-cases/env/vendor/a/src/jbuild | 3 + 41 files changed, 745 insertions(+), 222 deletions(-) create mode 100644 test/blackbox-tests/test-cases/env/bin/jbuild create mode 100644 test/blackbox-tests/test-cases/env/jbuild create mode 100644 test/blackbox-tests/test-cases/env/run.t create mode 100644 test/blackbox-tests/test-cases/env/src/jbuild create mode 100644 test/blackbox-tests/test-cases/env/vendor/a/a.opam create mode 100644 test/blackbox-tests/test-cases/env/vendor/a/jbuild create mode 100644 test/blackbox-tests/test-cases/env/vendor/a/src/jbuild diff --git a/CHANGES.md b/CHANGES.md index 77f7aec7fbe..4b5a1bfe1e3 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -25,6 +25,9 @@ next - Scan the file system lazily (#732, fixes #718 and #228, @diml) +- Add support for setting the default ocaml flags and for build + profiles (#419, @diml) + 1.0+beta20 (10/04/2018) ----------------------- diff --git a/bin/main.ml b/bin/main.ml index c822c3b7fa8..f77b0bf208d 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -11,7 +11,7 @@ type common = { debug_dep_path : bool ; debug_findlib : bool ; debug_backtraces : bool - ; dev_mode : bool + ; profile : string option ; workspace_file : string option ; root : string ; target_prefix : string @@ -33,7 +33,6 @@ let set_common c ~targets = Clflags.debug_dep_path := c.debug_dep_path; Clflags.debug_findlib := c.debug_findlib; Clflags.debug_backtraces := c.debug_backtraces; - Clflags.dev_mode := c.dev_mode; Clflags.capture_outputs := c.capture_outputs; if c.root <> Filename.current_dir_name then Sys.chdir c.root; @@ -80,6 +79,7 @@ module Main = struct ?only_packages:common.only_packages ?external_lib_deps_mode ?x:common.x + ?profile:common.profile ~ignore_promoted_rules:common.ignore_promoted_rules ~capture_outputs:common.capture_outputs () @@ -211,7 +211,6 @@ let common = debug_dep_path debug_findlib debug_backtraces - dev_mode no_buffer workspace_file diff_command @@ -221,6 +220,7 @@ let common = only_packages, ignore_promoted_rules, config_file, + profile, orig) x display @@ -236,7 +236,7 @@ let common = in let orig_args = List.concat - [ if dev_mode then ["--dev"] else [] + [ dump_opt "--profile" profile ; dump_opt "--workspace" workspace_file ; orig ] @@ -264,7 +264,7 @@ let common = { debug_dep_path ; debug_findlib ; debug_backtraces - ; dev_mode + ; profile ; capture_outputs = not no_buffer ; workspace_file ; root @@ -334,7 +334,27 @@ let common = Arg.(value & flag & info ["dev"] ~docs - ~doc:{|Use stricter compilation flags by default.|}) + ~doc:{|Same as $(b,--profile dev)|}) + in + let profile = + Arg.(value + & opt (some string) None + & info ["profile"] ~docs + ~doc:{|Select the build profile, for instance $(b,dev) or $(b,release). + The default is $(b,default).|}) + in + let profile = + let merge dev profile = + match dev, profile with + | false, x -> `Ok x + | true , None -> `Ok (Some "dev") + | true , Some _ -> + `Error (true, + "Cannot use --dev and --profile simultaneously") + in + Term.(ret (const merge + $ dev + $ profile)) in let display = let verbose = @@ -440,34 +460,39 @@ let common = & opt (some string) None & info ["p"; for_release] ~docs ~docv:"PACKAGES" ~doc:{|Shorthand for $(b,--root . --only-packages PACKAGE - --promote ignore --no-config). + --promote ignore --no-config --profile release). You must use this option in your $(i,.opam) files, in order to build only what's necessary when your project contains multiple packages as well as getting reproducible builds.|}) in let merge root only_packages ignore_promoted_rules - (config_file_opt, config_file) release = + (config_file_opt, config_file) profile release = let fail opt = incompatible ("-p/--" ^ for_release) opt in - match release, root, only_packages, ignore_promoted_rules, config_file_opt with - | Some _, Some _, _, _, _ -> fail "--root" - | Some _, _, Some _, _, _ -> fail "--only-packages" - | Some _, _, _, true , _ -> fail "--ignore-promoted-rules" - | Some _, _, _, _ , Some s -> fail s - | Some pkgs, None, None, false, None -> + match release, root, only_packages, ignore_promoted_rules, + profile, config_file_opt with + | Some _, Some _, _, _, _, _ -> fail "--root" + | Some _, _, Some _, _, _, _ -> fail "--only-packages" + | Some _, _, _, true , _, _ -> fail "--ignore-promoted-rules" + | Some _, _, _, _, Some _, _ -> fail "--profile" + | Some _, _, _, _, _, Some s -> fail s + | Some pkgs, None, None, false, None, None -> `Ok (Some ".", Some pkgs, true, No_config, + Some "release", ["-p"; pkgs] ) - | None, _, _, _, _ -> + | None, _, _, _, _, _ -> `Ok (root, only_packages, ignore_promoted_rules, config_file, + profile, List.concat [ dump_opt "--root" root ; dump_opt "--only-packages" only_packages + ; dump_opt "--profile" profile ; if ignore_promoted_rules then ["--ignore-promoted-rules"] else @@ -484,6 +509,7 @@ let common = $ only_packages $ ignore_promoted_rules $ config_file + $ profile $ frop)) in let x = @@ -503,7 +529,6 @@ let common = $ ddep_path $ dfindlib $ dbacktraces - $ dev $ no_buffer $ workspace_file $ diff_command @@ -520,7 +545,11 @@ let installed_libraries = set_common common ~targets:[]; let env = Main.setup_env ~capture_outputs:common.capture_outputs in Scheduler.go ~log:(Log.create common) ~common - (Context.create (Default [Native]) ~env >>= fun ctxs -> + (Context.create + (Default { targets = [Native] + ; profile = "default" }) + ~env + >>= fun ctxs -> let ctx = List.hd ctxs in let findlib = ctx.findlib in if na then begin @@ -783,8 +812,8 @@ let external_lib_deps = (Build_system.all_lib_deps_by_context setup.build_system ~request) ~f:(fun context_name lib_deps acc -> let internals = - Jbuild.Stanzas.lib_names - (match String.Map.find setup.Main.stanzas context_name with + Super_context.internal_lib_names + (match String.Map.find setup.Main.scontexts context_name with | None -> assert false | Some x -> x) in @@ -1297,6 +1326,59 @@ let promote = $ common) , Term.info "promote" ~doc ~man ) +let printenv = + let doc = "Print the environment of a directory" in + let man = + [ `S "DESCRIPTION" + ; `P {|$(b,dune printenv DIR) prints the environment of a directory|} + ; `Blocks help_secs + ] in + let go common dir = + set_common common ~targets:[]; + let log = Log.create common in + Scheduler.go ~log ~common ( + Main.setup ~log common >>= fun setup -> + let dir = Path.of_string dir in + check_path setup.contexts dir; + let request = + let dump sctx ~dir = + let open Build.O in + Super_context.dump_env sctx ~dir + >>^ fun env -> + ((Super_context.context sctx).name, env) + in + Build.all ( + match Path.extract_build_context dir with + | Some (ctx, _) -> + let sctx = + String_map.find setup.scontexts ctx |> Option.value_exn + in + [dump sctx ~dir] + | None -> + String_map.values setup.scontexts + |> List.map ~f:(fun sctx -> + let dir = + Path.append (Super_context.context sctx).build_dir dir + in + dump sctx ~dir) + ) + in + Build_system.do_build setup.build_system ~request + >>| fun l -> + let pp ppf = Format.fprintf ppf "@[(@,@[%a@]@]@,)" (Format.pp_print_list Sexp.pp) in + match l with + | [(_, env)] -> + Format.printf "%a@." pp env + | l -> + List.iter l ~f:(fun (name, env) -> + Format.printf "@[Environment for context %s:@,%a@]@." name pp env) + ) + in + ( Term.(const go + $ common + $ Arg.(value & pos 0 dir "" & info [] ~docv:"PATH")) + , Term.info "printenv" ~doc ~man ) + module Help = struct let config = ("dune-config", 5, "", "Dune", "Dune manual"), @@ -1412,6 +1494,7 @@ let all = ; rules ; utop ; promote + ; printenv ; Help.help ] diff --git a/doc/dune.inc b/doc/dune.inc index f915ebab95d..2effc9cd2cb 100644 --- a/doc/dune.inc +++ b/doc/dune.inc @@ -62,6 +62,15 @@ ((section man) (files (dune-installed-libraries.1)))) +(rule + ((targets (dune-printenv.1)) + (action (with-stdout-to ${@} + (run dune printenv --help=groff))))) + +(install + ((section man) + (files (dune-printenv.1)))) + (rule ((targets (dune-promote.1)) (action (with-stdout-to ${@} diff --git a/doc/jbuild.rst b/doc/jbuild.rst index 7026ff10e3a..571d413dfa1 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -711,6 +711,27 @@ With this jbuild file, running jbuilder as follow will replace the $ jbuilder build @runtest --auto-promote +env +--- + +The ``env`` stanza allows to modify the environment. The syntax is as +follow: + +.. code:: scheme + + (env + ( ) + ( ) + ... + ( )) + +The first form ``( )`` that correspond to the +selected build profile will be used to modify the environment in this +directory. You can use ``_`` to match any build profile. + +Currently ```` can be any OCaml flags field, see `OCaml +flags`_ for more details. + Common items ============ @@ -1097,8 +1118,8 @@ The glob syntax is interpreted as follows: OCaml flags ----------- -In ``library`` and ``executables`` stanzas, you can specify OCaml compilation -flags using the following fields: +In ``library``, ``executable``, ``executables`` and ``env`` stanzas, +you can specify OCaml compilation flags using the following fields: - ``(flags )`` to specify flags passed to both ``ocamlc`` and ``ocamlopt`` @@ -1108,16 +1129,14 @@ flags using the following fields: For all these fields, ```` is specified in the `Ordered set language`_. These fields all support ``(:include ...)`` forms. -The default value for ``(flags ...)`` includes some ``-w`` options to set -warnings. The exact set depends on whether ``--dev`` is passed to Jbuilder. As a -result it is recommended to write ``(flags ...)`` fields as follows: +The default value for ``(flags ...)`` is taken from the environment, +as a result it is recommended to write ``(flags ...)`` fields as +follows: -:: +.. code:: scheme (flags (:standard )) -.. _jbuild-jsoo: - js_of_ocaml ----------- diff --git a/doc/quick-start.rst b/doc/quick-start.rst index 55ad26757d7..ce8a9a22d83 100644 --- a/doc/quick-start.rst +++ b/doc/quick-start.rst @@ -116,6 +116,27 @@ Outside of the library, module ``Foo`` will be accessible as You can then use this library in any other directory by adding ``mylib`` to the ``(libraries ...)`` field. +Setting the OCaml compilation flags globally +============================================ + +Write this jbuild at the root of your project: + +.. code:: scheme + + (env + (dev + (flags (:standard -w +42))) + (release + (flags (:standard -O3)))) + +`dev` and `release` correspond to build profiles. The build profile +can be selected from the command line with `--profile foo` or from a +`dune-workspace` file by writing: + +.. code:: scheme + + (profile foo) + Using cppo ========== diff --git a/doc/terminology.rst b/doc/terminology.rst index cd373b48888..842effe759c 100644 --- a/doc/terminology.rst +++ b/doc/terminology.rst @@ -54,3 +54,19 @@ Terminology - ``install`` which depends on everything that should be installed - ``doc`` which depends on the generated HTML documentation. See :ref:`apidoc` for details + +- **environment**: in Jbuilder, each directory has an environment + attached to it. The environment determines the default values of + various parameters, such as the compilation flags. Inside a scope, + each directory inherit the environment from its parent. At the root + of every scope, a default environment is used. At any point, the + environment can be altered using an `env`_ stanza. + +- **build profile**: a global setting that influence various + defaults. It can be set from the command line using ``--profile + `` or from ``jbuild-workspace`` files. The following + profiles are standard: + + - ``default`` which is the default profile when none is set explicitely + - ``release`` which is the profile used for opam releases + - ``dev`` which has stricter warnings diff --git a/doc/usage.rst b/doc/usage.rst index d253f94bc6a..3c6241abfd6 100644 --- a/doc/usage.rst +++ b/doc/usage.rst @@ -225,8 +225,8 @@ follows: build: [["jbuilder" "build" "-p" name "-j" jobs]] -``-p pkg`` is a shorthand for ``--root . --only-packages pkg --promote -ignore``. ``-p`` is the short version of +``-p pkg`` is a shorthand for ``--root . --only-packages pkg --profile +release``. ``-p`` is the short version of ``--for-release-of-packages``. This has the following effects: @@ -234,7 +234,7 @@ This has the following effects: - it tells jbuilder to build everything that is installable and to ignore packages other than ``name`` defined in your project - it sets the root to prevent jbuilder from looking it up -- it ignores promotion to cut down dependencies and speed up the build +- it sets the build profile to ``release`` - it uses whatever concurrency option opam provides Note that ``name`` and ``jobs`` are variables expanded by opam. ``name`` @@ -355,6 +355,19 @@ as one containing exactly: This allows you to use an empty ``jbuild-workspace`` file to mark the root of your project. +profile +~~~~~~~ + +The build profile can be selected in the ``jbuild-workspace`` file by +write a ``(profile ...)`` stanza. For instance: + +.. code:: scheme + + (profile dev) + +Note that the command line option ``--profile`` has precedence over +this stanza. + context ~~~~~~~ @@ -379,6 +392,10 @@ context or can be the description of an opam switch, as follows: - ``(merlin)`` instructs Jbuilder to use this build context for merlin +- ``(profile )`` to set a different profile for a build + context. This has precedence over the command line option + ``--profile`` + Both ``(default ...)`` and ``(opam ...)`` accept a ``targets`` field in order to setup cross compilation. See `Cross Compilation`_ for more information. diff --git a/src/build_system.ml b/src/build_system.ml index ee14c68e10b..0594ecb9f6e 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -508,11 +508,8 @@ module Build_exec = struct reraise exn in let dyn_deps = ref Pset.empty in - let action = exec dyn_deps (Build.repr t) x in - (action, !dyn_deps) - - let exec_nop bs t x = - snd (exec bs (Build.O.(>>^) t (fun () -> Action.Progn [])) x) + let result = exec dyn_deps (Build.repr t) x in + (result, !dyn_deps) end (* [copy_source] is [true] for rules copying files from the source directory *) @@ -1206,8 +1203,10 @@ let eval_request t ~request ~process_target = (fun () -> wait_for_deps t rule_deps >>= fun () -> - let dyn_deps = Build_exec.exec_nop t request () in - process_targets (Pset.diff dyn_deps static_deps)) + let result, dyn_deps = Build_exec.exec t request () in + process_targets (Pset.diff dyn_deps static_deps) + >>| fun () -> + result) let universe_file = Path.relative Path.build_dir ".universe-state" diff --git a/src/build_system.mli b/src/build_system.mli index 069aa47d2e9..d55c6a8f2dd 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -177,8 +177,8 @@ end with type build_system := t (** Do the actual build *) val do_build : t - -> request:(unit, unit) Build.t - -> unit Fiber.t + -> request:(unit, 'a) Build.t + -> 'a Fiber.t (** {2 Other queries} *) diff --git a/src/clflags.ml b/src/clflags.ml index 2fdac5858cd..d10df6e78c4 100644 --- a/src/clflags.ml +++ b/src/clflags.ml @@ -3,7 +3,6 @@ let g = ref true let debug_findlib = ref false let warnings = ref "-40" let debug_dep_path = ref false -let dev_mode = ref false let workspace_root = ref "." let external_lib_deps_hint = ref [] let capture_outputs = ref true diff --git a/src/clflags.mli b/src/clflags.mli index 60a452cf893..e40cac0d4ef 100644 --- a/src/clflags.mli +++ b/src/clflags.mli @@ -15,9 +15,6 @@ val debug_findlib : bool ref (** Compiler warnings *) val warnings : string ref -(** Whether we are compiling with extra warnings *) -val dev_mode : bool ref - (** The path to the workspace root *) val workspace_root : string ref diff --git a/src/context.ml b/src/context.ml index 12b3bdd87bf..6560203614e 100644 --- a/src/context.ml +++ b/src/context.ml @@ -21,6 +21,7 @@ end type t = { name : string ; kind : Kind.t + ; profile : string ; merlin : bool ; for_host : t option ; implicit : bool @@ -81,6 +82,7 @@ let sexp_of_t t = record [ "name", string t.name ; "kind", Kind.sexp_of_t t.kind + ; "profile", string t.profile ; "merlin", bool t.merlin ; "for_host", option string (Option.map t.for_host ~f:(fun t -> t.name)) ; "build_dir", path t.build_dir @@ -128,7 +130,7 @@ let ocamlpath_sep = else Bin.path_sep -let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets () = +let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets ~profile () = let opam_var_cache = Hashtbl.create 128 in (match kind with | Opam { root; _ } -> @@ -329,6 +331,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets () = { name ; implicit ; kind + ; profile ; merlin ; for_host = host ; build_dir @@ -407,7 +410,8 @@ let opam_config_var t var = opam_config_var ~env:t.env ~cache:t.opam_var_cache v let default ?(merlin=true) ~env ~targets () = create ~kind:Default ~path:Bin.path ~env ~name:"default" ~merlin ~targets () -let create_for_opam ?root ~env ~targets ~switch ~name ?(merlin=false) () = +let create_for_opam ?root ~env ~targets ~profile ~switch ~name + ?(merlin=false) () = match Bin.opam with | None -> Utils.program_not_found "opam" | Some fn -> @@ -444,13 +448,14 @@ let create_for_opam ?root ~env ~targets ~switch ~name ?(merlin=false) () = | Some s -> Bin.parse_path s in let env = Env.extend env ~vars in - create ~kind:(Opam { root; switch }) ~targets ~path ~env ~name ~merlin () + create ~kind:(Opam { root; switch }) ~profile ~targets ~path ~env ~name + ~merlin () let create ?merlin ~env def = match (def : Workspace.Context.t) with - | Default targets -> default ~env ~targets ?merlin () - | Opam { name; switch; root; targets; _ } -> - create_for_opam ?root ~env ~switch ~name ?merlin ~targets () + | Default { targets; profile } -> default ~env ~profile ~targets ?merlin () + | Opam { name; switch; root; targets; profile; _ } -> + create_for_opam ?root ~env ~profile ~switch ~name ?merlin ~targets () let which t s = which ~cache:t.which_cache ~path:t.path s diff --git a/src/context.mli b/src/context.mli index b3fcc57c679..733bd9d02a5 100644 --- a/src/context.mli +++ b/src/context.mli @@ -34,6 +34,8 @@ type t = { name : string ; kind : Kind.t + ; profile : string + ; (** [true] if this context is used for the .merlin files *) merlin : bool diff --git a/src/exe.ml b/src/exe.ml index ed630bbb429..335413667f3 100644 --- a/src/exe.ml +++ b/src/exe.ml @@ -163,7 +163,7 @@ let link_exe Build.fanout (modules_and_cm_files >>^ snd) (SC.expand_and_eval_set sctx ~scope ~dir js_of_ocaml.flags - ~standard:(Js_of_ocaml_rules.standard ())) + ~standard:(Build.return (Js_of_ocaml_rules.standard sctx))) in SC.add_rules sctx (List.map rules ~f:(fun r -> cm_and_flags >>> r)) diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 9d38ebc9a5d..c1bfd953239 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -13,8 +13,7 @@ module Gen(P : Install_rules.Params) = struct module SC = Super_context module Odoc = Odoc.Gen(P) - open P - + let sctx = P.sctx let ctx = SC.context sctx let stanzas_per_dir = @@ -268,7 +267,8 @@ 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 _ -> []) + | Documentation _ | Alias _ | Provides _ | Install _ + | Env _ -> []) |> String.Set.of_list in String.Set.union generated_files @@ -466,10 +466,12 @@ module Gen(P : Install_rules.Params) = struct (obj_deps >>> Build.fanout4 - (top_sorted_modules >>^ artifacts ~ext:(Cm_kind.ext (Mode.cm_kind mode))) - (SC.expand_and_eval_set sctx ~scope ~dir lib.c_library_flags ~standard:[]) + (top_sorted_modules >>^artifacts ~ext:(Cm_kind.ext (Mode.cm_kind mode))) + (SC.expand_and_eval_set sctx ~scope ~dir lib.c_library_flags + ~standard:(Build.return [])) (Ocaml_flags.get flags mode) - (SC.expand_and_eval_set sctx ~scope ~dir lib.library_flags ~standard:[]) + (SC.expand_and_eval_set sctx ~scope ~dir lib.library_flags + ~standard:(Build.return [])) >>> Build.run ~context:ctx (Ok compiler) [ Dyn (fun (_, _, flags, _) -> As flags) @@ -492,7 +494,7 @@ module Gen(P : Install_rules.Params) = struct let dst = Path.relative dir (c_name ^ ctx.ext_obj) in SC.add_rule sctx (SC.expand_and_eval_set sctx ~scope ~dir lib.c_flags - ~standard:(Context.cc_g ctx) + ~standard:(Build.return (Context.cc_g ctx)) >>> Build.run ~context:ctx (* We have to execute the rule in the library directory as @@ -519,7 +521,7 @@ module Gen(P : Install_rules.Params) = struct in SC.add_rule sctx (SC.expand_and_eval_set sctx ~scope ~dir lib.cxx_flags - ~standard:(Context.cc_g ctx) + ~standard:(Build.return (Context.cc_g ctx)) >>> Build.run ~context:ctx (* We have to execute the rule in the library directory as @@ -545,7 +547,7 @@ module Gen(P : Install_rules.Params) = struct let obj_dir = Utils.library_object_directory ~dir lib.name in let requires = Lib.Compile.requires compile_info in let dep_kind = if lib.optional then Build.Optional else Required in - let flags = Ocaml_flags.make lib.buildable sctx ~scope ~dir in + 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 = @@ -606,7 +608,7 @@ module Gen(P : Install_rules.Params) = struct ~js_of_ocaml ~dynlink ~flags ~scope ~dir ~obj_dir ~dep_graphs ~modules ~requires ~alias_module; Option.iter alias_module ~f:(fun m -> - let flags = Ocaml_flags.default () in + let flags = Ocaml_flags.default ~profile:(SC.profile sctx) in Module_compilation.build_module sctx m ~js_of_ocaml ~dynlink @@ -650,7 +652,7 @@ module Gen(P : Install_rules.Params) = struct let ocamlmklib ~sandbox ~custom ~targets = SC.add_rule sctx ~sandbox (SC.expand_and_eval_set sctx ~scope ~dir - lib.c_library_flags ~standard:[] + lib.c_library_flags ~standard:(Build.return []) >>> Build.run ~context:ctx (Ok ctx.ocamlmklib) @@ -858,14 +860,12 @@ module Gen(P : Install_rules.Params) = struct l in - let flags = - Ocaml_flags.make exes.buildable sctx ~scope ~dir - in + let flags = SC.ocaml_flags sctx ~scope ~dir exes.buildable in let link_flags = SC.expand_and_eval_set sctx exes.link_flags ~scope ~dir - ~standard:[] + ~standard:(Build.return []) in (* Use "eobjs" rather than "objs" to avoid a potential conflict @@ -1027,6 +1027,7 @@ module type Gen = sig -> string list -> Build_system.extra_sub_directories_to_keep val init : unit -> unit + val sctx : Super_context.t end let gen ~contexts ~build_system @@ -1084,11 +1085,11 @@ let gen ~contexts ~build_system let module M = Gen(struct let sctx = sctx end) in Fiber.Ivar.fill (Option.value_exn (Hashtbl.find sctxs context.name)) sctx >>| fun () -> - (context.name, ((module M : Gen), stanzas)) + (context.name, (module M : Gen)) in Fiber.parallel_map contexts ~f:make_sctx >>| fun l -> let map = String.Map.of_list_exn l in Build_system.set_rule_generators build_system - (String.Map.map map ~f:(fun ((module M : Gen), _) -> M.gen_rules)); - String.Map.iter map ~f:(fun ((module M : Gen), _) -> M.init ()); - String.Map.map map ~f:snd + (String_map.map map ~f:(fun (module M : Gen) -> M.gen_rules)); + String_map.iter map ~f:(fun (module M : Gen) -> M.init ()); + String_map.map map ~f:(fun (module M : Gen) -> M.sctx) diff --git a/src/gen_rules.mli b/src/gen_rules.mli index 65e4014d23c..6b2475e808c 100644 --- a/src/gen_rules.mli +++ b/src/gen_rules.mli @@ -1,5 +1,4 @@ open! Import -open Jbuild (* Generate rules. Returns evaluated jbuilds per context names. *) val gen @@ -8,4 +7,4 @@ val gen -> ?external_lib_deps_mode:bool (* default: false *) -> ?only_packages:Package.Name.Set.t -> Jbuild_load.conf - -> (Path.t * Scope_info.t * Stanzas.t) list String.Map.t Fiber.t + -> Super_context.t String_map.t Fiber.t diff --git a/src/inline_tests.ml b/src/inline_tests.ml index cce6263832d..05d4efc222d 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -261,7 +261,7 @@ include Sub_system.Register_end_point( ~scope ~dir ~extra_vars - ~standard:[])) + ~standard:(Build.return []))) >>^ List.concat in diff --git a/src/jbuild.ml b/src/jbuild.ml index 49640fa1934..3fbec75bb6c 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -1192,6 +1192,42 @@ module Documentation = struct ) end +module Env = struct + type config = + { flags : Ordered_set_lang.Unexpanded.t + ; ocamlc_flags : Ordered_set_lang.Unexpanded.t + ; ocamlopt_flags : Ordered_set_lang.Unexpanded.t + } + + type pattern = + | Profile of string + | Any + + type t = + { loc : Loc.t + ; rules : (pattern * config) list + } + + let config = + record + (field_oslu "flags" >>= fun flags -> + field_oslu "ocamlc_flags" >>= fun ocamlc_flags -> + field_oslu "ocamlopt_flags" >>= fun ocamlopt_flags -> + return { flags; ocamlc_flags; ocamlopt_flags }) + + let rule = function + | List (loc, Atom (_, A pat) :: fields) -> + let pat = + match pat with + | "_" -> Any + | s -> Profile s + in + (pat, config (List (loc, fields))) + | sexp -> + of_sexp_error sexp + "S-expression of the form ( ) expected" +end + module Stanza = struct type t = | Library of Library.t @@ -1203,6 +1239,7 @@ module Stanza = struct | Copy_files of Copy_files.t | Menhir of Menhir.t | Documentation of Documentation.t + | Env of Env.t end module Stanzas = struct @@ -1239,6 +1276,8 @@ module Stanzas = struct (fun glob -> [Copy_files {add_line_directive = false; glob}]) ; cstr "copy_files#" (Copy_files.v1 @> nil) (fun glob -> [Copy_files {add_line_directive = true; glob}]) + ; cstr_rest_loc "env" nil Env.rule + (fun loc rules -> [Env { loc; rules }]) (* Just for validation and error messages *) ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> []) ; cstr_loc "include" (relative_file @> nil) (fun loc fn -> @@ -1278,7 +1317,13 @@ module Stanzas = struct | _ :: (_, loc) :: _ -> Loc.fail loc "jbuild_version specified too many times" in - List.concat_map sexps ~f:(select version pkgs ~file ~include_stack) + let l = + List.concat_map sexps ~f:(select version pkgs ~file ~include_stack) + in + match List.filter_map l ~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 pkgs sexps = try @@ -1302,16 +1347,4 @@ module Stanzas = struct sprintf "\n--> included from %s" (line_loc x)))) - - let lib_names ts = - List.fold_left ts ~init:String.Set.empty ~f:(fun acc (_, _, stanzas) -> - List.fold_left stanzas ~init:acc ~f:(fun acc -> function - | Stanza.Library lib -> - let acc = - match lib.public with - | None -> acc - | Some { name; _ } -> String.Set.add acc name - in - String.Set.add acc lib.name - | _ -> acc)) end diff --git a/src/jbuild.mli b/src/jbuild.mli index ea8c9e898ba..7c1f843b375 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -369,6 +369,23 @@ module Documentation : sig } end +module Env : sig + type config = + { flags : Ordered_set_lang.Unexpanded.t + ; ocamlc_flags : Ordered_set_lang.Unexpanded.t + ; ocamlopt_flags : Ordered_set_lang.Unexpanded.t + } + + type pattern = + | Profile of string + | Any + + type t = + { loc : Loc.t + ; rules : (pattern * config) list + } +end + module Stanza : sig type t = | Library of Library.t @@ -380,6 +397,7 @@ module Stanza : sig | Copy_files of Copy_files.t | Menhir of Menhir.t | Documentation of Documentation.t + | Env of Env.t end module Stanzas : sig @@ -393,5 +411,4 @@ module Stanzas : sig -> Scope_info.t -> Sexp.Ast.t list -> t - val lib_names : (_ * _ * t) list -> String.Set.t end diff --git a/src/js_of_ocaml_rules.ml b/src/js_of_ocaml_rules.ml index 1b728398215..ffc49fb63bf 100644 --- a/src/js_of_ocaml_rules.ml +++ b/src/js_of_ocaml_rules.ml @@ -4,12 +4,14 @@ open Build.O module SC = Super_context -let separate_compilation_enabled () = !Clflags.dev_mode +let dev_mode sctx = SC.profile sctx = "dev" -let pretty () = if !Clflags.dev_mode then ["--pretty" ] else [] -let sourcemap () = if !Clflags.dev_mode then ["--source-map-inline"] else [] +let separate_compilation_enabled = dev_mode -let standard () = pretty () @ sourcemap () +let pretty sctx = if dev_mode sctx then ["--pretty" ] else [] +let sourcemap sctx = if dev_mode sctx then ["--source-map-inline"] else [] + +let standard sctx = pretty sctx @ sourcemap sctx let install_jsoo_hint = "opam install js_of_ocaml-compiler" @@ -95,18 +97,18 @@ let link_rule ~sctx ~dir ~runtime ~target ~requires = jsoo_link [ Arg_spec.A "-o"; Target target ; Arg_spec.Dep runtime - ; Arg_spec.As (sourcemap ()) + ; Arg_spec.As (sourcemap sctx) ; Arg_spec.Dyn get_all ] let build_cm sctx ~scope ~dir ~(js_of_ocaml:Jbuild.Js_of_ocaml.t) ~src ~target = - if separate_compilation_enabled () + if separate_compilation_enabled sctx then let itarget = Path.extend_basename src ~suffix:".js" in let spec = Arg_spec.Dep src in let flags = SC.expand_and_eval_set sctx ~scope ~dir js_of_ocaml.flags - ~standard:(standard ()) + ~standard:(Build.return (standard sctx)) in [ flags >>> @@ -119,7 +121,7 @@ let build_cm sctx ~scope ~dir ~(js_of_ocaml:Jbuild.Js_of_ocaml.t) ~src ~target = else [] let setup_separate_compilation_rules sctx components = - if separate_compilation_enabled () + if separate_compilation_enabled sctx then match components with | [] | _ :: _ :: _ -> () @@ -145,7 +147,7 @@ let setup_separate_compilation_rules sctx components = let dir = in_build_dir ~ctx [ Lib.name pkg ] in let spec = Arg_spec.Dep src in SC.add_rule sctx - (Build.return (standard ()) + (Build.return (standard sctx) >>> js_of_ocaml_rule ~sctx ~dir ~flags:(fun flags -> As flags) ~spec ~target) @@ -157,7 +159,7 @@ let build_exe sctx ~dir ~js_of_ocaml ~src ~requires = let mk_target ext = Path.extend_basename src ~suffix:ext in let target = mk_target ".js" in let standalone_runtime = mk_target ".runtime.js" in - if separate_compilation_enabled () then + if separate_compilation_enabled sctx then [ link_rule ~sctx ~dir ~runtime:standalone_runtime ~target ~requires ; standalone_runtime_rule ~sctx ~dir ~javascript_files ~target:standalone_runtime ~requires diff --git a/src/js_of_ocaml_rules.mli b/src/js_of_ocaml_rules.mli index ccf1d1876e5..35c33a0d1ee 100644 --- a/src/js_of_ocaml_rules.mli +++ b/src/js_of_ocaml_rules.mli @@ -25,4 +25,4 @@ val setup_separate_compilation_rules -> string list -> unit -val standard : unit -> string list +val standard : Super_context.t -> string list diff --git a/src/main.ml b/src/main.ml index d886f5e1e65..5c3570727b2 100644 --- a/src/main.ml +++ b/src/main.ml @@ -5,8 +5,8 @@ let () = Inline_tests.linkme type setup = { build_system : Build_system.t - ; stanzas : (Path.t * Jbuild.Scope_info.t * Jbuild.Stanzas.t) list String.Map.t ; contexts : Context.t list + ; scontexts : Super_context.t String_map.t ; packages : Package.t Package.Name.Map.t ; file_tree : File_tree.t ; env : Env.t @@ -36,6 +36,7 @@ let setup ?(log=Log.no_log) ?x ?ignore_promoted_rules ?(capture_outputs=true) + ?profile () = let env = setup_env ~capture_outputs in let conf = @@ -57,7 +58,7 @@ let setup ?(log=Log.no_log) | None -> match workspace_file with | Some p -> - Workspace.load ?x p + Workspace.load ?x ?profile p | _ -> match List.find_map ["dune-workspace"; "jbuild-workspace"] ~f:(fun fn -> @@ -67,14 +68,17 @@ let setup ?(log=Log.no_log) else None) with - | Some p -> Workspace.load ?x p + | Some p -> Workspace.load ?x ?profile p | None -> { merlin_context = Some "default" - ; contexts = [Default [ - match x with - | None -> Native - | Some x -> Named x - ]] + ; contexts = [Default + { targets = [ + match x with + | None -> Native + | Some x -> Named x + ] + ; profile = Option.value profile ~default:"default" + }] } in @@ -104,12 +108,12 @@ let setup ?(log=Log.no_log) ~contexts ?only_packages ?external_lib_deps_mode - >>= fun stanzas -> + >>= fun scontexts -> Scheduler.set_status_line_generator gen_status_line >>> Fiber.return { build_system - ; stanzas + ; scontexts ; contexts ; packages = conf.packages ; file_tree = conf.file_tree @@ -133,8 +137,8 @@ let external_lib_deps ?log ~packages () = | Ok path -> Path.append context.build_dir path | Error () -> die "Unknown package %S" (Package.Name.to_string pkg)) in - let stanzas = Option.value_exn (String.Map.find setup.stanzas "default") in - let internals = Jbuild.Stanzas.lib_names stanzas in + let sctx = Option.value_exn (String.Map.find setup.scontexts "default") in + let internals = Super_context.internal_lib_names sctx in Path.Map.map (Build_system.all_lib_deps setup.build_system ~request:(Build.paths install_files)) @@ -220,9 +224,11 @@ let bootstrap () = | Error msg -> raise (Arg.Bad msg) | Ok c -> concurrency := Some c in + let profile = ref None in Arg.parse [ "-j" , String concurrency_arg, "JOBS concurrency" - ; "--dev" , Set Clflags.dev_mode , " set development mode" + ; "--dev" , Unit (fun () -> profile := Some "dev"), + " set development mode" ; "--display" , display_mode , " set the display mode" ; "--subst" , Unit subst , " substitute watermarks in source files" @@ -234,7 +240,7 @@ let bootstrap () = Clflags.debug_dep_path := true; let config = (* Only load the configuration with --dev *) - if !Clflags.dev_mode then + if !profile = Some "dev" then Config.load_user_config_file () else Config.default @@ -254,7 +260,14 @@ let bootstrap () = (set_concurrency config >>= fun () -> setup ~log ~workspace:{ merlin_context = Some "default" - ; contexts = [Default [Native]] } + ; contexts = [Default { targets = [Native] + ; profile = + Option.value !profile + ~default:"default" + } + ] + } + ?profile:!profile ~extra_ignored_subtrees:ignored_during_bootstrap () >>= fun { build_system = bs; _ } -> diff --git a/src/main.mli b/src/main.mli index 8b559d884bf..c56ff5923df 100644 --- a/src/main.mli +++ b/src/main.mli @@ -1,11 +1,9 @@ open! Import -open Jbuild type setup = { build_system : Build_system.t - ; (* Evaluated jbuilds per context names *) - stanzas : (Path.t * Scope_info.t * Stanzas.t) list String.Map.t ; contexts : Context.t list + ; scontexts : Super_context.t String_map.t ; packages : Package.t Package.Name.Map.t ; file_tree : File_tree.t ; env : Env.t @@ -25,6 +23,7 @@ val setup -> ?x:string -> ?ignore_promoted_rules:bool -> ?capture_outputs:bool + -> ?profile:string -> unit -> setup Fiber.t val external_lib_deps diff --git a/src/menhir.ml b/src/menhir.ml index 92c7230ed8c..570aba8486d 100644 --- a/src/menhir.ml +++ b/src/menhir.ml @@ -24,7 +24,10 @@ module SC = Super_context let gen_rules sctx ~dir ~scope (t : Jbuild.Menhir.t) = let targets n = List.map ~f:(Path.relative dir) [n ^ ".ml"; n ^ ".mli"] in (* This expands special variables such as ${ROOT} in the flags *) - let flags = SC.expand_and_eval_set sctx ~scope ~dir t.flags ~standard:[] in + let flags = + SC.expand_and_eval_set sctx ~scope ~dir t.flags + ~standard:(Build.return []) + in let menhir_binary = SC.resolve_program sctx "menhir" ~hint:"opam install menhir" in diff --git a/src/ocaml_flags.ml b/src/ocaml_flags.ml index e079e93ed0e..653992356f7 100644 --- a/src/ocaml_flags.ml +++ b/src/ocaml_flags.ml @@ -21,8 +21,8 @@ let dev_mode_warnings = ; 60 ]) -let default_flags () = - if !Clflags.dev_mode then +let default_flags ~profile = + if profile = "dev" then [ "-w"; dev_mode_warnings ^ !Clflags.warnings ; "-strict-sequence" ; "-strict-formats" @@ -46,12 +46,26 @@ let empty = let of_list l = { empty with common = Build.arr (fun () -> l) } -let make { Jbuild.Buildable. flags; ocamlc_flags; ocamlopt_flags; _ } ctx ~scope ~dir = - let eval = Super_context.expand_and_eval_set ctx ~scope ~dir in - { common = Build.memoize "common flags" (eval flags ~standard:(default_flags ())) +let default ~profile = + { common = Build.return (default_flags ~profile) ; specific = - { byte = Build.memoize "ocamlc flags" (eval ocamlc_flags ~standard:(default_ocamlc_flags ())) - ; native = Build.memoize "ocamlopt flags" (eval ocamlopt_flags ~standard:(default_ocamlopt_flags ())) + { byte = Build.return (default_ocamlc_flags ()) + ; native = Build.return (default_ocamlopt_flags ()) + } + } + +let make ~flags ~ocamlc_flags ~ocamlopt_flags ~default ~eval = + let f name x standard = + Build.memoize name + (if Ordered_set_lang.Unexpanded.has_special_forms x then + eval x ~standard + else + eval x ~standard:(Build.return [])) + in + { common = f "common flags" flags default.common + ; specific = + { byte = f "ocamlc flags" ocamlc_flags default.specific.byte + ; native = f "ocamlopt flags" ocamlopt_flags default.specific.native } } @@ -64,16 +78,17 @@ let get t mode = let get_for_cm t ~cm_kind = get t (Mode.of_cm_kind cm_kind) -let default () = - { common = Build.return (default_flags ()) - ; specific = - { byte = Build.return (default_ocamlc_flags ()) - ; native = Build.return (default_ocamlopt_flags ()) - } - } - let append_common t flags = {t with common = t.common >>^ fun l -> l @ flags} let prepend_common flags t = {t with common = t.common >>^ fun l -> flags @ l} let common t = t.common + +let dump t = + Build.fanout3 t.common t.specific.byte t.specific.native + >>^ fun (common, byte, native) -> + List.map ~f:Sexp.To_sexp.(pair string (list string)) + [ "flags" , common + ; "ocamlc_flags" , byte + ; "ocamlopt_flags" , native + ] diff --git a/src/ocaml_flags.mli b/src/ocaml_flags.mli index 51ddaf6d10b..fa9b1d4d0f3 100644 --- a/src/ocaml_flags.mli +++ b/src/ocaml_flags.mli @@ -5,13 +5,16 @@ open Stdune type t val make - : Jbuild.Buildable.t - -> Super_context.t - -> scope:Scope.t - -> dir:Path.t + : flags : Ordered_set_lang.Unexpanded.t + -> ocamlc_flags : Ordered_set_lang.Unexpanded.t + -> ocamlopt_flags : Ordered_set_lang.Unexpanded.t + -> default:t + -> eval:(Ordered_set_lang.Unexpanded.t + -> standard:(unit, string list) Build.t + -> (unit, string list) Build.t) -> t -val default : unit -> t +val default : profile:string -> t val empty : t @@ -24,3 +27,5 @@ val append_common : t -> string list -> t val prepend_common : string list -> t -> t val common : t -> (unit, string list) Build.t + +val dump : t -> (unit, Sexp.t list) Build.t diff --git a/src/ordered_set_lang.ml b/src/ordered_set_lang.ml index 29c2293abf8..2d8ca438ae2 100644 --- a/src/ordered_set_lang.ml +++ b/src/ordered_set_lang.ml @@ -223,6 +223,20 @@ module Unexpanded = struct in loop String.Set.empty t.ast + let has_special_forms t = + let rec loop (t : ast) = + let open Ast in + match t with + | Special _ | Include _ -> true + | Element _ -> false + | Union l -> + List.exists l ~f:loop + | Diff (l, r) -> + loop l || + loop r + in + loop t.ast + let expand t ~files_contents ~f = let rec expand (t : ast) : ast_expanded = let open Ast in diff --git a/src/ordered_set_lang.mli b/src/ordered_set_lang.mli index 77e15f60532..010de4c3e3c 100644 --- a/src/ordered_set_lang.mli +++ b/src/ordered_set_lang.mli @@ -58,6 +58,8 @@ module Unexpanded : sig val field : ?default:t -> string -> t Sexp.Of_sexp.record_parser + val has_special_forms : t -> bool + (** List of files needed to expand this set *) val files : t -> f:(String_with_vars.t -> string) -> String.Set.t diff --git a/src/super_context.ml b/src/super_context.ml index 50d7b1917ee..993b5515fea 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -14,6 +14,16 @@ module Dir_with_jbuild = struct } end +module Env_node = struct + type t = + { dir : Path.t + ; inherit_from : t Lazy.t option + ; scope : Scope.t + ; config : Env.t + ; mutable ocaml_flags : Ocaml_flags.t option + } +end + type t = { context : Context.t ; build_system : Build_system.t @@ -30,6 +40,7 @@ type t = ; chdir : (Action.t, Action.t) Build.t ; host : t option ; libs_by_package : (Package.t * Lib.Set.t) Package.Name.Map.t + ; env : (Path.t, Env_node.t) Hashtbl.t } let context t = t.context @@ -41,10 +52,23 @@ let file_tree t = t.file_tree let stanzas_to_consider_for_install t = t.stanzas_to_consider_for_install let cxx_flags t = t.cxx_flags let build_dir t = t.context.build_dir +let profile t = t.context.profile let build_system t = t.build_system let host t = Option.value t.host ~default:t +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 -> + String.Set.add + (match lib.public with + | None -> acc + | Some { name; _ } -> String.Set.add acc name) + lib.name + | _ -> acc)) + let public_libs t = t.public_libs let installed_libs t = t.installed_libs @@ -64,6 +88,88 @@ let expand_vars t ~scope ~dir ?(extra_vars=String.Map.empty) s = | Some _ as x -> x | None -> String.Map.find extra_vars var)) +let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard = + let open Build.O in + let f = expand_vars t ~scope ~dir ?extra_vars in + let parse ~loc:_ s = s in + match Ordered_set_lang.Unexpanded.files set ~f |> String.Set.to_list with + | [] -> + let set = + Ordered_set_lang.Unexpanded.expand set ~files_contents:String.Map.empty ~f + in + standard >>^ fun standard -> + Ordered_set_lang.String.eval set ~standard ~parse + | files -> + let paths = List.map files ~f:(Path.relative dir) in + Build.fanout standard (Build.all (List.map paths ~f:Build.read_sexp)) + >>^ fun (standard, sexps) -> + let files_contents = List.combine files sexps |> String.Map.of_list_exn in + let set = Ordered_set_lang.Unexpanded.expand set ~files_contents ~f in + Ordered_set_lang.String.eval set ~standard ~parse + +module Env = struct + open Env_node + + let rec get t ~dir = + match Hashtbl.find t.env dir with + | None -> + if Path.is_root dir then raise_notrace Exit; + let node = get t ~dir:(Path.parent dir) in + Hashtbl.add t.env dir node; + node + | Some node -> node + + let get t ~dir = + match get t ~dir with + | node -> node + | exception Exit -> + Exn.code_error "Super_context.Env.get called on invalid directory" + [ "dir", Path.sexp_of_t dir ] + + let ocaml_flags t ~dir = + let rec loop t node = + match node.ocaml_flags with + | Some x -> x + | None -> + let default = + match node.inherit_from with + | None -> Ocaml_flags.default ~profile:(profile t) + | Some (lazy node) -> loop t node + in + let flags = + match List.find_map node.config.rules ~f:(fun (pat, cfg) -> + match (pat : Env.pattern), profile t with + | Any, _ -> Some cfg + | Profile a, b -> Option.some_if (a = b) cfg) + with + | None -> default + | Some cfg -> + Ocaml_flags.make + ~flags:cfg.flags + ~ocamlc_flags:cfg.ocamlc_flags + ~ocamlopt_flags:cfg.ocamlopt_flags + ~default + ~eval:(expand_and_eval_set t ~scope:node.scope ~dir:node.dir + ?extra_vars:None) + in + node.ocaml_flags <- Some flags; + flags + in + loop t (get t ~dir) + +end + +let ocaml_flags t ~dir ~scope (x : Buildable.t) = + Ocaml_flags.make + ~flags:x.flags + ~ocamlc_flags:x.ocamlc_flags + ~ocamlopt_flags:x.ocamlopt_flags + ~default:(Env.ocaml_flags t ~dir) + ~eval:(expand_and_eval_set t ~scope ~dir ?extra_vars:None) + +let dump_env t ~dir = + Ocaml_flags.dump (Env.ocaml_flags t ~dir) + let resolve_program t ?hint bin = Artifacts.binary ?hint t.artifacts bin @@ -189,34 +295,65 @@ let create | Ok x -> x | Error _ -> assert false in - { context - ; host - ; build_system - ; scopes - ; public_libs - ; installed_libs - ; stanzas - ; packages - ; file_tree - ; stanzas_to_consider_for_install - ; artifacts - ; cxx_flags - ; vars - ; chdir = Build.arr (fun (action : Action.t) -> - match action with - | Chdir _ -> action - | _ -> Chdir (context.build_dir, action)) - ; libs_by_package = - Lib.DB.all public_libs - |> Lib.Set.to_list - |> List.map ~f:(fun lib -> - (Option.value_exn (Lib.package lib), lib)) - |> Package.Name.Map.of_list_multi - |> Package.Name.Map.merge packages ~f:(fun _name pkg libs -> - let pkg = Option.value_exn pkg in - let libs = Option.value libs ~default:[] in - Some (pkg, Lib.Set.of_list libs)) - } + let t = + { context + ; host + ; build_system + ; scopes + ; public_libs + ; installed_libs + ; stanzas + ; packages + ; file_tree + ; stanzas_to_consider_for_install + ; artifacts + ; cxx_flags + ; vars + ; chdir = Build.arr (fun (action : Action.t) -> + match action with + | Chdir _ -> action + | _ -> Chdir (context.build_dir, action)) + ; libs_by_package = + Lib.DB.all public_libs + |> Lib.Set.to_list + |> List.map ~f:(fun lib -> + (Option.value_exn (Lib.package lib), lib)) + |> Package.Name.Map.of_list_multi + |> Package.Name.Map.merge packages ~f:(fun _name pkg libs -> + let pkg = Option.value_exn pkg in + let libs = Option.value libs ~default:[] in + Some (pkg, Lib.Set.of_list libs)) + ; env = Hashtbl.create 128 + } + in + List.iter stanzas + ~f:(fun { Dir_with_jbuild. ctx_dir; scope; stanzas; _ } -> + List.iter stanzas ~f:(function + | Stanza.Env config -> + let inherit_from = + if ctx_dir = Scope.root scope then + None + else + Some (lazy (Env.get t ~dir:(Path.parent ctx_dir))) + in + Hashtbl.add t.env ctx_dir + { dir = ctx_dir + ; inherit_from = inherit_from + ; scope = scope + ; config = config + ; ocaml_flags = None + } + | _ -> ())); + if not (Hashtbl.mem t.env context.build_dir) then + Hashtbl.add t.env context.build_dir + { Env_node. + dir = context.build_dir + ; inherit_from = None + ; scope = Scope.DB.find_by_dir scopes context.build_dir + ; config = { loc = Loc.none; rules = [] } + ; ocaml_flags = None + }; + t let prefix_rules t prefix ~f = Build_system.prefix_rules t.build_system prefix ~f @@ -695,21 +832,3 @@ module Action = struct | [] -> build | fail :: _ -> Build.fail fail >>> build end - -let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard = - let open Build.O in - let f = expand_vars t ~scope ~dir ?extra_vars in - let parse ~loc:_ s = s in - match Ordered_set_lang.Unexpanded.files set ~f |> String.Set.to_list with - | [] -> - let set = - Ordered_set_lang.Unexpanded.expand set ~files_contents:String.Map.empty ~f - in - Build.return (Ordered_set_lang.String.eval set ~standard ~parse) - | files -> - let paths = List.map files ~f:(Path.relative dir) in - Build.all (List.map paths ~f:Build.read_sexp) - >>^ fun sexps -> - let files_contents = List.combine files sexps |> String.Map.of_list_exn in - let set = Ordered_set_lang.Unexpanded.expand set ~files_contents ~f in - Ordered_set_lang.String.eval set ~standard ~parse diff --git a/src/super_context.mli b/src/super_context.mli index 8e0ebd8d3c2..8ec0286e2d7 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -40,6 +40,7 @@ val artifacts : t -> Artifacts.t val stanzas_to_consider_for_install : t -> (Path.t * Scope.t * Stanza.t) list val cxx_flags : t -> string list val build_dir : t -> Path.t +val profile : t -> string val host : t -> t val build_system : t -> Build_system.t @@ -49,6 +50,21 @@ val public_libs : t -> Lib.DB.t (** Installed libraries that are not part of the workspace *) val installed_libs : t -> Lib.DB.t +(** All non-public library names *) +val internal_lib_names : t -> String.Set.t + +(** Compute the ocaml flags based on the directory environment and a + buildable stanza *) +val ocaml_flags + : t + -> dir:Path.t + -> scope:Scope.t + -> Buildable.t + -> Ocaml_flags.t + +(** Dump a directory environment in a readable form *) +val dump_env : t -> dir:Path.t -> (unit, Sexp.t list) Build.t + val find_scope_by_dir : t -> Path.t -> Scope.t val find_scope_by_name : t -> string option -> Scope.t @@ -66,14 +82,15 @@ val expand_and_eval_set -> dir:Path.t -> ?extra_vars:Action.Var_expansion.t String.Map.t -> Ordered_set_lang.Unexpanded.t - -> standard:string list + -> standard:(unit, string list) Build.t -> (unit, string list) Build.t val prefix_rules - : t + : t -> (unit, unit) Build.t -> f:(unit -> 'a) -> 'a + val add_rule : t -> ?sandbox:bool diff --git a/src/utop.ml b/src/utop.ml index 13394971f56..b8ab074e77a 100644 --- a/src/utop.ml +++ b/src/utop.ml @@ -78,6 +78,8 @@ let setup sctx ~dir ~(libs : Library.t list) ~scope = ~scope ~linkages:[Exe.Linkage.custom] ~requires - ~flags:(Ocaml_flags.append_common (Ocaml_flags.default ()) ["-w"; "-24"]) + ~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 diff --git a/src/workspace.ml b/src/workspace.ml index fc7b2f89f5b..7af6068b1ba 100644 --- a/src/workspace.ml +++ b/src/workspace.ml @@ -16,39 +16,57 @@ module Context = struct module Opam = struct type t = { name : string + ; profile : string ; switch : string ; root : string option ; merlin : bool ; targets : Target.t list } - let t = + let t ~profile = field "switch" string >>= fun switch -> field "name" string ~default:switch >>= fun name -> field "targets" (list Target.t) ~default:[Target.Native] >>= fun targets -> field_o "root" string >>= fun root -> field_b "merlin" >>= fun merlin -> + field "profile" string ~default:profile >>= fun profile -> return { switch ; name ; root ; merlin ; targets + ; profile } end - type t = Default of Target.t list | Opam of Opam.t + module Default = struct + type t = + { profile : string + ; targets : Target.t list + } - let t = function - | Atom (_, A "default") -> Default [Native] - | List (_, List _ :: _) as sexp -> Opam (record Opam.t sexp) + let t ~profile = + field "targets" (list Target.t) ~default:[Target.Native] + >>= fun targets -> + field "profile" string ~default:profile + >>= fun profile -> + return { targets; profile } + end + + type t = Default of Default.t | Opam of Opam.t + + let t ~profile = function + | Atom (_, A "default") -> + Default { targets = [Native] + ; profile + } + | List (_, List _ :: _) as sexp -> Opam (record (Opam.t ~profile) sexp) | sexp -> sum [ cstr_record "default" - (field "targets" (list Target.t) ~default:[Target.Native] - >>= fun targets -> - return (Default targets)) + (Default.t ~profile >>= fun x -> return (Default x)) ; cstr_record "opam" - (Opam.t >>= fun x -> return (Opam x)) + (Opam.t ~profile >>= fun x -> return (Opam x)) ] sexp @@ -57,8 +75,8 @@ module Context = struct | Opam o -> o.name let targets = function - | Default l -> l - | Opam o -> o.targets + | Default x -> x.targets + | Opam x -> x.targets let all_names t = let n = name t in @@ -72,15 +90,38 @@ type t = ; contexts : Context.t list } -let t ?x sexps = +type item = Context of Sexp.Ast.t | Profile of Loc.t * string + +let item_of_sexp = + sum + [ cstr "context" (raw @> nil) (fun x -> Context x) + ; cstr_loc "profile" (string @> nil) (fun loc x -> Profile (loc, x)) + ] + +let t ?x ?profile:cmdline_profile sexps = let defined_names = ref String.Set.empty in - let merlin_ctx, contexts = - List.fold_left sexps ~init:(None, []) ~f:(fun (merlin_ctx, ctxs) sexp -> - let ctx = - sum - [ cstr "context" (Context.t @> nil) (fun x -> x) ] - sexp - in + let profiles, contexts = + List.partition_map sexps ~f:(fun sexp -> + match item_of_sexp sexp with + | Profile (loc, p) -> Left (loc, p) + | Context c -> Right c) + in + let profile = + match profiles, cmdline_profile with + | _ :: (loc, _) :: _, _ -> + Loc.fail loc "profile defined too many times" + | _, Some p -> p + | [], None -> "default" + | [(_, p)], None -> p + in + let { merlin_context; contexts } = + let init = + { merlin_context = None + ; contexts = [] + } + in + List.fold_left contexts ~init ~f:(fun t sexp -> + let ctx = Context.t ~profile sexp in let ctx = match x with | None -> ctx @@ -93,8 +134,10 @@ let t ?x sexps = targets @ [target] in match ctx with - | Default targets -> Default (add_target target targets) - | Opam o -> Opam { o with targets = add_target target o.targets } + | Default d -> + Default { d with targets = add_target target d.targets } + | Opam o -> + Opam { o with targets = add_target target o.targets } in let name = Context.name ctx in if name = "" || @@ -108,22 +151,22 @@ let t ?x sexps = of_sexp_errorf sexp "second definition of build context %S" name; defined_names := String.Set.union !defined_names (String.Set.of_list (Context.all_names ctx)); - match ctx, merlin_ctx with + match ctx, t.merlin_context with | Opam { merlin = true; _ }, Some _ -> of_sexp_errorf sexp "you can only have one context for merlin" | Opam { merlin = true; _ }, None -> - (Some name, ctx :: ctxs) + { merlin_context = Some name; contexts = ctx :: t.contexts } | _ -> - (merlin_ctx, ctx :: ctxs)) + { t with contexts = ctx :: t.contexts }) in let contexts = match contexts with - | [] -> [Context.Default [Native]] + | [] -> [Context.Default { targets = [Native]; profile }] | _ -> contexts in - let merlin_ctx = - match merlin_ctx with - | Some _ -> merlin_ctx + let merlin_context = + match merlin_context with + | Some _ -> merlin_context | None -> if List.exists contexts ~f:(function Context.Default _ -> true | _ -> false) then @@ -131,8 +174,8 @@ let t ?x sexps = else None in - { merlin_context = merlin_ctx - ; contexts = List.rev contexts + { merlin_context + ; contexts = List.rev contexts } -let load ?x p = t ?x (Io.Sexp.load p ~mode:Many) +let load ?x ?profile p = t ?x ?profile (Io.Sexp.load p ~mode:Many) diff --git a/src/workspace.mli b/src/workspace.mli index d4bac52e0c7..fb7c346e929 100644 --- a/src/workspace.mli +++ b/src/workspace.mli @@ -10,15 +10,23 @@ module Context : sig end module Opam : sig type t = - { name : string - ; switch : string - ; root : string option - ; merlin : bool + { name : string + ; profile : string + ; switch : string + ; root : string option + ; merlin : bool ; targets : Target.t list } end - type t = Default of Target.t list | Opam of Opam.t + module Default : sig + type t = + { profile : string + ; targets : Target.t list + } + end + + type t = Default of Default.t | Opam of Opam.t val name : t -> string end @@ -28,4 +36,4 @@ type t = ; contexts : Context.t list } -val load : ?x:string -> Path.t -> t +val load : ?x:string -> ?profile:string -> Path.t -> t diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index f366d6876b1..f8dbff41e92 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -57,6 +57,14 @@ test-cases/depend-on-the-universe (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))) +(alias + ((name env) + (deps ((package dune) (files_recursively_in test-cases/env))) + (action + (chdir + test-cases/env + (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))) + (alias ((name exclude-missing-module) (deps @@ -444,6 +452,7 @@ (alias copy_files) (alias cross-compilation) (alias depend-on-the-universe) + (alias env) (alias exclude-missing-module) (alias exec-cmd) (alias findlib) @@ -496,6 +505,7 @@ (alias copy_files) (alias cross-compilation) (alias depend-on-the-universe) + (alias env) (alias exclude-missing-module) (alias exec-cmd) (alias findlib) diff --git a/test/blackbox-tests/test-cases/env/bin/jbuild b/test/blackbox-tests/test-cases/env/bin/jbuild new file mode 100644 index 00000000000..3ea8a9f15a7 --- /dev/null +++ b/test/blackbox-tests/test-cases/env/bin/jbuild @@ -0,0 +1,3 @@ +(env + (default + (flags (-machin)))) diff --git a/test/blackbox-tests/test-cases/env/jbuild b/test/blackbox-tests/test-cases/env/jbuild new file mode 100644 index 00000000000..10a480440d0 --- /dev/null +++ b/test/blackbox-tests/test-cases/env/jbuild @@ -0,0 +1,3 @@ +(env + (default + (flags (:standard -plop)))) diff --git a/test/blackbox-tests/test-cases/env/run.t b/test/blackbox-tests/test-cases/env/run.t new file mode 100644 index 00000000000..3f9588ed6d3 --- /dev/null +++ b/test/blackbox-tests/test-cases/env/run.t @@ -0,0 +1,36 @@ + $ dune printenv . + ( + (flags (-w -40 -plop)) + (ocamlc_flags (-g)) + (ocamlopt_flags (-g)) + ) + $ dune printenv src + ( + (flags (-w -40 -plop -truc)) + (ocamlc_flags (-g)) + (ocamlopt_flags (-g)) + ) + $ dune printenv bin + ( + (flags (-machin)) + (ocamlc_flags (-g)) + (ocamlopt_flags (-g)) + ) + $ dune printenv vendor + ( + (flags (-w -40 -plop)) + (ocamlc_flags (-g)) + (ocamlopt_flags (-g)) + ) + $ dune printenv vendor/a + ( + (flags (-w -40 -bidule)) + (ocamlc_flags (-g)) + (ocamlopt_flags (-g)) + ) + $ dune printenv vendor/a/src + ( + (flags (-w -40 -bidule -pouet)) + (ocamlc_flags (-g)) + (ocamlopt_flags (-g)) + ) diff --git a/test/blackbox-tests/test-cases/env/src/jbuild b/test/blackbox-tests/test-cases/env/src/jbuild new file mode 100644 index 00000000000..750f0be1757 --- /dev/null +++ b/test/blackbox-tests/test-cases/env/src/jbuild @@ -0,0 +1,3 @@ +(env + (default + (flags (:standard -truc)))) diff --git a/test/blackbox-tests/test-cases/env/vendor/a/a.opam b/test/blackbox-tests/test-cases/env/vendor/a/a.opam new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/env/vendor/a/jbuild b/test/blackbox-tests/test-cases/env/vendor/a/jbuild new file mode 100644 index 00000000000..4d10c80c795 --- /dev/null +++ b/test/blackbox-tests/test-cases/env/vendor/a/jbuild @@ -0,0 +1,3 @@ +(env + (default + (flags (:standard -bidule)))) diff --git a/test/blackbox-tests/test-cases/env/vendor/a/src/jbuild b/test/blackbox-tests/test-cases/env/vendor/a/src/jbuild new file mode 100644 index 00000000000..3721468f9cf --- /dev/null +++ b/test/blackbox-tests/test-cases/env/vendor/a/src/jbuild @@ -0,0 +1,3 @@ +(env + (default + (flags (:standard -pouet))))