From 1c1a08ec547c1405fa482489f8ebfbfed03a8e43 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 26 Jan 2017 10:53:37 +0000 Subject: [PATCH] 114.29+68 --- jbuilder.opam | 2 - src/build.ml | 5 ++- src/gen_rules.ml | 14 +++++- src/jbuild_types.ml | 36 +++++++++++++-- src/lib_db.ml | 104 ++++++++++++++++++++++++-------------------- src/lib_db.mli | 7 ++- 6 files changed, 112 insertions(+), 56 deletions(-) diff --git a/jbuilder.opam b/jbuilder.opam index cb0875a5..c43264d7 100644 --- a/jbuilder.opam +++ b/jbuilder.opam @@ -8,8 +8,6 @@ license: "Apache-2.0" build: [ ["ocaml" "build.ml" "build-package" "jbuilder" "-j" jobs] ] -depends: [ -] available: [ ocaml-version >= "4.03.0" ] descr: " Fast, portable and opinionated build system diff --git a/src/build.ml b/src/build.ml index 4ee35516..85baefb8 100644 --- a/src/build.ml +++ b/src/build.ml @@ -56,7 +56,10 @@ let record_lib_deps ~dir ~kind lib_deps = List.concat_map lib_deps ~f:(function | Jbuild_types.Lib_dep.Direct s -> [(s, kind)] | Select { choices; _ } -> - List.map choices ~f:(fun c -> (c.Jbuild_types.Lib_dep.dep, Optional))) + 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_map.of_alist_exn) module O = struct diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 4f4cd1e2..cf1773cf 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -174,8 +174,18 @@ module Gen(P : Params) = struct internal_libs_without_non_installable_optional_ones t let select_rules ~dir lib_deps = - List.map (Lib_db.resolve_selects t lib_deps) ~f:(fun (fn, code) -> - Build.return code >>> Build.echo (Path.relative dir fn)) + List.map (Lib_db.resolve_selects t lib_deps) ~f:(fun { dst_fn; src_fn } -> + let src = Path.relative dir src_fn in + let dst = Path.relative dir dst_fn in + Build.path src + >>> + Build.create_files ~targets:[dst] (fun () -> + let src_fn = Path.to_string src in + let dst_fn = Path.to_string dst in + with_file_in src_fn ~f:(fun ic -> + with_file_out dst_fn ~f:(fun oc -> + Printf.fprintf oc "# 1 \"%s\"\n" src_fn; + copy_channels ic oc)))) (* Hides [t] so that we don't resolve things statically *) let t = () diff --git a/src/jbuild_types.ml b/src/jbuild_types.ml index 6699a6fa..a88c51a7 100644 --- a/src/jbuild_types.ml +++ b/src/jbuild_types.ml @@ -291,9 +291,11 @@ module Js_of_ocaml = struct end module Lib_dep = struct + type literal = Pos of string | Neg of string + type choice = - { dep : string - ; code : string + { lits : literal list + ; file : string } type t = @@ -301,9 +303,31 @@ module Lib_dep = struct | Select of { result_fn : string; choices : choice list } let choice = function - | List [Atom dep; Atom code] -> { dep; code } + | List l as sexp -> + let rec loop acc = function + | [Atom "->"; sexp] -> + { lits = List.rev acc + ; file = file sexp + } + | Atom "->" :: _ | List _ :: _ | [] -> + of_sexp_error "(<[!]libraries>... -> ) expected" sexp + | Atom s :: l -> + 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 + else + loop (Pos s :: acc) l + in + loop [] l | sexp -> of_sexp_error "( ) expected" sexp + let sexp_of_choice { lits; file } = + List (List.fold_right lits ~init:[Atom "->"; Atom file] ~f:(fun lit acc -> + match lit with + | Pos s -> Atom s :: acc + | Neg s -> Atom ("!" ^ s) :: acc)) + let t = function | Atom s -> Direct s @@ -317,7 +341,11 @@ module Lib_dep = struct let to_lib_names = function | Direct s -> [s] - | Select s -> (List.map s.choices ~f:(fun x -> x.dep)) + | Select s -> + List.concat_map s.choices ~f:(fun x -> + List.map x.lits ~f:(function + | Pos x -> x + | Neg x -> x)) let direct s = Direct s end diff --git a/src/lib_db.ml b/src/lib_db.ml index 0754f387..fa8e44fc 100644 --- a/src/lib_db.ml +++ b/src/lib_db.ml @@ -43,29 +43,33 @@ let top_sort_internals t = (List.map cycle ~f:(fun lib -> Lib.describe (Internal lib)) |> String.concat ~sep:"\n-> ") -module Compute_instalable_internal_libs = struct - let lib_is_installable t ~internal_instalable_libs name = - match find_internal t name with - | Some (_, lib) -> String_map.mem lib.name internal_instalable_libs - | None -> Findlib.available t.findlib name +let lib_is_installable t name = + match find_internal t name with + | Some (_, lib) -> String_map.mem lib.name t.instalable_internal_libs + | None -> Findlib.available t.findlib name - let dep_is_installable t ~internal_instalable_libs dep = - match (dep : Lib_dep.t) with - | Direct s -> lib_is_installable t s ~internal_instalable_libs - | Select { choices; _ } -> - List.exists choices ~f:(fun c -> - lib_is_installable t ~internal_instalable_libs c.Lib_dep.dep) +let choice_is_possible t { Lib_dep. lits; _ } = + List.for_all lits ~f:(function + | Lib_dep.Pos name -> lib_is_installable t name + | Lib_dep.Neg name -> not (lib_is_installable t name)) - let compute t = - List.fold_left (top_sort_internals t) ~init:String_map.empty - ~f:(fun acc (dir, lib) -> - if not lib.Library.optional || - List.for_all (Library.all_lib_deps lib) - ~f:(dep_is_installable t ~internal_instalable_libs:acc) then - String_map.add acc ~key:lib.name ~data:(dir, lib) - else - acc) -end +let dep_is_installable t dep = + match (dep : Lib_dep.t) with + | Direct s -> lib_is_installable t s + | Select { choices; _ } -> List.exists choices ~f:(choice_is_possible t) + +let compute_instalable_internal_libs t = + List.fold_left (top_sort_internals t) ~init:t + ~f:(fun t (dir, lib) -> + if not lib.Library.optional || + List.for_all (Library.all_lib_deps lib) ~f:(dep_is_installable t) then + { t + with instalable_internal_libs = + String_map.add t.instalable_internal_libs + ~key:lib.name ~data:(dir, lib) + } + else + t) let create findlib stanzas = let libs : (string, Lib.t) Hashtbl.t = Hashtbl.create 1024 in @@ -79,31 +83,37 @@ let create findlib stanzas = Hashtbl.add libs ~key:name ~data) | _ -> ())); let t = { findlib; libs; instalable_internal_libs = String_map.empty } in - { t with instalable_internal_libs = - Compute_instalable_internal_libs.compute t } + compute_instalable_internal_libs t let internal_libs_without_non_installable_optional_ones t = String_map.values t.instalable_internal_libs -let find_either t name = - match find t name with - | x -> Inl x - | exception e -> - (* Call [find] again to get a proper backtrace *) - Inr { fail = fun () -> ignore (find t name : Lib.t); raise e } - let interpret_lib_deps t ~dir lib_deps = let libs, failures = List.partition_map lib_deps ~f:(function - | Lib_dep.Direct s -> find_either t s + | Lib_dep.Direct name -> begin + match find t name with + | x -> Inl [x] + | exception e -> + (* Call [find] again to get a proper backtrace *) + Inr { fail = fun () -> ignore (find t name : Lib.t); raise e } + end | Select { result_fn; choices } -> match - List.find_map choices ~f:(fun s -> - match find_either t s.dep with - | Inl _ as x -> Some x - | Inr _ -> None) + List.find_map choices ~f:(fun { lits; _ } -> + match + List.filter_map lits ~f:(function + | Pos s -> Some (find t s) + | Neg s -> + if lib_is_installable t s then + raise Exit + else + None) + with + | l -> Some l + | exception _ -> None) with - | Some res -> res + | Some l -> Inl l | None -> Inr { fail = fun () -> die "\ @@ -113,11 +123,12 @@ No solution found for the following form in %s: (Path.to_string dir) result_fn (String.concat ~sep:"\n " - (List.map choices ~f:(fun c -> c.Lib_dep.dep))) + (List.map choices ~f:(fun c -> + Sexp.to_string (Lib_dep.sexp_of_choice c)))) }) in let internals, externals = - List.partition_map libs ~f:(function + List.partition_map (List.concat libs) ~f:(function | Internal x -> Inl x | External x -> Inr x) in @@ -126,17 +137,18 @@ No solution found for the following form in %s: | [] -> None | f :: _ -> Some f) +type resolved_select = + { src_fn : string + ; dst_fn : string + } + let resolve_selects t lib_deps = List.filter_map lib_deps ~f:(function | Lib_dep.Direct _ -> None | Select { result_fn; choices } -> - let contents = - match List.find_map choices ~f:(fun s -> - match find_either t s.dep with - | Inl _ -> Some s.code - | Inr _ -> None) - with - | Some code -> code + let src_fn = + match List.find choices ~f:(choice_is_possible t) with + | Some c -> c.file | None -> "no solution found" in - Some (result_fn, contents)) + Some { dst_fn = result_fn; src_fn }) diff --git a/src/lib_db.mli b/src/lib_db.mli index cdaec544..ab0a7b52 100644 --- a/src/lib_db.mli +++ b/src/lib_db.mli @@ -18,7 +18,12 @@ val interpret_lib_deps -> Jbuild_types.Lib_dep.t list -> Lib.Internal.t list * Findlib.package list * fail option +type resolved_select = + { src_fn : string + ; dst_fn : string + } + val resolve_selects : t -> Jbuild_types.Lib_dep.t list - -> (string * string) list + -> resolved_select list