add internal command

build.ml

@@ -1,5 +1,3 @@
-#load "str.cma";;
-
 open StdLabels
 open Printf
 
@@ -12,6 +10,7 @@ let modules =
   ; "Loc"
   ; "Meta_lexer"
   ; "Meta"
+  ; "Bin"
   ; "Findlib"
   ; "Sexp"
   ; "Sexp_lexer"
@@ -25,17 +24,29 @@ let modules =
 
 let lexers = [ "sexp_lexer"; "meta_lexer" ]
 
+let path_sep =
+  if Sys.win32 then
+    ';'
+  else
+    ':'
+;;
+
+let split_path s =
+  let rec loop i j =
+    if j = String.length s then
+      [String.sub s ~pos:i ~len:(j - i)]
+    else if s.[j] = path_sep then
+      String.sub s ~pos:i ~len:(j - i) :: loop (j + 1) (j + 1)
+    else
+      loop i (j + 1)
+  in
+  loop 0 0
+;;
+
 let path =
   match Sys.getenv "PATH" with
   | exception Not_found -> []
-  | s ->
-    let sep =
-      if Sys.win32 then
-        ";"
-      else
-        ":"
-    in
-    Str.split_delim (Str.regexp sep) s
+  | s -> split_path s
 ;;
 
 let exe = if Sys.win32 then ".exe" else ""

src/bin.ml

@@ -0,0 +1,73 @@
+open Import
+
+let path_sep =
+  if Sys.win32 then
+    ';'
+  else
+    ':'
+;;
+
+let split_path s =
+  let rec loop i j =
+    if j = String.length s then
+      [String.sub s ~pos:i ~len:(j - i)]
+    else if s.[j] = path_sep then
+      String.sub s ~pos:i ~len:(j - i) :: loop (j + 1) (j + 1)
+    else
+      loop i (j + 1)
+  in
+  loop 0 0
+;;
+
+let path =
+  match Sys.getenv "PATH" with
+  | exception Not_found -> []
+  | s -> split_path s
+;;
+
+let exe = if Sys.win32 then ".exe" else ""
+
+let best_prog dir prog =
+  let fn = dir ^/ prog ^ ".opt" ^ exe in
+  if Sys.file_exists fn then
+    Some fn
+  else
+    let fn = dir ^/ prog ^ exe in
+    if Sys.file_exists fn then
+      Some fn
+    else
+      None
+
+let find_prog prog =
+  let rec search = function
+    | [] -> None
+    | dir :: rest ->
+      match best_prog dir prog with
+      | None -> search rest
+      | Some fn -> Some (dir, fn)
+  in
+  search path
+
+let prog_not_found_in_path prog =
+  Printf.eprintf "Program %s not found in PATH" prog;
+  exit 2
+
+let dir, ocamlc =
+  match find_prog "ocamlc" with
+  | None -> prog_not_found_in_path "ocamlc"
+  | Some x -> x
+
+let prog_not_found prog =
+  Printf.eprintf "ocamlc found in %s, but %s/%s doesn't exist" dir dir prog;
+  exit 2
+
+let best_prog prog = best_prog dir prog
+
+let get_prog prog =
+  match best_prog prog with
+  | None -> prog_not_found prog
+  | Some fn -> fn
+
+let ocamlopt = best_prog "ocamlopt"
+let ocamllex = get_prog "ocamllex"
+let ocamldep = get_prog "ocamldep"

src/bin.mli

@@ -0,0 +1,10 @@
+(** OCaml binaries *)
+
+(** Directory where the compiler and other tools are installed *)
+val dir : string
+
+(** Tools *)
+val ocamlc : string
+val ocamlopt : string option
+val ocamldep : string
+val ocamllex : string

src/findlib.ml

@@ -79,7 +79,7 @@ let acknowledge_meta (meta : Meta.t) =
       in
       Hashtbl.add db name { name; vars })
 
-let findlib_dir = ref ""
+let findlib_dir = Filename.dirname Bin.dir ^/ "lib"
 
 exception Package_not_found of string
 
@@ -92,7 +92,7 @@ let rec get_pkg name =
   match Hashtbl.find db name with
   | exception Not_found ->
     let root = root_pkg name in
-    let fn = !findlib_dir ^/ root ^/ "META" in
+    let fn = findlib_dir ^/ root ^/ "META" in
     if Sys.file_exists fn then begin
       acknowledge_meta { name = root; entries = Meta.load fn };
       get_pkg name
@@ -100,6 +100,24 @@ let rec get_pkg name =
       raise (Package_not_found name)
   | pkg -> pkg
 
+let root_packages =
+  let v = lazy (
+    Sys.readdir findlib_dir
+    |> Array.to_list
+    |> List.filter ~f:(fun name ->
+        Sys.file_exists (findlib_dir ^/ name ^/ "META"))
+  ) in
+  fun () -> Lazy.force v
+
+let all_packages =
+  let v = lazy (
+    List.iter (root_packages ()) ~f:(fun pkg ->
+        ignore (get_pkg pkg : package));
+    Hashtbl.fold db ~init:[] ~f:(fun ~key:pkg ~data:_ acc -> pkg :: acc)
+    |> List.sort ~cmp:String.compare
+  ) in
+  fun () -> Lazy.force v
+
 let rec interpret_rules rules ~preds =
   match rules with
   | [] -> None

src/findlib.mli

@@ -2,4 +2,7 @@
 
 exception Package_not_found of string
 
+val root_packages : unit -> string list
+val all_packages  : unit -> string list
+
 val query : pkg:string -> preds:string list -> var:string -> string option

src/jbuild.ml

@@ -1,3 +1,21 @@
-module J = Jbuild_interpret
+open Import
 
-let () = Future.Scheduler.go (Rule.do_build ["all"])
+let internal argv =
+  match Array.to_list argv with
+  | [_; "findlib-packages"] ->
+    List.iter (Findlib.all_packages ()) ~f:(Printf.printf "%s\n")
+  | _ ->
+    ()
+
+let () =
+  let argv = Sys.argv in
+  let argc = Array.length argv in
+  let compact () =
+    Array.append
+      [|sprintf "%s %s" argv.(0) argv.(1)|]
+      (Array.sub argv ~pos:2 ~len:(argc - 2))
+  in
+  if argc >= 2 then
+    match argv.(1) with
+    | "internal" -> internal (compact ())
+    | _ -> ()