From 93b0c618d10957a72ca9dd38b76e1b7b6f0aa9aa Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 4 Jul 2018 10:17:36 +0700 Subject: [PATCH] Add syntax for binding dependencies to names Signed-off-by: Rudi Grinberg --- src/jbuild.ml | 90 ++++++++++++------- src/jbuild.mli | 7 +- src/super_context.ml | 10 +-- test/blackbox-tests/dune.inc | 10 +++ test/blackbox-tests/test-cases/dep-vars/dune | 5 ++ .../test-cases/dep-vars/dune-project | 1 + test/blackbox-tests/test-cases/dep-vars/run.t | 3 + 7 files changed, 86 insertions(+), 40 deletions(-) create mode 100644 test/blackbox-tests/test-cases/dep-vars/dune create mode 100644 test/blackbox-tests/test-cases/dep-vars/dune-project create mode 100644 test/blackbox-tests/test-cases/dep-vars/run.t diff --git a/src/jbuild.ml b/src/jbuild.ml index 2e03e39a..a4ca5b48 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -233,7 +233,7 @@ module Pps_and_flags = struct end module Dep_conf = struct - type t = + type dep = | File of String_with_vars.t | Alias of String_with_vars.t | Alias_rec of String_with_vars.t @@ -241,38 +241,59 @@ module Dep_conf = struct | Source_tree of String_with_vars.t | Package of String_with_vars.t | Universe - | List of t list - let t = - let t = - let sw = String_with_vars.t in - fix (fun t -> - sum - [ "file" , (sw >>| fun x -> File x) - ; "alias" , (sw >>| fun x -> Alias x) - ; "alias_rec" , (sw >>| fun x -> Alias_rec x) - ; "glob_files" , (sw >>| fun x -> Glob_files x) - ; "package" , (sw >>| fun x -> Package x) - ; "universe" , return Universe - ; "files_recursively_in", - (Syntax.renamed_in Stanza.syntax (1, 0) ~to_:"source_tree" - >>= fun () -> - sw >>| fun x -> Source_tree x) - ; "source_tree", - (Syntax.since Stanza.syntax (1, 0) >>= fun () -> - sw >>| fun x -> Source_tree x) - ; "list", - (Syntax.since Stanza.syntax (1, 0) >>= fun () -> - (repeat t) >>| fun x -> List x) - ]) - in + type t = + | Unnamed of dep list + | Named of string * dep list + + let dep_cons = + let sw = String_with_vars.t in + [ "file" , (sw >>| fun x -> File x) + ; "alias" , (sw >>| fun x -> Alias x) + ; "alias_rec" , (sw >>| fun x -> Alias_rec x) + ; "glob_files" , (sw >>| fun x -> Glob_files x) + ; "package" , (sw >>| fun x -> Package x) + ; "universe" , return Universe + ; "files_recursively_in", + (Syntax.renamed_in Stanza.syntax (1, 0) ~to_:"source_tree" + >>= fun () -> + sw >>| fun x -> Source_tree x) + ; "source_tree", + (Syntax.since Stanza.syntax (1, 0) >>= fun () -> + sw >>| fun x -> Source_tree x) + ] + + let make_dep_parser ~single ~many = peek_exn >>= function | Template _ | Atom _ | Quoted_string _ -> - String_with_vars.t >>| fun x -> File x - | List _ -> t + String_with_vars.t >>| fun x -> single (File x) + | List _ -> many + + let dep = + let dep = + let dep_no_list = + make_dep_parser ~single:(fun x -> x) ~many:(sum dep_cons) in + sum (("list", repeat dep_no_list) + :: (List.map dep_cons ~f:(fun (n, d) -> (n, d >>| List.singleton)))) + in + make_dep_parser ~single:List.singleton ~many:dep + + let t = + peek_exn >>= function + | Atom (loc, A s) when String.length s > 1 && s.[0] = ':' -> + begin + string >>= fun name -> + peek >>= function + | None -> of_sexp_errorf loc "Naked binding %s" s + | Some _ -> dep + >>| fun deps -> + Named (name, deps) + end + | _ -> + dep >>| fun dep -> Unnamed dep open Sexp - let rec sexp_of_t = function + let sexp_of_dep = function | File t -> List [Sexp.unsafe_atom_of_string "file" ; String_with_vars.sexp_of_t t] | Alias t -> @@ -291,9 +312,12 @@ module Dep_conf = struct String_with_vars.sexp_of_t t] | Universe -> Sexp.unsafe_atom_of_string "universe" - | List ts -> - List (Sexp.unsafe_atom_of_string "list" - :: (List.map ~f:sexp_of_t ts)) + + let sexp_of_t = + let open Sexp.To_sexp in + function + | Unnamed dep -> (list sexp_of_dep) dep + | Named (name, dep) -> List [Sexp.atom name; (list sexp_of_dep) dep] end module Preprocess = struct @@ -1239,7 +1263,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 = [Unnamed [File (S.virt_text __POS__ src)]] ; action = (loc, Chdir @@ -1260,7 +1284,7 @@ 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 = [Unnamed [File (S.virt_text __POS__ src)]] ; action = (loc, Chdir diff --git a/src/jbuild.mli b/src/jbuild.mli index 55c39671..b6ab651c 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -82,7 +82,7 @@ module Lib_deps : sig end module Dep_conf : sig - type t = + type dep = | File of String_with_vars.t | Alias of String_with_vars.t | Alias_rec of String_with_vars.t @@ -90,7 +90,10 @@ module Dep_conf : sig | Source_tree of String_with_vars.t | Package of String_with_vars.t | Universe - | List of t list + + type t = + | Unnamed of dep list + | Named of string * dep list val t : t Sexp.Of_sexp.t val sexp_of_t : t -> Sexp.t diff --git a/src/super_context.ml b/src/super_context.ml index 9252a051..040f7fe4 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -487,7 +487,7 @@ module Deps = struct let loc = String_with_vars.loc s in Alias.of_user_written_path ~loc ((expand_vars_path t ~scope ~dir s)) - let rec dep t ~scope ~dir = function + let dep t ~scope ~dir = function | File s -> let path = expand_vars_path t ~scope ~dir s in Build.path path @@ -521,12 +521,12 @@ module Deps = struct | Universe -> Build.path Build_system.universe_file >>^ fun () -> [] - | List ts -> - Build.all (List.map ~f:(dep t ~scope ~dir) ts) - >>^ List.concat let interpret t ~scope ~dir l = - Build.all (List.map l ~f:(dep t ~scope ~dir)) + List.concat_map l ~f:(function + | Unnamed d + | Named (_, d) -> List.map ~f:(dep t ~scope ~dir) d) + |> Build.all >>^ List.concat end diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 555a7d2f..72e2921f 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -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)) @@ -680,6 +688,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) @@ -762,6 +771,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) diff --git a/test/blackbox-tests/test-cases/dep-vars/dune b/test/blackbox-tests/test-cases/dep-vars/dune new file mode 100644 index 00000000..cd26888c --- /dev/null +++ b/test/blackbox-tests/test-cases/dep-vars/dune @@ -0,0 +1,5 @@ + +(rule + (deps :foo (list a b) :baz foo (list (alias test)) (list a b c)) + (targets bar) + (action (with-stdout-to bar (echo "foo")))) diff --git a/test/blackbox-tests/test-cases/dep-vars/dune-project b/test/blackbox-tests/test-cases/dep-vars/dune-project new file mode 100644 index 00000000..b2559fa0 --- /dev/null +++ b/test/blackbox-tests/test-cases/dep-vars/dune-project @@ -0,0 +1 @@ +(lang dune 1.0) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/dep-vars/run.t b/test/blackbox-tests/test-cases/dep-vars/run.t new file mode 100644 index 00000000..0d2bd1b0 --- /dev/null +++ b/test/blackbox-tests/test-cases/dep-vars/run.t @@ -0,0 +1,3 @@ +Dependencies are allowed :patterns + + $ dune build