diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 76e407a6..16296a12 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -214,7 +214,7 @@ include Sub_system.Register_end_point( ~init:extra_vars ~f:(fun acc (k, v) -> String.Map.add acc k v) in - Build.return [] + Build.return Named.empty >>> Build.all (List.filter_map backends ~f:(fun (backend : Backend.t) -> diff --git a/src/jbuild.ml b/src/jbuild.ml index a56044ed..1f250a06 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -234,15 +234,31 @@ end module Named = struct type 'a t = - { named: (Loc.t * 'a list) String.Map.t + { named: 'a list String.Map.t ; unnamed : 'a list } + let fold { named; unnamed } ~f ~init = + let flipped x acc = f acc x in + String.Map.fold named + ~f:(fun x init -> List.fold_left ~f:flipped ~init x) + ~init:(List.fold_left ~f:flipped ~init unnamed) + + let first { named; unnamed } = + if String.Map.is_empty named then + match unnamed with + | [] -> Result.Error `Empty + | x :: _ -> Ok x + else + Result.Error `Named_exists + let empty = { named = String.Map.empty ; unnamed = [] } + let singleton x = { empty with unnamed = [x] } + let t elem = let binding = peek_exn >>= function @@ -262,17 +278,18 @@ module Named = struct let (named, unnamed) = List.partition_map bindings ~f:(fun x -> x) in { unnamed = List.flatten unnamed ; named = - match String.Map.of_list named with - | Ok x -> x - | Error (name, (l1, _), (l2, _)) -> - of_sexp_errorf l1 "Variable %s is already defined in %s" - name (Loc.to_file_colon_line l2) + (match String.Map.of_list named with + | Ok x -> x + | Error (name, (l1, _), (l2, _)) -> + of_sexp_errorf l1 "Variable %s is already defined in %s" + name (Loc.to_file_colon_line l2)) + |> String.Map.map ~f:snd }) let sexp_of_t sexp_of_a { unnamed; named } = let unnamed = List.map ~f:sexp_of_a unnamed in let named = - String.Map.foldi ~init:[] named ~f:(fun n (_, d) acc -> + String.Map.foldi ~init:[] named ~f:(fun n d acc -> Sexp.unsafe_atom_of_string (":" ^ n) :: (List.map ~f:sexp_of_a d) @ acc) in Sexp.List (unnamed @ named) diff --git a/src/jbuild.mli b/src/jbuild.mli index efba5409..8b9e3979 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -83,12 +83,18 @@ end module Named : sig type 'a t = - { named : (Loc.t * 'a list) String.Map.t + { named : 'a list String.Map.t ; unnamed : 'a list } val empty : 'a t + val singleton : 'a -> 'a t + + val first : 'a t -> ('a, [`Empty | `Named_exists]) Result.t + + val fold : 'a t -> f:('a -> 'init -> 'init) -> init:'init -> 'init + val sexp_of_t : ('a -> Usexp.t) -> 'a t -> Usexp.t end diff --git a/src/preprocessing.ml b/src/preprocessing.ml index fad3f8cd..799c8926 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -456,7 +456,7 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind = let src_path = Path.relative dir src.name in add_alias src.name (Build.path src_path - >>^ (fun _ -> [src_path]) + >>^ (fun _ -> Jbuild.Named.singleton src_path) >>> SC.Action.run sctx action ~loc @@ -531,7 +531,7 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess (preprocessor_deps >>> Build.path src - >>^ (fun _ -> [src]) + >>^ (fun _ -> Jbuild.Named.singleton src) >>> SC.Action.run sctx (Redirect diff --git a/src/super_context.ml b/src/super_context.ml index 7393410f..dd024ebf 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -528,11 +528,20 @@ module Deps = struct >>^ List.concat let interpret_named t ~scope ~dir { Named.unnamed; named } = - String.Map.fold ~init:unnamed named ~f:(fun (_, ds) acc -> - List.rev_append ds acc) - |> List.map ~f:(dep t ~scope ~dir) - |> Build.all - >>^ List.concat + let deps l = + List.map ~f:(dep t ~scope ~dir) l + |> Build.all + >>^ List.concat + in + let unnamed = deps unnamed in + let named = + String.Map.to_list named + |> List.map ~f:(fun (k, d) -> deps d >>^ fun d -> (k, d)) + |> Build.all + >>^ String.Map.of_list_exn + in + unnamed &&& named >>^ fun (unnamed, named) -> + { Named.unnamed; named } end module Pkg_version = struct @@ -762,31 +771,47 @@ 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 = + let expand_step2 ~dir ~dynamic_expansions + ~(deps_written_by_user : Path.t Jbuild.Named.t) + ~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 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) + begin match + Pform.Map.expand Pform.Map.static_vars ~syntax_version ~var + with + | None -> + String.Map.find deps_written_by_user.named key + |> Option.map ~f:Value.L.paths + | Some x -> + begin match x with + Pform.Var.Deps -> + deps_written_by_user + |> Jbuild.Named.fold ~init:[] ~f:List.cons + |> Value.L.paths + |> Option.some | First_dep -> - begin match deps_written_by_user with - | [] -> + begin match Jbuild.Named.first deps_written_by_user with + | Error `Named_exists -> + Loc.fail loc "%%{first-dep} is not allowed with named dependencies" + | Error `Empty -> Loc.warn loc "Variable '%s' used with no explicit \ dependencies@." key; - [Value.String ""] - | v :: _ -> [Path v] + Some [Value.String ""] + | Ok v -> Some [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 var] + end + end) 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 = + : (Path.t Named.t, Action.t) Build.t = let map_exe = map_exe sctx in if targets_written_by_user = Alias then begin match Action.Infer.unexpanded_targets t with diff --git a/src/super_context.mli b/src/super_context.mli index eb86dd28..f7ba8137 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -225,7 +225,7 @@ module Deps : sig -> scope:Scope.t -> dir:Path.t -> Dep_conf.t Named.t - -> (unit, Path.t list) Build.t + -> (unit, Path.t Named.t) Build.t end (** Interpret action written in jbuild files *) @@ -245,7 +245,7 @@ module Action : sig -> dep_kind:Build.lib_dep_kind -> targets:targets -> scope:Scope.t - -> (Path.t list, Action.t) Build.t + -> (Path.t Named.t, Action.t) Build.t end module Pkg_version : sig