handle findlib properly
This commit is contained in:
parent
c1fef155d4
commit
d3125bd4a8
|
@ -48,6 +48,11 @@ let find_prog prog =
|
|||
in
|
||||
search path
|
||||
|
||||
let locate prog =
|
||||
match find_prog prog with
|
||||
| None -> None
|
||||
| Some (_, fn) -> Some fn
|
||||
|
||||
let prog_not_found_in_path prog =
|
||||
Printf.eprintf "Program %s not found in PATH" prog;
|
||||
exit 2
|
||||
|
|
|
@ -8,3 +8,5 @@ val ocamlc : string
|
|||
val ocamlopt : string option
|
||||
val ocamldep : string
|
||||
val ocamllex : string
|
||||
|
||||
val locate : string -> string option
|
||||
|
|
|
@ -79,7 +79,16 @@ let acknowledge_meta (meta : Meta.t) =
|
|||
in
|
||||
Hashtbl.add db name { name; vars })
|
||||
|
||||
let findlib_dir = Filename.dirname Bin.dir ^/ "lib"
|
||||
let findlib_dirs =
|
||||
match Bin.locate "ocamlfind" with
|
||||
| Some fn ->
|
||||
ksprintf run_and_read_lines "%s printconf path" fn
|
||||
| None ->
|
||||
match Bin.locate "opam" with
|
||||
| None ->
|
||||
[Filename.dirname Bin.dir ^/ "lib"]
|
||||
| Some fn ->
|
||||
[run_and_read_line "%s config var root"]
|
||||
|
||||
exception Package_not_found of string
|
||||
|
||||
|
@ -88,24 +97,38 @@ let root_pkg s =
|
|||
| exception Not_found -> s
|
||||
| i -> String.sub s ~pos:0 ~len:i
|
||||
|
||||
let load_meta root_name =
|
||||
let rec loop dirs =
|
||||
match dirs with
|
||||
| [] -> raise (Package_not_found root_name)
|
||||
| dir :: dirs ->
|
||||
let fn = dir ^/ root_name ^/ "META" in
|
||||
if Sys.file_exists fn then
|
||||
acknowledge_meta
|
||||
{ name = root_name
|
||||
; entries = Meta.load fn
|
||||
}
|
||||
else
|
||||
loop dirs
|
||||
in
|
||||
loop findlib_dirs
|
||||
|
||||
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
|
||||
if Sys.file_exists fn then begin
|
||||
acknowledge_meta { name = root; entries = Meta.load fn };
|
||||
load_meta (root_pkg name);
|
||||
get_pkg name
|
||||
end else
|
||||
raise (Package_not_found name)
|
||||
| pkg -> pkg
|
||||
|
||||
let root_packages =
|
||||
let v = lazy (
|
||||
Sys.readdir findlib_dir
|
||||
List.map findlib_dirs ~f:(fun dir ->
|
||||
Sys.readdir dir
|
||||
|> Array.to_list
|
||||
|> List.filter ~f:(fun name ->
|
||||
Sys.file_exists (findlib_dir ^/ name ^/ "META"))
|
||||
Sys.file_exists (dir ^/ name ^/ "META")))
|
||||
|> List.concat
|
||||
|> List.sort ~cmp:String.compare
|
||||
) in
|
||||
fun () -> Lazy.force v
|
||||
|
||||
|
|
|
@ -120,15 +120,8 @@ module Scheduler = struct
|
|||
| Some fn -> sprintf "%s > %s" s fn
|
||||
|
||||
let process_done job status =
|
||||
match status with
|
||||
| Unix.WEXITED 0 -> Ivar.fill job.ivar ()
|
||||
| _ ->
|
||||
Printf.ksprintf failwith "Process \"%s\" exited with status %d"
|
||||
(command_line job)
|
||||
(match status with
|
||||
| WEXITED n -> n
|
||||
| WSIGNALED n -> 128 + n
|
||||
| WSTOPPED _ -> assert false)
|
||||
handle_process_status (lazy (command_line job)) status;
|
||||
Ivar.fill job.ivar ()
|
||||
|
||||
let running = Hashtbl.create 128
|
||||
|
||||
|
|
|
@ -42,6 +42,7 @@ type ('a, 'b) eq =
|
|||
let (^/) a b = a ^ "/" ^ b
|
||||
|
||||
let sprintf = Printf.sprintf
|
||||
let ksprintf = Printf.ksprintf
|
||||
|
||||
let protectx x ~finally ~f =
|
||||
match f x with
|
||||
|
@ -62,10 +63,40 @@ let with_lexbuf_from_file fn ~f =
|
|||
};
|
||||
f lb)
|
||||
|
||||
let lines_of_file fn =
|
||||
let input_lines =
|
||||
let rec loop ic acc =
|
||||
match input_line ic with
|
||||
| exception End_of_file -> List.rev acc
|
||||
| line -> loop ic (line :: acc)
|
||||
in
|
||||
with_file_in fn ~f:(fun ic -> loop ic [])
|
||||
fun ic -> loop ic []
|
||||
|
||||
let lines_of_file fn = with_file_in fn ~f:input_lines
|
||||
|
||||
exception Error of string
|
||||
let die fmt = ksprintf (fun msg -> raise (Error msg)) fmt
|
||||
|
||||
let handle_process_status cmd (status : Unix.process_status) =
|
||||
match status with
|
||||
| WEXITED 0 -> ()
|
||||
| WEXITED n -> die "Command exited with code %d: %s" n (Lazy.force cmd)
|
||||
| WSIGNALED n -> die "Command got killed by signal %d: %s" n (Lazy.force cmd)
|
||||
| WSTOPPED _ -> assert false
|
||||
|
||||
let with_process_in cmd ~f =
|
||||
let ic = Unix.open_process_in cmd in
|
||||
match f ic with
|
||||
| exception e ->
|
||||
ignore (Unix.close_process_in ic : Unix.process_status);
|
||||
raise e
|
||||
| y ->
|
||||
handle_process_status (lazy cmd) (Unix.close_process_in ic);
|
||||
y
|
||||
|
||||
let run_and_read_lines cmd = with_process_in cmd ~f:input_lines
|
||||
|
||||
let run_and_read_line cmd =
|
||||
match run_and_read_lines cmd with
|
||||
| [] -> die "Command returned no output: %s" cmd
|
||||
| [x] -> x
|
||||
| _ -> die "Command returned too many lines: %s" cmd
|
||||
|
|
|
@ -1,3 +1,5 @@
|
|||
open Import
|
||||
|
||||
type t =
|
||||
{ start : Lexing.position
|
||||
; stop : Lexing.position
|
||||
|
@ -11,7 +13,7 @@ let of_lexbuf lb =
|
|||
exception Error of t * string
|
||||
|
||||
let fail t fmt =
|
||||
Printf.ksprintf (fun msg -> raise (Error (t, msg))) fmt
|
||||
ksprintf (fun msg -> raise (Error (t, msg))) fmt
|
||||
|
||||
let fail_lex lb fmt =
|
||||
fail (of_lexbuf lb) fmt
|
||||
|
|
Loading…
Reference in New Issue