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

Merge pull request #950 from rgrinberg/dep-conf-list 

Syntax for naming dependencies
This commit is contained in:
Rudi Grinberg 2018-07-10 02:47:51 +07:00 committed by GitHub
parent e9027b4b11 80b3684f9f
commit 1ac0da6347
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
47 changed files with 702 additions and 455 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
CHANGES.md
View File

@ -143,6 +143,9 @@ next
- Lowercase all built-in %{variables} in dune files (#956, @rgrinberg)
- New syntax for naming dependencies: `(deps (:x a b) (:y (glob_files *.c*)))`.
This replaces the use for `${<}` in dune files. (#950, @diml, @rgrinberg)
1.0+beta20 (10/04/2018)
-----------------------

90
doc/dune-files.rst
View File

@ -22,7 +22,7 @@ Stanzas
(rule
(targets foo.ml)
(deps generator/gen.exe)
(action (run %{<} -o %{@})))
(action (run %{deps} -o %{targets})))
The following sections describe the available stanzas and their meaning.
@ -457,9 +457,9 @@ For instance:
.. code:: scheme
(rule
(targets b
(deps a
(action (copy %{<} %{@})))))
(targets b)
(deps a)
(action (copy %{deps} %{targets})))
In this example it is obvious by inspecting the action what the
dependencies and targets are. When this is the case you can use the
@ -495,7 +495,7 @@ ocamllex
(rule
(targets <name>.ml)
(deps <name>.mll)
(action (chdir %{root} (run %{bin:ocamllex} -q -o %{<}))))
(action (chdir %{root} (run %{bin:ocamllex} -q -o %{targets} %{deps}))))
To use a different rule mode, use the long form:
@ -515,7 +515,7 @@ ocamlyacc
(rule
(targets <name>.ml <name>.mli)
(deps <name>.mly)
(action (chdir %{root} (run %{bin:ocamlyacc} %{<}))))
(action (chdir %{root} (run %{bin:ocamlyacc} %{deps}))))
To use a different rule mode, use the long form:
@ -866,9 +866,8 @@ Dune supports the following variables:
In addition, ``(action ...)`` fields support the following special variables:
- ``@`` expands to the list of target
- ``<`` expands to the first dependency, or the empty string if there are no
dependencies
- ``targets`` expands to the list of target
- ``deps`` expands to the list of dependencies
- ``^`` expands to the list of dependencies, separated by spaces
- ``dep:<path>`` expands to ``<path>`` (and adds ``<path>`` as a dependency of
the action)
@ -909,7 +908,7 @@ In addition, ``(action ...)`` fields support the following special variables:
The ``%{<kind>:...}`` forms are what allows you to write custom rules that work
transparently whether things are installed or not.
Note that aliases are ignored by both ``%{<}`` and ``%{^}``.
Note that aliases are ignored by ``%{deps}``
The intent of this last form is to reliably read a list of strings
generated by an OCaml program via:
@ -920,13 +919,13 @@ generated by an OCaml program via:
#. Expansion of lists
Forms that expands to list of items, such as ``%{cc}``, ``%{^}``,
``%{@}`` or ``%{read-lines:...}``, are suitable to be used in, say,
Forms that expands to list of items, such as ``%{cc}``, ``%{deps}``,
``%{targets}`` or ``%{read-lines:...}``, are suitable to be used in, say,
``(run <prog> <arguments>)``. For instance in:
.. code:: scheme
(run foo %{^})
(run foo %{deps})
if there are two dependencies ``a`` and ``b``, the produced command
will be equivalent to the shell command:
@ -940,7 +939,7 @@ you have to quote the variable as in:
.. code:: scheme
(run foo "%{^}")
(run foo "%{deps}")
which is equivalent to the following shell command:
@ -949,7 +948,7 @@ which is equivalent to the following shell command:
$ foo "a b"
(the items of the list are concatenated with space).
Note that, since ``%{^}`` is a list of items, the first one may be
Note that, since ``%{deps}`` is a list of items, the first one may be
used as a program name, for instance:
.. code:: scheme
@ -957,7 +956,7 @@ used as a program name, for instance:
(rule
(targets result.txt)
(deps foo.exe (glob_files *.txt))
(action (run %{^})))
(action (run %{deps})))
Here is another example:
@ -966,7 +965,7 @@ Here is another example:
(rule
(targets foo.exe)
(deps foo.c)
(action (run %{cc} -o %{@} %{<} -lfoolib)))
(action (run %{cc} -o %{targets} %{deps} -lfoolib)))
Library dependencies
@ -1038,11 +1037,11 @@ the ``-pp`` or ``-ppx`` of the various OCaml tools.
Preprocessing with actions
~~~~~~~~~~~~~~~~~~~~~~~~~~
``<action>`` uses the same DSL as described in the `User actions`_ section, and
for the same reason given in that section, it will be executed from the root of
the current build context. It is expected to be an action that reads the file
given as only dependency and outputs the preprocessed file on its standard
output.
``<action>`` uses the same DSL as described in the `User actions`_
section, and for the same reason given in that section, it will be
executed from the root of the current build context. It is expected to
be an action that reads the file given as only dependency named
``input-file`` and outputs the preprocessed file on its standard output.
More precisely, ``(preprocess (action <action>))`` acts as if
you had setup a rule for every file of the form:
@ -1052,10 +1051,10 @@ you had setup a rule for every file of the form:
(rule
(targets file.pp.ml)
(deps file.ml)
(action (with-stdout-to %{@} (chdir %{root} <action>))))
(action (with-stdout-to %{targets} (chdir %{root} <action>))))
The equivalent of a ``-pp <command>`` option passed to the OCaml compiler is
``(system "<command> %{<}")``.
``(system "<command> %{input-file}")``.
Preprocessing with ppx rewriters
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@ -1105,8 +1104,8 @@ For instance:
.. code:: scheme
(preprocess (per_module
(((action (run ./pp.sh X=1 %{<})) (foo bar)))
(((action (run ./pp.sh X=2 %{<})) (baz)))))
(((action (run ./pp.sh X=1 %{input-file})) (foo bar)))
(((action (run ./pp.sh X=2 %{input-file})) (baz)))))
.. _deps-field:
@ -1116,6 +1115,8 @@ Dependency specification
Dependencies in ``dune`` files can be specified using one of the following
syntax:
- ``(:name <dependencies>)`` will bind the the list of dependencies to the
``name`` variable. This variable will be available as ``%{name}`` in actions.
- ``(file <filename>)`` or simply ``<filename>``: depend on this file
- ``(alias <alias-name>)``: depend on the construction of this alias, for
instance: ``(alias src/runtest)``
@ -1143,6 +1144,33 @@ syntax:
In all these cases, the argument supports `Variables expansion`_.
Named Dependencies
~~~~~~~~~~~~~~~~~~
dune allows a user to organize dependency lists by naming them. The user is
allowed to assign a group of dependencies a name that can later be referred to
in actions (like the ``%{deps}`` and ``%{targets}`` built in variables).
One instance where is useful is for naming globs. Here's an example of an
imaginary bundle command:
.. code:: scheme
(rule
(targets archive.tar)
(deps
index.html
(:css (glob_files *.css))
(:js foo.js bar.js)
(:img (glob_files *.png) (glob_files *.jpg)))
(action
(run %{bin:bundle} index.html -css %{css} -js %{js} -img %{img} -o %{targets})))
Note that such named dependency list can also include unnamed dependencies (like
``index.html`` in the example above). Also, such user defined names wil shadow
built in variables. So ``(:root x)`` will shadow the built in ``%{root}``
variable.
.. _glob:
Glob
@ -1310,7 +1338,7 @@ To understand why this is important, let's consider this dune file living in
(rule
(targets blah.ml)
(deps blah.mll)
(action (run ocamllex -o %{@} %{<})))
(action (run ocamllex -o %{targets} %{deps})))
Here the command that will be executed is:
@ -1334,7 +1362,7 @@ of your project. What you should write instead is:
(rule
(targets blah.ml)
(deps blah.mll)
(action (chdir %{root} (run ocamllex -o %{@} %{<}))))
(action (chdir %{root} (run ocamllex -o %{targets} %{deps}))))
Locks
-----
@ -1357,13 +1385,13 @@ same lock:
(name runtest)
(deps foo)
(locks m)
(action (run test.exe %{<})))
(action (run test.exe %{deps})))
(alias
(name runtest)
(deps bar)
(locks m)
(action (run test.exe %{<})))
(action (run test.exe %{deps})))
Dune will make sure that the executions of ``test.exe foo`` and
``test.exe bar`` are serialized.
@ -1383,7 +1411,7 @@ simply use an absolute filename:
(name runtest)
(deps foo)
(locks /tcp-port/1042)
(action (run test.exe %{<})))
(action (run test.exe %{deps})))
.. _ocaml-syntax:

