114.29+68

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

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

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 = ()

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>... -> <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
 
+  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

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 })

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