114.29+68
This commit is contained in:
parent
5f239a349f
commit
1c1a08ec54
|
@ -8,8 +8,6 @@ license: "Apache-2.0"
|
||||||
build: [
|
build: [
|
||||||
["ocaml" "build.ml" "build-package" "jbuilder" "-j" jobs]
|
["ocaml" "build.ml" "build-package" "jbuilder" "-j" jobs]
|
||||||
]
|
]
|
||||||
depends: [
|
|
||||||
]
|
|
||||||
available: [ ocaml-version >= "4.03.0" ]
|
available: [ ocaml-version >= "4.03.0" ]
|
||||||
descr: "
|
descr: "
|
||||||
Fast, portable and opinionated build system
|
Fast, portable and opinionated build system
|
||||||
|
|
|
@ -56,7 +56,10 @@ let record_lib_deps ~dir ~kind lib_deps =
|
||||||
List.concat_map lib_deps ~f:(function
|
List.concat_map lib_deps ~f:(function
|
||||||
| Jbuild_types.Lib_dep.Direct s -> [(s, kind)]
|
| Jbuild_types.Lib_dep.Direct s -> [(s, kind)]
|
||||||
| Select { choices; _ } ->
|
| 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)
|
|> String_map.of_alist_exn)
|
||||||
|
|
||||||
module O = struct
|
module O = struct
|
||||||
|
|
|
@ -174,8 +174,18 @@ module Gen(P : Params) = struct
|
||||||
internal_libs_without_non_installable_optional_ones t
|
internal_libs_without_non_installable_optional_ones t
|
||||||
|
|
||||||
let select_rules ~dir lib_deps =
|
let select_rules ~dir lib_deps =
|
||||||
List.map (Lib_db.resolve_selects t lib_deps) ~f:(fun (fn, code) ->
|
List.map (Lib_db.resolve_selects t lib_deps) ~f:(fun { dst_fn; src_fn } ->
|
||||||
Build.return code >>> Build.echo (Path.relative dir 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 *)
|
(* Hides [t] so that we don't resolve things statically *)
|
||||||
let t = ()
|
let t = ()
|
||||||
|
|
|
@ -291,9 +291,11 @@ module Js_of_ocaml = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module Lib_dep = struct
|
module Lib_dep = struct
|
||||||
|
type literal = Pos of string | Neg of string
|
||||||
|
|
||||||
type choice =
|
type choice =
|
||||||
{ dep : string
|
{ lits : literal list
|
||||||
; code : string
|
; file : string
|
||||||
}
|
}
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
|
@ -301,9 +303,31 @@ module Lib_dep = struct
|
||||||
| Select of { result_fn : string; choices : choice list }
|
| Select of { result_fn : string; choices : choice list }
|
||||||
|
|
||||||
let choice = function
|
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>... -> <file>) 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 "(<library-name> <code>) expected" sexp
|
| sexp -> of_sexp_error "(<library-name> <code>) 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
|
let t = function
|
||||||
| Atom s ->
|
| Atom s ->
|
||||||
Direct s
|
Direct s
|
||||||
|
@ -317,7 +341,11 @@ module Lib_dep = struct
|
||||||
|
|
||||||
let to_lib_names = function
|
let to_lib_names = function
|
||||||
| Direct s -> [s]
|
| 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
|
let direct s = Direct s
|
||||||
end
|
end
|
||||||
|
|
104
src/lib_db.ml
104
src/lib_db.ml
|
@ -43,29 +43,33 @@ let top_sort_internals t =
|
||||||
(List.map cycle ~f:(fun lib -> Lib.describe (Internal lib))
|
(List.map cycle ~f:(fun lib -> Lib.describe (Internal lib))
|
||||||
|> String.concat ~sep:"\n-> ")
|
|> String.concat ~sep:"\n-> ")
|
||||||
|
|
||||||
module Compute_instalable_internal_libs = struct
|
let lib_is_installable t name =
|
||||||
let lib_is_installable t ~internal_instalable_libs name =
|
match find_internal t name with
|
||||||
match find_internal t name with
|
| Some (_, lib) -> String_map.mem lib.name t.instalable_internal_libs
|
||||||
| Some (_, lib) -> String_map.mem lib.name internal_instalable_libs
|
| None -> Findlib.available t.findlib name
|
||||||
| None -> Findlib.available t.findlib name
|
|
||||||
|
|
||||||
let dep_is_installable t ~internal_instalable_libs dep =
|
let choice_is_possible t { Lib_dep. lits; _ } =
|
||||||
match (dep : Lib_dep.t) with
|
List.for_all lits ~f:(function
|
||||||
| Direct s -> lib_is_installable t s ~internal_instalable_libs
|
| Lib_dep.Pos name -> lib_is_installable t name
|
||||||
| Select { choices; _ } ->
|
| Lib_dep.Neg name -> not (lib_is_installable t name))
|
||||||
List.exists choices ~f:(fun c ->
|
|
||||||
lib_is_installable t ~internal_instalable_libs c.Lib_dep.dep)
|
|
||||||
|
|
||||||
let compute t =
|
let dep_is_installable t dep =
|
||||||
List.fold_left (top_sort_internals t) ~init:String_map.empty
|
match (dep : Lib_dep.t) with
|
||||||
~f:(fun acc (dir, lib) ->
|
| Direct s -> lib_is_installable t s
|
||||||
if not lib.Library.optional ||
|
| Select { choices; _ } -> List.exists choices ~f:(choice_is_possible t)
|
||||||
List.for_all (Library.all_lib_deps lib)
|
|
||||||
~f:(dep_is_installable t ~internal_instalable_libs:acc) then
|
let compute_instalable_internal_libs t =
|
||||||
String_map.add acc ~key:lib.name ~data:(dir, lib)
|
List.fold_left (top_sort_internals t) ~init:t
|
||||||
else
|
~f:(fun t (dir, lib) ->
|
||||||
acc)
|
if not lib.Library.optional ||
|
||||||
end
|
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 create findlib stanzas =
|
||||||
let libs : (string, Lib.t) Hashtbl.t = Hashtbl.create 1024 in
|
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)
|
Hashtbl.add libs ~key:name ~data)
|
||||||
| _ -> ()));
|
| _ -> ()));
|
||||||
let t = { findlib; libs; instalable_internal_libs = String_map.empty } in
|
let t = { findlib; libs; instalable_internal_libs = String_map.empty } in
|
||||||
{ t with instalable_internal_libs =
|
compute_instalable_internal_libs t
|
||||||
Compute_instalable_internal_libs.compute t }
|
|
||||||
|
|
||||||
let internal_libs_without_non_installable_optional_ones t =
|
let internal_libs_without_non_installable_optional_ones t =
|
||||||
String_map.values t.instalable_internal_libs
|
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 interpret_lib_deps t ~dir lib_deps =
|
||||||
let libs, failures =
|
let libs, failures =
|
||||||
List.partition_map lib_deps ~f:(function
|
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 } ->
|
| Select { result_fn; choices } ->
|
||||||
match
|
match
|
||||||
List.find_map choices ~f:(fun s ->
|
List.find_map choices ~f:(fun { lits; _ } ->
|
||||||
match find_either t s.dep with
|
match
|
||||||
| Inl _ as x -> Some x
|
List.filter_map lits ~f:(function
|
||||||
| Inr _ -> None)
|
| 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
|
with
|
||||||
| Some res -> res
|
| Some l -> Inl l
|
||||||
| None ->
|
| None ->
|
||||||
Inr { fail = fun () ->
|
Inr { fail = fun () ->
|
||||||
die "\
|
die "\
|
||||||
|
@ -113,11 +123,12 @@ No solution found for the following form in %s:
|
||||||
(Path.to_string dir)
|
(Path.to_string dir)
|
||||||
result_fn
|
result_fn
|
||||||
(String.concat ~sep:"\n "
|
(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
|
in
|
||||||
let internals, externals =
|
let internals, externals =
|
||||||
List.partition_map libs ~f:(function
|
List.partition_map (List.concat libs) ~f:(function
|
||||||
| Internal x -> Inl x
|
| Internal x -> Inl x
|
||||||
| External x -> Inr x)
|
| External x -> Inr x)
|
||||||
in
|
in
|
||||||
|
@ -126,17 +137,18 @@ No solution found for the following form in %s:
|
||||||
| [] -> None
|
| [] -> None
|
||||||
| f :: _ -> Some f)
|
| f :: _ -> Some f)
|
||||||
|
|
||||||
|
type resolved_select =
|
||||||
|
{ src_fn : string
|
||||||
|
; dst_fn : string
|
||||||
|
}
|
||||||
|
|
||||||
let resolve_selects t lib_deps =
|
let resolve_selects t lib_deps =
|
||||||
List.filter_map lib_deps ~f:(function
|
List.filter_map lib_deps ~f:(function
|
||||||
| Lib_dep.Direct _ -> None
|
| Lib_dep.Direct _ -> None
|
||||||
| Select { result_fn; choices } ->
|
| Select { result_fn; choices } ->
|
||||||
let contents =
|
let src_fn =
|
||||||
match List.find_map choices ~f:(fun s ->
|
match List.find choices ~f:(choice_is_possible t) with
|
||||||
match find_either t s.dep with
|
| Some c -> c.file
|
||||||
| Inl _ -> Some s.code
|
|
||||||
| Inr _ -> None)
|
|
||||||
with
|
|
||||||
| Some code -> code
|
|
||||||
| None -> "no solution found"
|
| None -> "no solution found"
|
||||||
in
|
in
|
||||||
Some (result_fn, contents))
|
Some { dst_fn = result_fn; src_fn })
|
||||||
|
|
|
@ -18,7 +18,12 @@ val interpret_lib_deps
|
||||||
-> Jbuild_types.Lib_dep.t list
|
-> Jbuild_types.Lib_dep.t list
|
||||||
-> Lib.Internal.t list * Findlib.package list * fail option
|
-> Lib.Internal.t list * Findlib.package list * fail option
|
||||||
|
|
||||||
|
type resolved_select =
|
||||||
|
{ src_fn : string
|
||||||
|
; dst_fn : string
|
||||||
|
}
|
||||||
|
|
||||||
val resolve_selects
|
val resolve_selects
|
||||||
: t
|
: t
|
||||||
-> Jbuild_types.Lib_dep.t list
|
-> Jbuild_types.Lib_dep.t list
|
||||||
-> (string * string) list
|
-> resolved_select list
|
||||||
|
|
Loading…
Reference in New Issue