21
doc/migration.rst
View File

@ -169,7 +169,6 @@ Jbuild Dune
======================== ============
``${@}`` ``%{targets}``
``${^}`` ``%{deps}``
``${<}`` ``%{first-dep}``
``${path:file}`` ``%{dep:file}``
``${SCOPE_ROOT}`` ``%{project_root}``
``${findlib:..}`` ``%{lib:..}``
@ -186,8 +185,26 @@ Jbuild Dune
Removed Variables
-----------------
``${path-no-dep:file}`` has been removed.
``${path-no-dep:file}`` and ``${<}`` have been removed.
A named dependency should be used instead of ``${<}``. For instance
the following jbuild file:
.. code:: scheme
(alias
((name runtest)
(deps (input))
(action (run ./test.exe %{<}))))
should be rewritten to the following dune file:
.. code:: scheme
(alias
(name runtest)
(deps (:x input))
(action (run ./test.exe %{x})))
``# JBUILDER_GEN`` renamed
--------------------------

2
doc/tests.rst
View File

@ -307,7 +307,7 @@ The backend for such a framework looks like this:
(library
((name simple_tests)
(inline_tests.backend
((generate_runner (run sed "s/(\\*TEST:\\(.*\\)\\*)/let () = \\1;;/" ${impl-files}))
((generate_runner (run sed "s/(\\*TEST:\\(.*\\)\\*)/let () = \\1;;/" %{impl-files}))
))))
Now all you have to do is write ``(inline_tests ((backend

2
src/action.ml
View File

@ -525,7 +525,7 @@ module Unexpanded = struct
Redirect (outputs, E.path ~dir ~f fn, partial_expand t ~dir ~map_exe ~f)
| Ignore (outputs, t) ->
Ignore (outputs, partial_expand t ~dir ~map_exe ~f)
| Progn l -> Progn (List.map l ~f:(fun t -> partial_expand t ~dir ~map_exe ~f))
| Progn l -> Progn (List.map l ~f:(partial_expand ~dir ~map_exe ~f))
| Echo xs -> Echo (List.map xs ~f:(E.cat_strings ~dir ~f))
| Cat x -> Cat (E.path ~dir ~f x)
| Copy (x, y) ->

10
src/gen_rules.ml
View File

@ -187,13 +187,14 @@ module Gen(P : Install_rules.Params) = struct
in
SC.add_rule_get_targets sctx ~mode:rule.mode ~loc:rule.loc
~locks:(interpret_locks ~dir ~scope rule.locks)
(SC.Deps.interpret sctx ~scope ~dir rule.deps
(SC.Deps.interpret_named sctx ~scope ~dir rule.deps
>>>
SC.Action.run
sctx
(snd rule.action)
~loc:(fst rule.action)
~dir
~bindings:(Pform.Map.of_bindings rule.deps)
~dep_kind:Required
~targets
~scope)
@ -929,7 +930,7 @@ module Gen(P : Install_rules.Params) = struct
let module S = Sexp.To_sexp in
Sexp.List
[ Sexp.unsafe_atom_of_string "user-alias"
; S.list Jbuild.Dep_conf.sexp_of_t alias_conf.deps
; Jbuild.Bindings.sexp_of_t Jbuild.Dep_conf.sexp_of_t alias_conf.deps
; S.option Action.Unexpanded.sexp_of_t
(Option.map alias_conf.action ~f:snd)
]
@ -939,7 +940,7 @@ module Gen(P : Install_rules.Params) = struct
~name:alias_conf.name
~stamp
~locks:(interpret_locks ~dir ~scope alias_conf.locks)
(SC.Deps.interpret sctx ~scope ~dir alias_conf.deps
(SC.Deps.interpret_named sctx ~scope ~dir alias_conf.deps
>>>
match alias_conf.action with
| None -> Build.progn []
@ -950,6 +951,7 @@ module Gen(P : Install_rules.Params) = struct
~loc
~dir
~dep_kind:Required
~bindings:(Pform.Map.of_bindings alias_conf.deps)
~targets:Alias
~scope)
@ -976,7 +978,7 @@ module Gen(P : Install_rules.Params) = struct
let rule =
{ Rule.
targets = Infer
; deps = []
; deps = Bindings.empty
; action =
(loc, Action.Unexpanded.Redirect (Stdout, diff.file2, run_action))
; mode = Standard

22
src/inline_tests.ml
View File

@ -179,8 +179,9 @@ include Sub_system.Register_end_point(
~obj_name:name)
in
let extra_vars =
String.Map.singleton "library-name" ([Value.String lib.name])
let bindings =
Pform.Map.singleton "library-name"
(Values [String lib.name])
in
let runner_libs =
@ -202,25 +203,24 @@ include Sub_system.Register_end_point(
let target = Path.relative inline_test_dir main_module_filename in
let source_modules = Module.Name.Map.values source_modules in
let files ml_kind =
Value.L.paths (
Pform.Values (Value.L.paths (
List.filter_map source_modules ~f:(fun m ->
Module.file m ~dir ml_kind))
Module.file m ~dir ml_kind)))
in
let extra_vars =
List.fold_left
let bindings =
Pform.Map.of_list_exn
[ "impl-files", files Impl
; "intf-files", files Intf
]
~init:extra_vars
~f:(fun acc (k, v) -> String.Map.add acc k v)
in
Build.return []
Build.return Bindings.empty
>>>
Build.all
(List.filter_map backends ~f:(fun (backend : Backend.t) ->
Option.map backend.info.generate_runner ~f:(fun (loc, action) ->
SC.Action.run sctx action ~loc
~extra_vars ~dir ~dep_kind:Required ~targets:Alias ~scope)))
~bindings
~dir ~dep_kind:Required ~targets:Alias ~scope)))
>>^ (fun actions ->
Action.with_stdout_to target
(Action.progn actions))
@ -251,7 +251,7 @@ include Sub_system.Register_end_point(
Super_context.expand_and_eval_set sctx flags
~scope
~dir
~extra_vars
~bindings
~standard:(Build.return [])))
>>^ List.concat
in

104
src/jbuild.ml
View File

@ -232,6 +232,63 @@ module Pps_and_flags = struct
Dune_syntax.t
end
module Bindings = struct
type 'a one =
| Unnamed of 'a
| Named of string * 'a list
type 'a t = 'a one list
let fold t ~f ~init = List.fold_left ~f:(fun acc x -> f x acc) ~init t
let to_list =
List.concat_map ~f:(function
| Unnamed x -> [x]
| Named (_, xs) -> xs)
let find t k =
List.find_map t ~f:(function
| Unnamed _ -> None
| Named (k', x) -> Option.some_if (k = k') x)
let empty = []
let singleton x = [Unnamed x]
let t elem =
let rec loop vars acc =
peek >>= function
| None -> return (List.rev acc)
| Some (List (_, Atom (loc, A s) :: _)) when
String.length s > 1 && s.[0] = ':' ->
let name = String.sub s ~pos:1 ~len:(String.length s - 1) in
let vars =
if not (String.Set.mem vars name) then
String.Set.add vars name
else
of_sexp_errorf loc "Variable %s is defined for the second time."
name
in
enter (junk >>= fun () -> repeat elem)
>>= fun values ->
loop vars (Named (name, values) :: acc)
| _ ->
elem >>= fun x ->
loop vars (Unnamed x :: acc)
in
Stanza.file_kind () >>= function
| Jbuild -> list (elem >>| fun x -> Unnamed x)
| Dune -> loop String.Set.empty []
let sexp_of_t sexp_of_a bindings =
Sexp.List (
List.map bindings ~f:(function
| Unnamed a -> sexp_of_a a
| Named (name, bindings) ->
Sexp.List (Sexp.atom (":" ^ name) :: List.map ~f:sexp_of_a bindings))
)
end
module Dep_conf = struct
type t =
| File of String_with_vars.t
@ -269,21 +326,23 @@ module Dep_conf = struct
open Sexp
let sexp_of_t = function
| File t ->
List [Sexp.unsafe_atom_of_string "file" ; String_with_vars.sexp_of_t t]
List [ Sexp.unsafe_atom_of_string "file"
; String_with_vars.sexp_of_t t ]
| Alias t ->
List [Sexp.unsafe_atom_of_string "alias" ; String_with_vars.sexp_of_t t]
List [ Sexp.unsafe_atom_of_string "alias"
; String_with_vars.sexp_of_t t ]
| Alias_rec t ->
List [Sexp.unsafe_atom_of_string "alias_rec" ;
String_with_vars.sexp_of_t t]
List [ Sexp.unsafe_atom_of_string "alias_rec"
; String_with_vars.sexp_of_t t ]
| Glob_files t ->
List [Sexp.unsafe_atom_of_string "glob_files" ;
String_with_vars.sexp_of_t t]
List [ Sexp.unsafe_atom_of_string "glob_files"
; String_with_vars.sexp_of_t t ]
| Source_tree t ->
List [Sexp.unsafe_atom_of_string "files_recursively_in" ;
String_with_vars.sexp_of_t t]
List [ Sexp.unsafe_atom_of_string "files_recursively_in"
; String_with_vars.sexp_of_t t ]
| Package t ->
List [Sexp.unsafe_atom_of_string "package" ;
String_with_vars.sexp_of_t t]
List [ Sexp.unsafe_atom_of_string "package"
; String_with_vars.sexp_of_t t]
| Universe ->
Sexp.unsafe_atom_of_string "universe"
end
@ -1071,7 +1130,7 @@ module Rule = struct
type t =
{ targets : Targets.t
; deps : Dep_conf.t list
; deps : Dep_conf.t Bindings.t
; action : Loc.t * Action.Unexpanded.t
; mode : Mode.t
; locks : String_with_vars.t list
@ -1113,7 +1172,7 @@ module Rule = struct
let short_form =
located Action.Unexpanded.t >>| fun (loc, action) ->
{ targets = Infer
; deps = []
; deps = Bindings.empty
; action = (loc, action)
; mode = Standard
; locks = []
@ -1126,7 +1185,8 @@ module Rule = struct
>>= fun action ->
field "targets" (list file_in_current_dir)
>>= fun targets ->
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
field "deps" (Bindings.t Dep_conf.t) ~default:Bindings.empty
>>= fun deps ->
field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
map_validate
(field_b
@ -1231,7 +1291,7 @@ module Rule = struct
let src = name ^ ".mll" in
let dst = name ^ ".ml" in
{ targets = Static [dst]
; deps = [File (S.virt_text __POS__ src)]
; deps = Bindings.singleton (Dep_conf.File (S.virt_text __POS__ src))
; action =
(loc,
Chdir
@ -1240,7 +1300,7 @@ module Rule = struct
[ S.virt_text __POS__ "-q"
; S.virt_text __POS__ "-o"
; S.virt_var __POS__ "targets"
; S.virt_var __POS__"first-dep"
; S.virt_var __POS__"deps"
])))
; mode
; locks = []
@ -1252,13 +1312,13 @@ module Rule = struct
List.map modules ~f:(fun name ->
let src = name ^ ".mly" in
{ targets = Static [name ^ ".ml"; name ^ ".mli"]
; deps = [File (S.virt_text __POS__ src)]
; deps = Bindings.singleton (Dep_conf.File (S.virt_text __POS__ src))
; action =
(loc,
Chdir
(S.virt_var __POS__ "root",
Run (S.virt_text __POS__ "ocamlyacc",
[S.virt_var __POS__ "first-dep"])))
[S.virt_var __POS__ "deps"])))
; mode
; locks = []
; loc
@ -1320,7 +1380,7 @@ end
module Alias_conf = struct
type t =
{ name : string
; deps : Dep_conf.t list
; deps : Dep_conf.t Bindings.t
; action : (Loc.t * Action.Unexpanded.t) option
; locks : String_with_vars.t list
; package : Package.t option
@ -1336,10 +1396,11 @@ module Alias_conf = struct
let t =
record
(field "name" alias_name >>= fun name ->
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
field_o "package" Pkg.t >>= fun package ->
field_o "action" (located Action.Unexpanded.t) >>= fun action ->
field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
field "deps" (Bindings.t Dep_conf.t) ~default:Bindings.empty
>>= fun deps ->
return
{ name
; deps
@ -1354,7 +1415,7 @@ module Tests = struct
{ exes : Executables.t
; locks : String_with_vars.t list
; package : Package.t option
; deps : Dep_conf.t list
; deps : Dep_conf.t Bindings.t
}
let gen_parse names =
@ -1362,11 +1423,12 @@ module Tests = struct
(Buildable.t >>= fun buildable ->
field_oslu "link_flags" >>= fun link_flags ->
names >>= fun names ->
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
field_o "package" Pkg.t >>= fun package ->
field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
field "modes" Executables.Link_mode.Set.t
~default:Executables.Link_mode.Set.default >>= fun modes ->
field "deps" (Bindings.t Dep_conf.t) ~default:Bindings.empty
>>= fun deps ->
return
{ exes =
{ Executables.

26
src/jbuild.mli
View File

@ -81,6 +81,26 @@ module Lib_deps : sig
val of_pps : Pp.t list -> t
end
module Bindings : sig
type 'a one =
| Unnamed of 'a
| Named of string * 'a list
type 'a t = 'a one list
val find : 'a t -> string -> 'a list option
val fold : 'a t -> f:('a one -> 'acc -> 'acc) -> init:'acc -> 'acc
val empty : 'a t
val to_list : 'a t -> 'a list
val singleton : 'a -> 'a t
val sexp_of_t : ('a -> Usexp.t) -> 'a t -> Usexp.t
end
module Dep_conf : sig
type t =
| File of String_with_vars.t
@ -284,7 +304,7 @@ module Rule : sig
type t =
{ targets : Targets.t
; deps : Dep_conf.t list
; deps : Dep_conf.t Bindings.t
; action : Loc.t * Action.Unexpanded.t
; mode : Mode.t
; locks : String_with_vars.t list
@ -307,7 +327,7 @@ end
module Alias_conf : sig
type t =
{ name : string
; deps : Dep_conf.t list
; deps : Dep_conf.t Bindings.t
; action : (Loc.t * Action.Unexpanded.t) option
; locks : String_with_vars.t list
; package : Package.t option
@ -350,7 +370,7 @@ module Tests : sig
{ exes : Executables.t
; locks : String_with_vars.t list
; package : Package.t option
; deps : Dep_conf.t list
; deps : Dep_conf.t Bindings.t
}
end

171
src/pform.ml
View File

@ -1,68 +1,55 @@
open Import
module Var = struct
type t =
| Values of Value.t list
| Project_root
| First_dep
| Deps
| Targets
type t =
| Values of Value.t list
| Project_root
| First_dep
| Deps
| Targets
| Named_local
| Exe
| Dep
| Bin
| Lib
| Libexec
| Lib_available
| Version
| Read
| Read_strings
| Read_lines
| Path_no_dep
| Ocaml_config
let to_value_no_deps_or_targets t ~scope =
match t with
| Values v -> Some v
| Project_root -> Some [Value.Dir (Scope.root scope)]
| First_dep
| Deps
| Targets -> None
end
module Macro = struct
type t =
| Exe
| Dep
| Bin
| Lib
| Libexec
| Lib_available
| Version
| Read
| Read_strings
| Read_lines
| Path_no_dep
| Ocaml_config
end
type 'a t =
| No_info of 'a
| Since of 'a * Syntax.Version.t
| Deleted_in of 'a * Syntax.Version.t
type with_info =
| No_info of t
| Since of t * Syntax.Version.t
| Deleted_in of t * Syntax.Version.t * string option
| Renamed_in of Syntax.Version.t * string
module Map = struct
type nonrec 'a t = 'a t String.Map.t
type t = with_info String.Map.t
let values v = No_info (Var.Values v)
let renamed_in ~new_name ~version = Renamed_in (version, new_name)
let deleted_in ~version kind = Deleted_in (kind, version)
let since ~version v = Since (v, version)
let values v = No_info (Values v)
let renamed_in ~new_name ~version = Renamed_in (version, new_name)
let deleted_in ~version ?repl kind = Deleted_in (kind, version, repl)
let since ~version v = Since (v, version)
let static_vars =
[ "first-dep", since ~version:(1, 0) Var.First_dep
; "targets", since ~version:(1, 0) Var.Targets
; "deps", since ~version:(1, 0) Var.Deps
; "project_root", since ~version:(1, 0) Var.Project_root
let static =
let macro x = No_info x in
[ "targets", since ~version:(1, 0) Targets
; "deps", since ~version:(1, 0) Deps
; "project_root", since ~version:(1, 0) Project_root
; "<", renamed_in ~version:(1, 0) ~new_name:"first-dep"
; "<", deleted_in First_dep ~version:(1, 0)
~repl:"Use a named dependency instead:\
\n\
\n\ (deps (:x <dep>) ...)\
\n\ ... %{x} ..."
; "@", renamed_in ~version:(1, 0) ~new_name:"targets"
; "^", renamed_in ~version:(1, 0) ~new_name:"deps"
; "SCOPE_ROOT", renamed_in ~version:(1, 0) ~new_name:"project_root"
]
let macros =
let macro kind = No_info kind in
let open Macro in
[ "exe", macro Exe
; "exe", macro Exe
; "bin", macro Bin
; "lib", macro Lib
; "libexec", macro Libexec
@ -82,7 +69,7 @@ module Map = struct
]
|> String.Map.of_list_exn
let create_vars ~(context : Context.t) ~cxx_flags =
let create ~(context : Context.t) ~cxx_flags =
let ocamlopt =
match context.ocamlopt with
| None -> Path.relative context.ocaml_bin "ocamlopt"
@ -107,11 +94,13 @@ module Map = struct
; "arch_sixtyfour" , string (string_of_bool context.arch_sixtyfour)
; "make" , make
; "root" , values [Value.Dir context.build_dir]
] in
]
in
let uppercased =
List.map lowercased ~f:(fun (k, _) ->
(String.uppercase k, renamed_in ~new_name:k ~version:(1, 0))) in
let vars =
(String.uppercase k, renamed_in ~new_name:k ~version:(1, 0)))
in
let other =
[ "-verbose" , values []
; "pa_cpp" , strings (context.c_compiler :: cflags
@ ["-undef"; "-traditional";
@ -128,49 +117,67 @@ module Map = struct
; "profile" , string context.profile
]
in
[ static_vars
; lowercased
; uppercased
; vars
]
|> List.concat
|> String.Map.of_list_exn
String.Map.superpose
static
(String.Map.of_list_exn
(List.concat
[ lowercased
; uppercased
; other
]))
let static_vars = String.Map.of_list_exn static_vars
let superpose = String.Map.superpose
let rec expand t ~syntax_version ~var =
let name = String_with_vars.Var.name var in
let rec expand t ~syntax_version ~pform =
let name = String_with_vars.Var.name pform in
Option.bind (String.Map.find t name) ~f:(fun v ->
let what var =
String_with_vars.Var.to_string (
if String_with_vars.Var.is_macro var then
String_with_vars.Var.with_payload var ~payload:(Some "..")
else
var)
in
let describe = String_with_vars.Var.describe in
match v with
| No_info v -> Some v
| Since (v, min_version) ->
if syntax_version >= min_version then
Some v
else
Syntax.Error.since (String_with_vars.Var.loc var)
Syntax.Error.since (String_with_vars.Var.loc pform)
Stanza.syntax min_version
~what:(what var)
~what:(describe pform)
| Renamed_in (in_version, new_name) -> begin
if syntax_version >= in_version then
Syntax.Error.renamed_in (String_with_vars.Var.loc var)
Syntax.Error.renamed_in (String_with_vars.Var.loc pform)
Stanza.syntax syntax_version
~what:(what var)
~to_:(what (String_with_vars.Var.with_name var ~name:new_name))
~what:(describe pform)
~to_:(describe
(String_with_vars.Var.with_name pform ~name:new_name))
else
expand t ~syntax_version:in_version
~var:(String_with_vars.Var.with_name var ~name:new_name)
~pform:(String_with_vars.Var.with_name pform ~name:new_name)
end
| Deleted_in (v, in_version) ->
| Deleted_in (v, in_version, repl) ->
if syntax_version < in_version then
Some v
else
Syntax.Error.deleted_in (String_with_vars.Var.loc var)
Stanza.syntax syntax_version ~what:(what var))
Syntax.Error.deleted_in (String_with_vars.Var.loc pform)
Stanza.syntax syntax_version ~what:(describe pform) ?repl)
let empty = String.Map.empty
let singleton k v = String.Map.singleton k (No_info v)
let of_list_exn pforms =
List.map ~f:(fun (k, x) -> (k, No_info x)) pforms
|> String.Map.of_list_exn
let of_bindings =
Jbuild.Bindings.fold ~f:(fun x acc ->
match x with
| Unnamed _ -> acc
| Named (s, _) -> String.Map.add acc s (No_info Named_local)
) ~init:empty
let input_file path =
let value = Values (Value.L.paths [path]) in
[ "input-file", since ~version:(1, 0) value
; "<", renamed_in ~new_name:"input-file" ~version:(1, 0)
]
|> String.Map.of_list_exn
end

79
src/pform.mli
View File

@ -1,49 +1,50 @@
module Var : sig
type t =
| Values of Value.t list
| Project_root
| First_dep
| Deps
| Targets
open Stdune
val to_value_no_deps_or_targets : t -> scope:Scope.t -> Value.t list option
end
type t =
(* Variables *)
| Values of Value.t list
| Project_root
| First_dep
| Deps
| Targets
| Named_local
module Macro : sig
type t =
| Exe
| Dep
| Bin
| Lib
| Libexec
| Lib_available
| Version
| Read
| Read_strings
| Read_lines
| Path_no_dep
| Ocaml_config
end
type 'a t =
| No_info of 'a
| Since of 'a * Syntax.Version.t
| Deleted_in of 'a * Syntax.Version.t
| Renamed_in of Syntax.Version.t * string
(* Macros *)
| Exe
| Dep
| Bin
| Lib
| Libexec
| Lib_available
| Version
| Read
| Read_strings
| Read_lines
| Path_no_dep
| Ocaml_config
module Map : sig
type 'a var
type 'a t
type pform
type t
val create_vars : context:Context.t -> cxx_flags:string list -> Var.t t
val create : context:Context.t -> cxx_flags:string list -> t
val macros : Macro.t t
val superpose : t -> t -> t
val static_vars : Var.t t
(** Map with all named values as [Named_local] *)
val of_bindings : _ Jbuild.Bindings.t -> t
val singleton : string -> pform -> t
val of_list_exn : (string * pform) list -> t
val input_file : Path.t -> t
val expand
: 'a t
: t
-> syntax_version:Syntax.Version.t
-> var:String_with_vars.Var.t
-> 'a option
end with type 'a var := 'a t
-> pform:String_with_vars.Var.t
-> pform option
val empty : t
end with type pform := t

22
src/preprocessing.ml
View File

@ -454,14 +454,16 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind =
let action = Action.Unexpanded.Chdir (root_var, action) in
Module.iter source ~f:(fun _ (src : Module.File.t) ->
let src_path = Path.relative dir src.name in
let bindings = Pform.Map.input_file src_path in
add_alias src.name
(Build.path src_path
>>^ (fun _ -> [src_path])
>>^ (fun _ -> Jbuild.Bindings.empty)
>>> SC.Action.run sctx
action
~loc
~dir
~dep_kind
~bindings
~targets:(Static [])
~scope)))
| Pps { loc; pps; flags } ->
@ -476,14 +478,15 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind =
get_ppx_driver sctx ~loc ~scope ~dir_kind pps
>>| fun (exe, driver) ->
(exe,
let extra_vars =
String_map.singleton "corrected-suffix" [Value.String corrected_suffix]
let bindings =
Pform.Map.singleton "corrected-suffix"
(Values [String corrected_suffix])
in
Build.memoize "ppx flags"
(SC.expand_and_eval_set sctx driver.info.lint_flags
~scope
~dir
~extra_vars
~bindings
~standard:(Build.return [])))
in
(fun ~source ~ast ->
@ -527,11 +530,12 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess
(fun m ~lint ->
let ast =
pped_module m ~dir ~f:(fun _kind src dst ->
let bindings = Pform.Map.input_file src in
SC.add_rule sctx
(preprocessor_deps
>>>
Build.path src
>>^ (fun _ -> [src])
>>^ (fun _ -> Jbuild.Bindings.empty)
>>>
SC.Action.run sctx
(Redirect
@ -542,6 +546,7 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess
~loc
~dir
~dep_kind
~bindings
~targets:(Static [dst])
~scope))
|> setup_reason_rules sctx ~dir in
@ -558,14 +563,15 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess
let open Result.O in
get_ppx_driver sctx ~loc ~scope ~dir_kind pps >>| fun (exe, driver) ->
(exe,
let extra_vars =
String_map.singleton "corrected-suffix" [Value.String corrected_suffix]
let bindings =
Pform.Map.singleton "corrected-suffix"
(Values [String corrected_suffix])
in
Build.memoize "ppx flags"
(SC.expand_and_eval_set sctx driver.info.flags
~scope
~dir
~extra_vars
~bindings
~standard:(Build.return [])))
in
(fun m ~lint ->

16
src/string_with_vars.ml
View File

@ -211,6 +211,8 @@ module Var = struct
| Var s -> s
| Macro (k, v) -> k ^ ":" ^ v
let payload t = t.payload
let to_string = string_of_var
let pp fmt t = Format.pp_print_string fmt (to_string t)
@ -224,6 +226,12 @@ module Var = struct
{ t with name }
let is_macro t = Option.is_some t.payload
let describe t =
to_string
(match t.payload with
| None -> t
| Some _ -> { t with payload = Some ".." })
end
let partial_expand
@ -277,10 +285,10 @@ let expand t ~mode ~dir ~f =
| None ->
begin match var.syntax with
| Percent ->
begin match Var.destruct var with
| Var v -> Loc.fail var.loc "unknown variable %S" v
| Macro _ -> Loc.fail var.loc "unknown form %s" (string_of_var var)
end
if Var.is_macro var then
Loc.fail var.loc "Unknown macro %s" (Var.describe var)
else
Loc.fail var.loc "Unknown variable %S" (Var.name var)
| Dollar_brace
| Dollar_paren -> Some [Value.String (string_of_var var)]
end

6
src/string_with_vars.mli
View File

@ -56,6 +56,7 @@ module Var : sig
val name : t -> string
val loc : t -> Loc.t
val full_name : t -> string
val payload : t -> string option
type kind =
| Var of string
@ -63,13 +64,14 @@ module Var : sig
val destruct : t -> kind
val to_string : t -> string
val with_name : t -> name:string -> t
val with_payload : t -> payload:string option -> t
val is_macro : t -> bool
(** Describe what this variable is *)
val describe : t -> string
end
val expand

371
src/super_context.ml
View File

@ -45,8 +45,7 @@ type t =
; artifacts : Artifacts.t
; stanzas_to_consider_for_install : Installable.t list
; cxx_flags : string list
; vars : Pform.Var.t Pform.Map.t
; macros : Pform.Macro.t Pform.Map.t
; pforms : Pform.Map.t
; ocaml_config : Value.t list String.Map.t
; chdir : (Action.t, Action.t) Build.t
; host : t option
@ -86,64 +85,43 @@ let installed_libs t = t.installed_libs
let find_scope_by_dir t dir = Scope.DB.find_by_dir t.scopes dir
let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name
let expand_vars t ~syntax_version ~var =
if String_with_vars.Var.is_macro var then
Loc.fail (String_with_vars.Var.loc var)
"macros of the form %%{name:..} cannot be expanded here"
else
Pform.Map.expand t.vars ~syntax_version ~var
let expand_macro t ~syntax_version ~var =
if String_with_vars.Var.is_macro var then
Pform.Map.expand t.macros ~syntax_version ~var
else
Exn.code_error "expand_macro can't expand variables"
[ "var", String_with_vars.Var.sexp_of_t var ]
let expand t ~syntax_version ~var =
match
match String_with_vars.Var.destruct var with
| Var _ -> Left (expand_vars t ~syntax_version ~var)
| Macro (_, _) -> Right (expand_macro t ~syntax_version ~var)
with
| Right None
| Left None -> None
| Right (Some x) -> Some (Right x)
| Left (Some x) -> Some (Left x)
let expand_ocaml_config t pform =
let name = Option.value_exn (String_with_vars.Var.payload pform) in
match String.Map.find t.ocaml_config name with
| Some x -> x
| None ->
Loc.fail (String_with_vars.Var.loc pform)
"Unknown ocaml configuration variable %S"
name
let (expand_vars_string, expand_vars_path) =
let expand t ~scope ~dir ?(extra_vars=String.Map.empty) s =
String_with_vars.expand ~mode:Single ~dir s ~f:(fun var syntax_version ->
match expand t ~syntax_version ~var with
| None ->
String.Map.find extra_vars (String_with_vars.Var.full_name var)
| Some (Left v) ->
begin match Pform.Var.to_value_no_deps_or_targets ~scope v with
| Some _ as v -> v
| None ->
Loc.fail (String_with_vars.Var.loc var)
"Variable %a is not allowed in this context"
String_with_vars.Var.pp var
end
| Some (Right Ocaml_config) ->
String.Map.find t.ocaml_config (String_with_vars.Var.name var)
| Some (Right _) ->
Loc.fail (String_with_vars.Var.loc var)
"This percent form isn't allowed in this position")
let expand t ~scope ~dir ?(bindings=Pform.Map.empty) s =
String_with_vars.expand ~mode:Single ~dir s ~f:(fun pform syntax_version ->
(match Pform.Map.expand bindings ~syntax_version ~pform with
| None -> Pform.Map.expand t.pforms ~syntax_version ~pform
| Some _ as x -> x)
|> Option.map ~f:(function
| Pform.Values l -> l
| Ocaml_config -> expand_ocaml_config t pform
| Project_root -> [Value.Dir (Scope.root scope)]
| _ ->
Loc.fail (String_with_vars.Var.loc pform)
"%s isn't allowed in this position"
(String_with_vars.Var.describe pform)))
in
let expand_vars t ~scope ~dir ?extra_vars s =
expand t ~scope ~dir ?extra_vars s
let expand_vars t ~scope ~dir ?bindings s =
expand t ~scope ~dir ?bindings s
|> Value.to_string ~dir
in
let expand_vars_path t ~scope ~dir ?extra_vars s =
expand t ~scope ~dir ?extra_vars s
let expand_vars_path t ~scope ~dir ?bindings s =
expand t ~scope ~dir ?bindings s
|> Value.to_path ~error_loc:(String_with_vars.loc s) ~dir
in
(expand_vars, expand_vars_path)
let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard =
let expand_and_eval_set t ~scope ~dir ?bindings set ~standard =
let open Build.O in
let f = expand_vars_string t ~scope ~dir ?extra_vars in
let f = expand_vars_string t ~scope ~dir ?bindings in
let parse ~loc:_ s = s in
let (syntax, files) = Ordered_set_lang.Unexpanded.files set ~f in
match String.Set.to_list files with
@ -208,7 +186,7 @@ module Env = struct
~ocamlopt_flags:cfg.ocamlopt_flags
~default
~eval:(expand_and_eval_set t ~scope:node.scope ~dir:node.dir
?extra_vars:None)
?bindings:None)
in
node.ocaml_flags <- Some flags;
flags
@ -223,7 +201,7 @@ let ocaml_flags t ~dir ~scope (x : Buildable.t) =
~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)
~eval:(expand_and_eval_set t ~scope ~dir ?bindings:None)
let dump_env t ~dir =
Ocaml_flags.dump (Env.ocaml_flags t ~dir)
@ -306,7 +284,7 @@ let create
List.filter context.ocamlc_cflags
~f:(fun s -> not (String.is_prefix s ~prefix:"-std="))
in
let vars = Pform.Map.create_vars ~context ~cxx_flags in
let pforms = Pform.Map.create ~context ~cxx_flags in
let ocaml_config =
let string s = [Value.String s] in
Ocaml_config.to_list context.ocaml_config
@ -333,8 +311,7 @@ let create
; stanzas_to_consider_for_install
; artifacts
; cxx_flags
; vars
; macros = Pform.Map.macros
; pforms
; ocaml_config
; chdir = Build.arr (fun (action : Action.t) ->
match action with
@ -523,8 +500,23 @@ module Deps = struct
>>^ fun () -> []
let interpret t ~scope ~dir l =
Build.all (List.map l ~f:(dep t ~scope ~dir))
List.map l ~f:(dep t ~scope ~dir)
|> Build.all
>>^ List.concat
let interpret_named t ~scope ~dir bindings =
let unnamed x = Jbuild.Bindings.Unnamed x in
List.map bindings ~f:(function
| Jbuild.Bindings.Unnamed p ->
dep t ~scope ~dir p >>^ unnamed
| Named (s, ps) ->
List.map ~f:(dep t ~scope ~dir) ps
|> Build.all
>>^ (fun deps -> Jbuild.Bindings.Named (s, deps)))
|> Build.all
>>^ List.concat_map ~f:(function
| Jbuild.Bindings.Unnamed s -> List.map s ~f:unnamed
| Named (s, ps) -> [Named (s, List.concat ps)])
end
module Pkg_version = struct
@ -615,7 +607,7 @@ module Action = struct
| Some x -> x
let expand_step1 sctx ~dir ~dep_kind ~scope ~targets_written_by_user
~map_exe ~extra_vars t =
~map_exe ~bindings t =
let acc =
{ failures = []
; lib_deps = String.Map.empty
@ -623,127 +615,117 @@ module Action = struct
; ddeps = String.Map.empty
}
in
let expand_form s var syntax_version =
let loc = String_with_vars.Var.loc var in
let key = String_with_vars.Var.full_name var in
begin match expand_macro sctx ~syntax_version ~var with
| Some Pform.Macro.Exe -> Some (path_exp (map_exe (Path.relative dir s)))
| Some Ocaml_config -> String.Map.find sctx.ocaml_config s
| Some Dep -> Some (path_exp (Path.relative dir s))
| Some Bin -> begin
let sctx = host sctx in
match Artifacts.binary (artifacts sctx) s with
| Ok path -> Some (path_exp path)
| Error e ->
add_fail acc ({ fail = fun () -> Action.Prog.Not_found.raise e })
end
| Some Lib -> begin
let lib_dep, file = parse_lib_file ~loc s in
add_lib_dep acc lib_dep dep_kind;
match
Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file
with
| Ok path -> Some (path_exp path)
| Error fail -> add_fail acc fail
end
| Some Libexec -> begin
let sctx = host sctx in
let lib_dep, file = parse_lib_file ~loc s in
add_lib_dep acc lib_dep dep_kind;
match
Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file
with
| Error fail -> add_fail acc fail
| Ok path ->
if not Sys.win32 || Filename.extension s = ".exe" then begin
Some (path_exp path)
end else begin
let path_exe = Path.extend_basename path ~suffix:".exe" in
let dep =
Build.if_file_exists path_exe
~then_:(Build.path path_exe >>^ fun _ -> path_exp path_exe)
~else_:(Build.path path >>^ fun _ -> path_exp path)
in
add_ddep acc ~key dep
end
end
| Some Lib_available -> begin
let lib = s in
add_lib_dep acc lib Optional;
Some (str_exp (string_of_bool (
Lib.DB.available (Scope.libs scope) lib)))
end
| Some Version -> begin
match Package.Name.Map.find (Scope.project scope).packages
(Package.Name.of_string s) with
| Some p ->
let x =
Pkg_version.read sctx p >>^ function
| None -> [Value.String ""]
| Some s -> [String s]
in
add_ddep acc ~key x
| None ->
add_fail acc { fail = fun () ->
Loc.fail loc "Package %S doesn't exist in the current project." s
}
end
| Some Read -> begin
let path = Path.relative dir s in
let data =
Build.contents path
>>^ fun s -> [Value.String s]
in
add_ddep acc ~key data
end
| Some Read_lines -> begin
let path = Path.relative dir s in
let data =
Build.lines_of path
>>^ Value.L.strings
in
add_ddep acc ~key data
end
| Some Read_strings -> begin
let path = Path.relative dir s in
let data =
Build.strings path
>>^ Value.L.strings
in
add_ddep acc ~key data
end
| Some Path_no_dep -> Some [Value.Dir (Path.relative dir s)]
| None ->
Loc.fail (String_with_vars.Var.loc var) "Unknown form: %a"
String_with_vars.Var.pp var
end
in
let expand var syntax_version =
let loc = String_with_vars.Var.loc var in
let key = String_with_vars.Var.full_name var in
let expand pform syntax_version =
let loc = String_with_vars.Var.loc pform in
let key = String_with_vars.Var.full_name pform in
let s = Option.value (String_with_vars.Var.payload pform) ~default:"" in
let res =
match String_with_vars.Var.destruct var with
| Macro (_, s) -> expand_form s var syntax_version
| Var var_name ->
begin match expand_vars sctx ~syntax_version ~var with
| None -> String.Map.find extra_vars key
| Some Targets ->
let var () =
match var_name with
| "@" -> sprintf "${%s}" var_name
| "targets" -> sprintf "%%{%s}" var_name
| _ -> assert false
in
Pform.Map.expand bindings ~syntax_version ~pform
|> Option.bind ~f:(function
| Pform.Values l -> Some l
| Ocaml_config -> Some (expand_ocaml_config sctx pform)
| Project_root -> Some [Value.Dir (Scope.root scope)]
| First_dep | Deps | Named_local -> None
| Targets ->
begin match targets_written_by_user with
| Infer ->
Loc.fail loc "You cannot use %s with inferred rules." (var ())
Loc.fail loc "You cannot use %s with inferred rules."
(String_with_vars.Var.describe pform)
| Alias ->
Loc.fail loc "You cannot use %s in aliases." (var ())
Loc.fail loc "You cannot use %s in aliases."
(String_with_vars.Var.describe pform)
| Static l ->
Some (Value.L.dirs l) (* XXX hack to signal no dep *)
end
| Some v -> Pform.Var.to_value_no_deps_or_targets v ~scope
end
| Exe -> Some (path_exp (map_exe (Path.relative dir s)))
| Dep -> Some (path_exp (Path.relative dir s))
| Bin -> begin
let sctx = host sctx in
match Artifacts.binary (artifacts sctx) s with
| Ok path -> Some (path_exp path)
| Error e ->
add_fail acc
({ fail = fun () -> Action.Prog.Not_found.raise e })
end
| Lib -> begin
let lib_dep, file = parse_lib_file ~loc s in
add_lib_dep acc lib_dep dep_kind;
match
Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file
with
| Ok path -> Some (path_exp path)
| Error fail -> add_fail acc fail
end
| Libexec -> begin
let sctx = host sctx in
let lib_dep, file = parse_lib_file ~loc s in
add_lib_dep acc lib_dep dep_kind;
match
Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file
with
| Error fail -> add_fail acc fail
| Ok path ->
if not Sys.win32 || Filename.extension s = ".exe" then begin
Some (path_exp path)
end else begin
let path_exe = Path.extend_basename path ~suffix:".exe" in
let dep =
Build.if_file_exists path_exe
~then_:(Build.path path_exe >>^ fun _ ->
path_exp path_exe)
~else_:(Build.path path >>^ fun _ ->
path_exp path)
in
add_ddep acc ~key dep
end
end
| Lib_available -> begin
let lib = s in
add_lib_dep acc lib Optional;
Some (str_exp (string_of_bool (
Lib.DB.available (Scope.libs scope) lib)))
end
| Version -> begin
match Package.Name.Map.find (Scope.project scope).packages
(Package.Name.of_string s) with
| Some p ->
let x =
Pkg_version.read sctx p >>^ function
| None -> [Value.String ""]
| Some s -> [String s]
in
add_ddep acc ~key x
| None ->
add_fail acc { fail = fun () ->
Loc.fail loc
"Package %S doesn't exist in the current project." s
}
end
| Read -> begin
let path = Path.relative dir s in
let data =
Build.contents path
>>^ fun s -> [Value.String s]
in
add_ddep acc ~key data
end
| Read_lines -> begin
let path = Path.relative dir s in
let data =
Build.lines_of path
>>^ Value.L.strings
in
add_ddep acc ~key data
end
| Read_strings -> begin
let path = Path.relative dir s in
let data =
Build.strings path
>>^ Value.L.strings
in
add_ddep acc ~key data
end
| Path_no_dep -> Some [Value.Dir (Path.relative dir s)])
in
Option.iter res ~f:(fun v ->
acc.sdeps <- Path.Set.union
@ -754,31 +736,51 @@ module Action = struct
let t = U.partial_expand t ~dir ~map_exe ~f:expand in
(t, acc)
let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t =
U.Partial.expand t ~dir ~map_exe ~f:(fun var syntax_version ->
let key = String_with_vars.Var.full_name var in
let loc = String_with_vars.Var.loc var in
let expand_step2 ~dir ~dynamic_expansions ~bindings
~(deps_written_by_user : Path.t Jbuild.Bindings.t)
~map_exe t =
U.Partial.expand t ~dir ~map_exe ~f:(fun pform syntax_version ->
let key = String_with_vars.Var.full_name pform in
let loc = String_with_vars.Var.loc pform in
match String.Map.find dynamic_expansions key with
| Some _ as opt -> opt
| None ->
Pform.Map.expand Pform.Map.static_vars ~syntax_version ~var
|> Option.map ~f:(function
| Pform.Var.Deps -> (Value.L.paths deps_written_by_user)
Option.map (Pform.Map.expand bindings ~syntax_version ~pform) ~f:(function
| Named_local ->
begin match Jbuild.Bindings.find deps_written_by_user key with
| None ->
Exn.code_error "Local named variable not present in named deps"
[ "pform", String_with_vars.Var.sexp_of_t pform
; "deps_written_by_user",
Jbuild.Bindings.sexp_of_t Path.sexp_of_t deps_written_by_user
]
| Some x -> Value.L.paths x
end
| Deps ->
deps_written_by_user
|> Jbuild.Bindings.to_list
|> Value.L.paths
| First_dep ->
begin match deps_written_by_user with
| Named _ :: _ ->
(* This case is not possible: ${<} only exist in jbuild
files and named dependencies are not available in
jbuild files *)
assert false
| Unnamed v :: _ -> [Path v]
| [] ->
Loc.warn loc "Variable '%s' used with no explicit \
dependencies@." key;
[Value.String ""]
| v :: _ -> [Path v]
end
| _ ->
Exn.code_error "Unexpected variable in step2"
["var", String_with_vars.Var.sexp_of_t var]))
["var", String_with_vars.Var.sexp_of_t pform]))
let run sctx ~loc ?(extra_vars=String.Map.empty)
t ~dir ~dep_kind ~targets:targets_written_by_user ~scope
: (Path.t list, Action.t) Build.t =
let run sctx ~loc ~bindings t ~dir ~dep_kind
~targets:targets_written_by_user ~scope
: (Path.t Bindings.t, Action.t) Build.t =
let bindings = Pform.Map.superpose sctx.pforms bindings in
let map_exe = map_exe sctx in
if targets_written_by_user = Alias then begin
match Action.Infer.unexpanded_targets t with
@ -791,7 +793,7 @@ module Action = struct
end;
let t, forms =
expand_step1 sctx t ~dir ~dep_kind ~scope
~targets_written_by_user ~map_exe ~extra_vars
~targets_written_by_user ~map_exe ~bindings
in
let { Action.Infer.Outcome. deps; targets } =
match targets_written_by_user with
@ -850,6 +852,7 @@ module Action = struct
in
let unresolved =
expand_step2 t ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe
~bindings
in
Action.Unresolved.resolve unresolved ~f:(fun prog ->
let sctx = host sctx in

17
src/super_context.mli
View File

@ -82,7 +82,7 @@ val expand_vars_string
: t
-> scope:Scope.t
-> dir:Path.t
-> ?extra_vars:Value.t list String.Map.t
-> ?bindings:Pform.Map.t
-> String_with_vars.t
-> string
@ -90,7 +90,7 @@ val expand_vars_path
: t
-> scope:Scope.t
-> dir:Path.t
-> ?extra_vars:Value.t list String.Map.t
-> ?bindings:Pform.Map.t
-> String_with_vars.t
-> Path.t
@ -98,7 +98,7 @@ val expand_and_eval_set
: t
-> scope:Scope.t
-> dir:Path.t
-> ?extra_vars:Value.t list String.Map.t
-> ?bindings:Pform.Map.t
-> Ordered_set_lang.Unexpanded.t
-> standard:(unit, string list) Build.t
-> (unit, string list) Build.t
@ -219,6 +219,13 @@ module Deps : sig
-> dir:Path.t
-> Dep_conf.t list
-> (unit, Path.t list) Build.t
val interpret_named
: t
-> scope:Scope.t
-> dir:Path.t
-> Dep_conf.t Bindings.t
-> (unit, Path.t Bindings.t) Build.t
end
(** Interpret action written in jbuild files *)
@ -232,13 +239,13 @@ module Action : sig
val run
: t
-> loc:Loc.t
-> ?extra_vars:Value.t list String.Map.t
-> bindings:Pform.Map.t
-> Action.Unexpanded.t
-> dir:Path.t
-> dep_kind:Build.lib_dep_kind
-> targets:targets
-> scope:Scope.t
-> (Path.t list, Action.t) Build.t
-> (Path.t Bindings.t, Action.t) Build.t
end
module Pkg_version : sig

7
src/syntax.ml
View File

@ -65,9 +65,12 @@ module Error = struct
Loc.fail loc "%s was renamed to '%s' in the %s version of %s"
what to_ (Version.to_string ver) t.desc
let deleted_in loc t ver ~what =
Loc.fail loc "%s was deleted in version %s of %s"
let deleted_in loc t ?repl ver ~what =
Loc.fail loc "%s was deleted in version %s of %s%s"
what (Version.to_string ver) t.desc
(match repl with
| None -> ""
| Some s -> ".\n" ^ s)
end

8
src/syntax.mli
View File

@ -25,7 +25,13 @@ module Error : sig
val renamed_in : Loc.t -> t -> Version.t -> what:string -> to_:string -> _
val deleted_in : Loc.t -> t -> Version.t -> what:string -> _
val deleted_in
: Loc.t
-> t
-> ?repl:string
-> Version.t
-> what:string
-> _
end
(** [create ~name ~desc supported_versions] defines a new

30
test/blackbox-tests/dune.inc
View File

@ -80,6 +80,14 @@
test-cases/custom-build-dir
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
(alias
(name dep-vars)
(deps (package dune) (source_tree test-cases/dep-vars))
(action
(chdir
test-cases/dep-vars
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
(alias
(name depend-on-the-universe)
(deps (package dune) (source_tree test-cases/depend-on-the-universe))
@ -531,6 +539,14 @@
(run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t)
(diff? run.t run.t.corrected)))))
(alias
(name preprocess-with-action)
(deps (package dune) (source_tree test-cases/preprocess-with-action))
(action
(chdir
test-cases/preprocess-with-action
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
(alias
(name private-public-overlap)
(deps (package dune) (source_tree test-cases/private-public-overlap))
@ -603,6 +619,14 @@
test-cases/select
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
(alias
(name shadow-bindings)
(deps (package dune) (source_tree test-cases/shadow-bindings))
(action
(chdir
test-cases/shadow-bindings
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
(alias
(name subst)
(deps (package dune) (source_tree test-cases/subst))
@ -680,6 +704,7 @@
(alias copy_files)
(alias cross-compilation)
(alias custom-build-dir)
(alias dep-vars)
(alias depend-on-the-universe)
(alias dune-jbuild-var-case)
(alias dune-ppx-driver-system)
@ -732,6 +757,7 @@
(alias package-dep)
(alias path-variables)
(alias ppx-rewriter)
(alias preprocess-with-action)
(alias private-public-overlap)
(alias project-root)
(alias promote)
@ -740,6 +766,7 @@
(alias scope-bug)
(alias scope-ppx-bug)
(alias select)
(alias shadow-bindings)
(alias subst)
(alias syntax-versioning)
(alias tests-stanza)
@ -762,6 +789,7 @@
(alias copy_files)
(alias cross-compilation)
(alias custom-build-dir)
(alias dep-vars)
(alias depend-on-the-universe)
(alias dune-jbuild-var-case)
(alias dune-ppx-driver-system)
@ -807,6 +835,7 @@
(alias output-obj)
(alias package-dep)
(alias path-variables)
(alias preprocess-with-action)
(alias project-root)
(alias promote)
(alias quoting)
@ -814,6 +843,7 @@
(alias scope-bug)
(alias scope-ppx-bug)
(alias select)
(alias shadow-bindings)
(alias subst)
(alias syntax-versioning)
(alias tests-stanza)

5
test/blackbox-tests/test-cases/dep-vars/dune Normal file
View File

@ -0,0 +1,5 @@
(rule
(deps (:foo a b) (:baz foo (alias test)) a b c)
(targets bar)
(action (with-stdout-to bar (echo "foo"))))

1
test/blackbox-tests/test-cases/dep-vars/dune-project Normal file
View File

@ -0,0 +1 @@
(lang dune 1.0)

3
test/blackbox-tests/test-cases/dep-vars/run.t Normal file
View File

@ -0,0 +1,3 @@
Dependencies are allowed :patterns
$ dune build

8
test/blackbox-tests/test-cases/force-test/dune
View File

@ -1,7 +1 @@
(executable
(name f))
(alias
(name runtest)
(deps f.exe)
(action (run %{first-dep})))
(test (name f))

6
test/blackbox-tests/test-cases/github568/dune
View File

@ -7,8 +7,7 @@
(alias
(name runtest)
(package lib1)
(deps test1.exe)
(action (run %{first-dep})))
(action (run ./test1.exe)))
(executable
(name test1)
@ -24,8 +23,7 @@
(alias
(name runtest)
(package lib2)
(deps test2.exe)
(action (run %{first-dep})))
(action (run ./test2.exe)))
(executable
(name test2)

3
test/blackbox-tests/test-cases/github660/explicit-interfaces/dune
View File

@ -1,6 +1,5 @@
(alias
(name runtest)
(deps main.exe)
(action (run %{first-dep})))
(action (run ./main.exe)))
(executable (name main))

3
test/blackbox-tests/test-cases/github660/no-interfaces/dune
View File

@ -1,6 +1,5 @@
(alias
(name runtest)
(deps main.exe)
(action (run %{first-dep})))
(action (run ./main.exe)))
(executable (name main))

2
test/blackbox-tests/test-cases/macro-expand-error/run.t
View File

@ -4,5 +4,5 @@ inappropariate place:
$ dune build
Info: creating file dune-project with this contents: (lang dune 1.0)
File "dune", line 1, characters 14-21:
Error: This percent form isn't allowed in this position
Error: %{read:..} isn't allowed in this position
[1]

6
test/blackbox-tests/test-cases/output-obj/dune
View File

@ -33,7 +33,7 @@
(rule
(targets dynamic.exe)
(deps dynamic.c)
(action (run %{cc} -o %{targets} %{first-dep} %{ocaml-config:native_c_libraries})))
(action (run %{cc} -o %{targets} %{deps} %{ocaml-config:native_c_libraries})))
(alias
(name runtest)
@ -48,9 +48,9 @@
(alias
(name runtest)
(deps test.bc%{ext_dll})
(action (run ./dynamic.exe ./%{first-dep})))
(action (run ./dynamic.exe ./%{deps})))
(alias
(name runtest)
(deps test%{ext_dll})
(action (run ./dynamic.exe ./%{first-dep})))
(action (run ./dynamic.exe ./%{deps})))

1
test/blackbox-tests/test-cases/preprocess-with-action/dune-project Normal file
View File

@ -0,0 +1 @@
(lang dune 1.0)

3
test/blackbox-tests/test-cases/preprocess-with-action/dune/dune Normal file
View File

@ -0,0 +1,3 @@
(test
(name test)
(preprocess (action (run pp/pp.exe %{input-file}))))

1
test/blackbox-tests/test-cases/preprocess-with-action/dune/test.expected Normal file
View File

@ -0,0 +1 @@
Hello, world!

1
test/blackbox-tests/test-cases/preprocess-with-action/dune/test.ml Normal file
View File

@ -0,0 +1 @@
print_endline _STRING_

10
test/blackbox-tests/test-cases/preprocess-with-action/jbuild/jbuild Normal file
View File

@ -0,0 +1,10 @@
(executable
((name test)
(preprocess (action (run pp/pp.exe ${<})))))
(rule
(with-stdout-to test.output (run ./test.exe)))
(alias
((name runtest)
(action (diff test.expected test.output))))

1
test/blackbox-tests/test-cases/preprocess-with-action/jbuild/test.expected Normal file
View File

@ -0,0 +1 @@
Hello, world!

1
test/blackbox-tests/test-cases/preprocess-with-action/jbuild/test.ml Normal file
View File

@ -0,0 +1 @@
print_endline _STRING_

4
test/blackbox-tests/test-cases/preprocess-with-action/pp/dune Normal file
View File

@ -0,0 +1,4 @@
(executable
(name pp))
(ocamllex pp)

10
test/blackbox-tests/test-cases/preprocess-with-action/pp/pp.mll Normal file
View File

@ -0,0 +1,10 @@
rule main = parse
| eof { () }
| "_STRING_" { Printf.printf "%S" "Hello, world!"; main lexbuf }
| _ as c { print_char c; main lexbuf }
{
let () =
set_binary_mode_out stdout true;
main (Lexing.from_channel (open_in_bin Sys.argv.(1)))
}

1
test/blackbox-tests/test-cases/preprocess-with-action/run.t Normal file
View File

@ -0,0 +1 @@
$ dune runtest

3
test/blackbox-tests/test-cases/select/dune
View File

@ -10,5 +10,4 @@
(alias
(name runtest)
(deps main.exe)
(action (run %{first-dep})))
(action (run ./main.exe)))

5
test/blackbox-tests/test-cases/shadow-bindings/dune Normal file
View File

@ -0,0 +1,5 @@
(alias
(name runtest)
(deps (:root foo))
(action (echo %{root})))

1
test/blackbox-tests/test-cases/shadow-bindings/dune-project Normal file
View File

@ -0,0 +1 @@
(lang dune 1.0)

0
test/blackbox-tests/test-cases/shadow-bindings/foo Normal file
View File

4
test/blackbox-tests/test-cases/shadow-bindings/run.t Normal file
View File

@ -0,0 +1,4 @@
Bindings introduced by user dependencies should shadow existing bindings
$ dune runtest
foo

11
test/blackbox-tests/test-cases/syntax-versioning/run.t
View File

@ -16,3 +16,14 @@
Error: 'link_executables' was deleted in version 1.0 of the dune language
[1]
$ rm -f dune
$ echo '(alias (name x) (deps x) (action (run %{<})))' > dune
$ dune build
File "dune", line 1, characters 40-42:
Error: %{<} was deleted in version 1.0 of the dune language.
Use a named dependency instead:
(deps (:x <dep>) ...)
... %{x} ...
[1]
$ rm -f dune

7
test/unit-tests/configurator/dune
View File

@ -1,8 +1,3 @@
(executable
(test
(name test_configurator)
(libraries configurator))
(alias
(name runtest)
(deps ./test_configurator.exe)
(action (run %{first-dep})))

42
test/unit-tests/dune
View File

@ -18,72 +18,72 @@
(alias
(name runtest)
(deps tests.mlt
(deps (:t tests.mlt)
(glob_files %{project_root}/src/.dune.objs/*.cmi)
(glob_files %{project_root}/src/stdune/.stdune.objs/*.cmi)
(source_tree toolchain.d)
(source_tree findlib-db))
(action (chdir %{project_root}
(progn
(run %{exe:expect_test.exe} %{first-dep})
(diff? %{first-dep} %{first-dep}.corrected)))))
(run %{exe:expect_test.exe} %{t})
(diff? %{t} %{t}.corrected)))))
(alias
(name runtest)
(deps filename.mlt
(deps (:t filename.mlt)
(glob_files %{project_root}/src/.dune.objs/*.cmi)
(glob_files %{project_root}/src/stdune/.stdune.objs/*.cmi))
(action (chdir %{project_root}
(progn
(run %{exe:expect_test.exe} %{first-dep})
(diff? %{first-dep} %{first-dep}.corrected)))))
(run %{exe:expect_test.exe} %{t})
(diff? %{t} %{t}.corrected)))))
(alias
(name runtest)
(deps import_dot_map.mlt
(deps (:t import_dot_map.mlt)
(glob_files %{project_root}/src/.dune.objs/*.cmi)
(glob_files %{project_root}/src/stdune/.stdune.objs/*.cmi))
(action (chdir %{project_root}
(progn
(run %{exe:expect_test.exe} %{first-dep})
(diff? %{first-dep} %{first-dep}.corrected)))))
(run %{exe:expect_test.exe} %{t})
(diff? %{t} %{t}.corrected)))))
(alias
(name runtest)
(deps action.mlt
(deps (:t action.mlt)
(glob_files %{project_root}/src/.dune.objs/*.cmi)
(glob_files %{project_root}/src/stdune/.stdune.objs/*.cmi))
(action (chdir %{project_root}
(progn
(run %{exe:expect_test.exe} %{first-dep})
(diff? %{first-dep} %{first-dep}.corrected)))))
(run %{exe:expect_test.exe} %{t})
(diff? %{t} %{t}.corrected)))))
(alias
(name runtest)
(deps path.mlt
(deps (:t path.mlt)
(glob_files %{project_root}/src/.dune.objs/*.cmi)
(glob_files %{project_root}/src/stdune/.stdune.objs/*.cmi))
(action (chdir %{project_root}
(progn
(run %{exe:expect_test.exe} %{first-dep})
(diff? %{first-dep} %{first-dep}.corrected)))))
(run %{exe:expect_test.exe} %{t})
(diff? %{t} %{t}.corrected)))))
(alias
(name runtest)
(deps sexp.mlt
(deps (:t sexp.mlt)
(glob_files %{project_root}/src/.dune.objs/*.cmi)
(glob_files %{project_root}/src/stdune/.stdune.objs/*.cmi))
(action (chdir %{project_root}
(progn
(run %{exe:expect_test.exe} %{first-dep})
(diff? %{first-dep} %{first-dep}.corrected)))))
(run %{exe:expect_test.exe} %{t})
(diff? %{t} %{t}.corrected)))))
(alias
(name runtest)
(deps jbuild.mlt
(deps (:t jbuild.mlt)
(glob_files %{project_root}/src/.dune.objs/*.cmi)
(glob_files %{project_root}/src/stdune/.stdune.objs/*.cmi))
(action (chdir %{project_root}
(progn
(run %{exe:expect_test.exe} %{first-dep})
(diff? %{first-dep} %{first-dep}.corrected)))))
(run %{exe:expect_test.exe} %{t})
(diff? %{t} %{t}.corrected)))))

7
test/unit-tests/ocaml-config/dune
View File

@ -1,8 +1,3 @@
(executable
(test
(name gh637)
(libraries ocaml_config))
(alias
(name runtest)
(deps ./gh637.exe)
(action (run %{first-dep})))