matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Detect clauses that are always false in (select ...) forms

This commit is contained in:
Jeremie Dimino 2017-04-26 13:21:51 +01:00
parent 05581ed8bc
commit 43572595b4
3 changed files with 43 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/build.ml
View File

@ -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

50
src/jbuild_types.ml
View File

@ -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>... -> <file>) 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 "(<library-name> <code>) 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 "<library> or (select <module> from <libraries...>) 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

42
src/lib_db.ml
View File

@ -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