Allow to set the concurrency level from the config file
This commit is contained in:
parent
3347d4d59f
commit
fae08c79be
4
Makefile
4
Makefile
|
@ -4,10 +4,10 @@ BIN := ./_build/default/bin/main.exe
|
|||
-include Makefile.dev
|
||||
|
||||
default: boot.exe
|
||||
./boot.exe -j 4 --dev
|
||||
./boot.exe --dev
|
||||
|
||||
release: boot.exe
|
||||
./boot.exe -j 4
|
||||
./boot.exe
|
||||
|
||||
boot.exe: bootstrap.ml
|
||||
ocaml bootstrap.ml
|
||||
|
|
21
bin/main.ml
21
bin/main.ml
|
@ -8,8 +8,7 @@ open Fiber.O
|
|||
let () = suggest_function := Jbuilder_cmdliner.Cmdliner_suggest.value
|
||||
|
||||
type common =
|
||||
{ concurrency : int
|
||||
; debug_dep_path : bool
|
||||
{ debug_dep_path : bool
|
||||
; debug_findlib : bool
|
||||
; debug_backtraces : bool
|
||||
; dev_mode : bool
|
||||
|
@ -31,7 +30,6 @@ type common =
|
|||
let prefix_target common s = common.target_prefix ^ s
|
||||
|
||||
let set_common c ~targets =
|
||||
Clflags.concurrency := c.concurrency;
|
||||
Clflags.debug_dep_path := c.debug_dep_path;
|
||||
Clflags.debug_findlib := c.debug_findlib;
|
||||
Clflags.debug_backtraces := c.debug_backtraces;
|
||||
|
@ -231,12 +229,12 @@ let common =
|
|||
| Default -> Config.load_user_config_file ()
|
||||
in
|
||||
let config =
|
||||
match display with
|
||||
| None -> config
|
||||
| Some display -> { display }
|
||||
Config.merge config
|
||||
{ display
|
||||
; concurrency
|
||||
}
|
||||
in
|
||||
{ concurrency
|
||||
; debug_dep_path
|
||||
{ debug_dep_path
|
||||
; debug_findlib
|
||||
; debug_backtraces
|
||||
; dev_mode
|
||||
|
@ -259,7 +257,7 @@ let common =
|
|||
let docs = copts_sect in
|
||||
let concurrency =
|
||||
Arg.(value
|
||||
& opt int !Clflags.concurrency
|
||||
& opt (some int) None
|
||||
& info ["j"] ~docs ~docv:"JOBS"
|
||||
~doc:{|Run no more than $(i,JOBS) commands simultaneously.|}
|
||||
)
|
||||
|
@ -1281,6 +1279,11 @@ module Help = struct
|
|||
executed by Jbuilder, with some colors to help differentiate
|
||||
programs.|}
|
||||
])
|
||||
; `S "JOBS"
|
||||
; `P {|Syntax: $(b,\(jobs NUMBER\))|}
|
||||
; `P {|Set the maximum number of jobs Jbuilder might run in parallel.
|
||||
This can also be set from the command line via $(b,-j NUMBER).|}
|
||||
; `P {|The default for this value is 4.|}
|
||||
; common_footer
|
||||
]
|
||||
|
||||
|
|
|
@ -1,4 +1,3 @@
|
|||
let concurrency = ref 4
|
||||
(*let ocaml_comp_flags = ref ["-g"]*)
|
||||
let g = ref true
|
||||
let debug_findlib = ref false
|
||||
|
|
|
@ -1,8 +1,5 @@
|
|||
(** Command line flags *)
|
||||
|
||||
(** Concurrency *)
|
||||
val concurrency : int ref
|
||||
|
||||
(** Compilation flags for OCaml files *)
|
||||
(*val ocaml_comp_flags : string list ref*)
|
||||
|
||||
|
|
|
@ -38,18 +38,42 @@ module Display = struct
|
|||
let t = enum all
|
||||
end
|
||||
|
||||
module type S = sig
|
||||
type 'a field
|
||||
|
||||
type t =
|
||||
{ display : Display.t
|
||||
{ display : Display.t field
|
||||
; concurrency : int field
|
||||
}
|
||||
end
|
||||
|
||||
module rec M : S with type 'a field = 'a = M
|
||||
include M
|
||||
|
||||
module rec Partial : S with type 'a field := 'a option = Partial
|
||||
|
||||
let merge t (partial : Partial.t) =
|
||||
let field from_t from_partial =
|
||||
Option.value from_partial ~default:from_t
|
||||
in
|
||||
{ display = field t.display partial.display
|
||||
; concurrency = field t.concurrency partial.concurrency
|
||||
}
|
||||
|
||||
let default =
|
||||
{ display = Progress
|
||||
; concurrency = 4
|
||||
}
|
||||
|
||||
let t =
|
||||
record
|
||||
(field "display" Display.t >>= fun display ->
|
||||
return { display })
|
||||
(field "display" Display.t ~default:default.display
|
||||
>>= fun display ->
|
||||
field "jobs" int ~default:default.concurrency
|
||||
>>= fun concurrency ->
|
||||
return { display
|
||||
; concurrency
|
||||
})
|
||||
|
||||
let user_config_file = Filename.concat Xdg.config_dir "dune/config"
|
||||
|
||||
|
|
|
@ -28,12 +28,23 @@ module Display : sig
|
|||
val all : (string * t) list
|
||||
end
|
||||
|
||||
module type S = sig
|
||||
type 'a field
|
||||
|
||||
type t =
|
||||
{ display : Display.t
|
||||
{ display : Display.t field
|
||||
; concurrency : int field
|
||||
}
|
||||
end
|
||||
|
||||
include S with type 'a field = 'a
|
||||
|
||||
module Partial : S with type 'a field := 'a option
|
||||
|
||||
val t : t Sexp.Of_sexp.t
|
||||
|
||||
val merge : t -> Partial.t -> t
|
||||
|
||||
val default : t
|
||||
val user_config_file : string
|
||||
val load_user_config_file : unit -> t
|
||||
|
|
13
src/main.ml
13
src/main.ml
|
@ -126,19 +126,22 @@ let bootstrap () =
|
|||
fun s ->
|
||||
display := Some (List.assoc s Config.Display.all))
|
||||
in
|
||||
let concurrency = ref None in
|
||||
let set r x = r := Some x in
|
||||
Arg.parse
|
||||
[ "-j" , Set_int Clflags.concurrency, "JOBS concurrency"
|
||||
[ "-j" , Int (set concurrency), "JOBS concurrency"
|
||||
; "--dev" , Set Clflags.dev_mode , " set development mode"
|
||||
; "--display" , display_mode , " print detailed information about commands being run"
|
||||
; "--display" , display_mode , " set the display mode"
|
||||
; "--subst" , Unit subst , " substitute watermarks in source files"
|
||||
]
|
||||
anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:";
|
||||
Clflags.debug_dep_path := true;
|
||||
let config = Config.load_user_config_file () in
|
||||
let config =
|
||||
match !display with
|
||||
| None -> config
|
||||
| Some display -> { display }
|
||||
Config.merge config
|
||||
{ display = !display
|
||||
; concurrency = !concurrency
|
||||
}
|
||||
in
|
||||
let log = Log.create ~display:config.display () in
|
||||
Scheduler.go ~log ~config
|
||||
|
|
|
@ -61,6 +61,8 @@ type t =
|
|||
{ log : Log.t
|
||||
; original_cwd : string
|
||||
; display : Config.Display.t
|
||||
; concurrency : int
|
||||
; waiting_for_available_job : t Fiber.Ivar.t Queue.t
|
||||
; mutable status_line : string
|
||||
; mutable gen_status_line : unit -> string option
|
||||
}
|
||||
|
@ -92,13 +94,13 @@ let set_status_line_generator f =
|
|||
Fiber.Var.get_exn t_var >>| fun t ->
|
||||
t.gen_status_line <- f
|
||||
|
||||
let waiting_for_available_job = Queue.create ()
|
||||
let wait_for_available_job () =
|
||||
if Running_jobs.count () < !Clflags.concurrency then
|
||||
Fiber.Var.get_exn t_var
|
||||
Fiber.Var.get_exn t_var >>= fun t ->
|
||||
if Running_jobs.count () < t.concurrency then
|
||||
Fiber.return t
|
||||
else begin
|
||||
let ivar = Fiber.Ivar.create () in
|
||||
Queue.push ivar waiting_for_available_job;
|
||||
Queue.push ivar t.waiting_for_available_job;
|
||||
Fiber.Ivar.read ivar
|
||||
end
|
||||
|
||||
|
@ -128,8 +130,8 @@ let rec go_rec t =
|
|||
t.status_line <- status_line;
|
||||
end;
|
||||
let job, status = Running_jobs.wait () in
|
||||
(if not (Queue.is_empty waiting_for_available_job) then
|
||||
Fiber.Ivar.fill (Queue.pop waiting_for_available_job) t
|
||||
(if not (Queue.is_empty t.waiting_for_available_job) then
|
||||
Fiber.Ivar.fill (Queue.pop t.waiting_for_available_job) t
|
||||
else
|
||||
Fiber.return ())
|
||||
>>= fun () ->
|
||||
|
@ -150,7 +152,9 @@ let go ?(log=Log.no_log) ?(config=Config.default)
|
|||
; gen_status_line
|
||||
; original_cwd = cwd
|
||||
; display = config.display
|
||||
; concurrency = config.concurrency
|
||||
; status_line = ""
|
||||
; waiting_for_available_job = Queue.create ()
|
||||
}
|
||||
in
|
||||
printer := { print = fun fmt -> print t fmt };
|
||||
|
|
Loading…
Reference in New Issue