diff --git a/src/build.ml b/src/build.ml index 7bee1b56..aff1425f 100644 --- a/src/build.ml +++ b/src/build.ml @@ -64,9 +64,8 @@ let record_lib_deps ~dir ~kind lib_deps = | Jbuild_types.Lib_dep.Direct s -> [(s, kind)] | Select { choices; _ } -> List.concat_map choices ~f:(fun c -> - List.filter_map c.Jbuild_types.Lib_dep.lits ~f:(function - | Pos d -> Some (d, Optional) - | Neg _ -> None))) + String_set.elements c.Jbuild_types.Lib_dep.required + |> List.map ~f:(fun d -> (d, Optional)))) |> String_map.of_alist_reduce ~f:merge_lib_dep_kind) module O = struct diff --git a/src/jbuild_types.ml b/src/jbuild_types.ml index 5715a0f6..dc080aec 100644 --- a/src/jbuild_types.ml +++ b/src/jbuild_types.ml @@ -250,14 +250,17 @@ module Js_of_ocaml = struct end module Lib_dep = struct - type literal = Pos of string | Neg of string - type choice = - { lits : literal list - ; file : string + { required : String_set.t + ; forbidden : String_set.t + ; file : string } - type select = { result_fn : string; choices : choice list } + type select = + { result_fn : string + ; choices : choice list + ; loc : Loc.t (* For error messages *) + } type t = | Direct of string @@ -265,10 +268,16 @@ module Lib_dep = struct let choice = function | List (_, l) as sexp -> - let rec loop acc = function - | [Atom (_, "->"); sexp] -> - { lits = List.rev acc - ; file = file sexp + let rec loop required forbidden = function + | [Atom (_, "->"); fsexp] -> + let common = String_set.inter required forbidden in + if not (String_set.is_empty common) then + of_sexp_errorf sexp + "library %S is both required and forbidden in this clause" + (String_set.choose common); + { required + ; forbidden + ; file = file fsexp } | Atom (_, "->") :: _ | List _ :: _ | [] -> of_sexp_error sexp "(<[!]libraries>... -> ) expected" @@ -276,26 +285,20 @@ module Lib_dep = struct let len = String.length s in if len > 0 && s.[0] = '!' then let s = String.sub s ~pos:1 ~len:(len - 1) in - loop (Neg s :: acc) l + loop required (String_set.add s forbidden) l else - loop (Pos s :: acc) l + loop (String_set.add s required) forbidden l in - loop [] l + loop String_set.empty String_set.empty l | sexp -> of_sexp_error sexp "( ) expected" - let sexp_of_choice { lits; file } : Sexp.t = - List (List.fold_right lits ~init:[Atom "->"; Atom file] - ~f:(fun lit acc -> - match lit with - | Pos s -> Sexp.Atom s :: acc - | Neg s -> Sexp.Atom ("!" ^ s) :: acc)) - let t = function | Atom (_, s) -> Direct s - | List (_, Atom (_, "select") :: m :: Atom (_, "from") :: libs) -> + | List (loc, Atom (_, "select") :: m :: Atom (_, "from") :: libs) -> Select { result_fn = file m ; choices = List.map libs ~f:choice + ; loc } | sexp -> of_sexp_error sexp " or (select from ) expected" @@ -303,10 +306,9 @@ module Lib_dep = struct let to_lib_names = function | Direct s -> [s] | Select s -> - List.concat_map s.choices ~f:(fun x -> - List.map x.lits ~f:(function - | Pos x -> x - | Neg x -> x)) + List.fold_left s.choices ~init:String_set.empty ~f:(fun acc x -> + String_set.union acc (String_set.union x.required x.forbidden)) + |> String_set.elements let direct s = Direct s end diff --git a/src/lib_db.ml b/src/lib_db.ml index 0d9733e1..9b1b3e6d 100644 --- a/src/lib_db.ml +++ b/src/lib_db.ml @@ -72,10 +72,9 @@ let lib_is_available t ~from name = | Some (_, lib) -> String_map.mem lib.name t.instalable_internal_libs | None -> Findlib.available t.findlib name ~required_by:[Utils.jbuild_name_in ~dir:from] -let choice_is_possible t ~from { Lib_dep. lits; _ } = - List.for_all lits ~f:(function - | Lib_dep.Pos name -> lib_is_available t ~from name - | Lib_dep.Neg name -> not (lib_is_available t ~from name)) +let choice_is_possible t ~from { Lib_dep.required; forbidden; _ } = + String_set.for_all required ~f:(fun name -> lib_is_available t ~from name ) && + String_set.for_all forbidden ~f:(fun name -> not (lib_is_available t ~from name)) let dep_is_available t ~from dep = match (dep : Lib_dep.t) with @@ -130,33 +129,22 @@ let interpret_lib_deps t ~dir lib_deps = (* Call [find] again to get a proper backtrace *) Inr { fail = fun () -> ignore (find_exn t ~from:dir name : Lib.t); raise e } end - | Select { result_fn; choices } -> + | Select { choices; loc; _ } -> match - List.find_map choices ~f:(fun { lits; _ } -> - match - List.filter_map lits ~f:(function - | Pos s -> Some (find_exn t ~from:dir s) - | Neg s -> - if lib_is_available t ~from:dir s then - raise Exit - else - None) - with - | l -> Some l - | exception _ -> None) + List.find_map choices ~f:(fun { required; forbidden; _ } -> + if String_set.exists forbidden ~f:(lib_is_available t ~from:dir) then + None + else + match + List.map (String_set.elements required) ~f:(find_exn t ~from:dir) + with + | l -> Some l + | exception _ -> None) with | Some l -> Inl l | None -> Inr { fail = fun () -> - die "\ -No solution found for the following form in %s: - (select %s from - %s)" - (Path.to_string dir) - result_fn - (String.concat ~sep:"\n " - (List.map choices ~f:(fun c -> - Sexp.to_string (Lib_dep.sexp_of_choice c)))) + Loc.fail loc "No solution found for this select form" }) in let internals, externals = @@ -177,7 +165,7 @@ type resolved_select = let resolve_selects t ~from lib_deps = List.filter_map lib_deps ~f:(function | Lib_dep.Direct _ -> None - | Select { result_fn; choices } -> + | Select { result_fn; choices; _ } -> let src_fn = match List.find choices ~f:(choice_is_possible t ~from) with | Some c -> c.file