Add a development mode and cleanup the code
This commit is contained in:
parent
4f161894ff
commit
9c6e367089
2
Makefile
2
Makefile
|
@ -1,7 +1,7 @@
|
||||||
NAME := jbuilder
|
NAME := jbuilder
|
||||||
|
|
||||||
default: boot.exe
|
default: boot.exe
|
||||||
./boot.exe -j 4
|
./boot.exe -j 4 --dev
|
||||||
|
|
||||||
boot.exe: bootstrap.ml
|
boot.exe: bootstrap.ml
|
||||||
ocaml bootstrap.ml
|
ocaml bootstrap.ml
|
||||||
|
|
17
bin/main.ml
17
bin/main.ml
|
@ -47,13 +47,15 @@ type common =
|
||||||
; debug_rules: bool
|
; debug_rules: bool
|
||||||
; debug_dep_path: bool
|
; debug_dep_path: bool
|
||||||
; debug_findlib: bool
|
; debug_findlib: bool
|
||||||
|
; dev_mode: bool
|
||||||
}
|
}
|
||||||
|
|
||||||
let set_common c =
|
let set_common c =
|
||||||
Clflags.concurrency := c.concurrency;
|
Clflags.concurrency := c.concurrency;
|
||||||
Clflags.debug_rules := c.debug_rules;
|
Clflags.debug_rules := c.debug_rules;
|
||||||
Clflags.debug_dep_path := c.debug_dep_path;
|
Clflags.debug_dep_path := c.debug_dep_path;
|
||||||
Clflags.debug_findlib := c.debug_findlib
|
Clflags.debug_findlib := c.debug_findlib;
|
||||||
|
Clflags.dev_mode := c.dev_mode
|
||||||
|
|
||||||
let copts_sect = "COMMON OPTIONS"
|
let copts_sect = "COMMON OPTIONS"
|
||||||
let help_secs =
|
let help_secs =
|
||||||
|
@ -66,15 +68,22 @@ let help_secs =
|
||||||
]
|
]
|
||||||
|
|
||||||
let common =
|
let common =
|
||||||
let make concurrency debug_rules debug_dep_path debug_findlib =
|
let make concurrency debug_rules debug_dep_path debug_findlib dev_mode =
|
||||||
{ concurrency ; debug_rules ; debug_dep_path ; debug_findlib } in
|
{ concurrency
|
||||||
|
; debug_rules
|
||||||
|
; debug_dep_path
|
||||||
|
; debug_findlib
|
||||||
|
; dev_mode
|
||||||
|
}
|
||||||
|
in
|
||||||
let docs = copts_sect in
|
let docs = copts_sect in
|
||||||
let concurrency =
|
let concurrency =
|
||||||
Arg.(value & opt int !Clflags.concurrency & info ["j"] ~docs) in
|
Arg.(value & opt int !Clflags.concurrency & info ["j"] ~docs) in
|
||||||
let drules = Arg.(value & flag & info ["drules"] ~docs) in
|
let drules = Arg.(value & flag & info ["drules"] ~docs) in
|
||||||
let ddep_path = Arg.(value & flag & info ["ddep-path"] ~docs) in
|
let ddep_path = Arg.(value & flag & info ["ddep-path"] ~docs) in
|
||||||
let dfindlib = Arg.(value & flag & info ["dfindlib"] ~docs) in
|
let dfindlib = Arg.(value & flag & info ["dfindlib"] ~docs) in
|
||||||
Term.(const make $ concurrency $ drules $ ddep_path $ dfindlib)
|
let dev = Arg.(value & flag & info ["dev"] ~docs) in
|
||||||
|
Term.(const make $ concurrency $ drules $ ddep_path $ dfindlib $ dev)
|
||||||
|
|
||||||
let build_package pkg =
|
let build_package pkg =
|
||||||
Future.Scheduler.go ~log:(create_log ())
|
Future.Scheduler.go ~log:(create_log ())
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
open Import
|
open! Import
|
||||||
|
|
||||||
module Target : sig
|
module Target : sig
|
||||||
type t =
|
type t =
|
||||||
|
|
|
@ -6,3 +6,4 @@ let debug_run = ref true
|
||||||
let debug_findlib = ref false
|
let debug_findlib = ref false
|
||||||
let warnings = ref "-40"
|
let warnings = ref "-40"
|
||||||
let debug_dep_path = ref false
|
let debug_dep_path = ref false
|
||||||
|
let dev_mode = ref false
|
||||||
|
|
|
@ -23,3 +23,6 @@ val debug_findlib : bool ref
|
||||||
|
|
||||||
(** Compiler warnings *)
|
(** Compiler warnings *)
|
||||||
val warnings : string ref
|
val warnings : string ref
|
||||||
|
|
||||||
|
(** Whether we are compiling with extra warnings *)
|
||||||
|
val dev_mode : bool ref
|
||||||
|
|
|
@ -192,12 +192,6 @@ let run_capture_line ?dir ?env prog args =
|
||||||
cmdline (String.concat l ~sep:"\n")
|
cmdline (String.concat l ~sep:"\n")
|
||||||
|
|
||||||
module Scheduler = struct
|
module Scheduler = struct
|
||||||
let key_for_color prog =
|
|
||||||
let s = Filename.basename prog in
|
|
||||||
match String.lsplit2 s ~on:'.' with
|
|
||||||
| None -> s
|
|
||||||
| Some (s, _) -> s
|
|
||||||
|
|
||||||
let colorize_prog s =
|
let colorize_prog s =
|
||||||
let len = String.length s in
|
let len = String.length s in
|
||||||
if len = 0 then
|
if len = 0 then
|
||||||
|
@ -247,15 +241,6 @@ module Scheduler = struct
|
||||||
| None -> s
|
| None -> s
|
||||||
| Some dir -> sprintf "(cd %s && %s)" dir s
|
| Some dir -> sprintf "(cd %s && %s)" dir s
|
||||||
|
|
||||||
let stderr_supports_colors = lazy(
|
|
||||||
not Sys.win32 &&
|
|
||||||
Unix.(isatty stderr) &&
|
|
||||||
match Sys.getenv "TERM" with
|
|
||||||
| exception Not_found -> false
|
|
||||||
| "dumb" -> false
|
|
||||||
| _ -> true
|
|
||||||
)
|
|
||||||
|
|
||||||
type running_job =
|
type running_job =
|
||||||
{ id : int
|
{ id : int
|
||||||
; job : job
|
; job : job
|
||||||
|
@ -322,7 +307,7 @@ module Scheduler = struct
|
||||||
Hashtbl.fold running ~init:[] ~f:(fun ~key:pid ~data:job acc ->
|
Hashtbl.fold running ~init:[] ~f:(fun ~key:pid ~data:job acc ->
|
||||||
let pid, status = Unix.waitpid [WNOHANG] pid in
|
let pid, status = Unix.waitpid [WNOHANG] pid in
|
||||||
if pid <> 0 then begin
|
if pid <> 0 then begin
|
||||||
(pid, job, status) :: acc
|
(job, status) :: acc
|
||||||
end else
|
end else
|
||||||
acc)
|
acc)
|
||||||
in
|
in
|
||||||
|
@ -331,7 +316,7 @@ module Scheduler = struct
|
||||||
Unix.sleepf 0.001;
|
Unix.sleepf 0.001;
|
||||||
wait_win32 ()
|
wait_win32 ()
|
||||||
| _ ->
|
| _ ->
|
||||||
List.iter finished ~f:(fun (pid, job, status) ->
|
List.iter finished ~f:(fun (job, status) ->
|
||||||
process_done job status)
|
process_done job status)
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
|
|
|
@ -2,8 +2,6 @@ open Import
|
||||||
open Jbuild_types
|
open Jbuild_types
|
||||||
open Build.O
|
open Build.O
|
||||||
|
|
||||||
module BS = Build_system
|
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
(* +-----------------------------------------------------------------+
|
||||||
| Utils |
|
| Utils |
|
||||||
+-----------------------------------------------------------------+ *)
|
+-----------------------------------------------------------------+ *)
|
||||||
|
@ -15,10 +13,33 @@ let g () =
|
||||||
[]
|
[]
|
||||||
|
|
||||||
module Ocaml_flags = struct
|
module Ocaml_flags = struct
|
||||||
let default_ocamlc_flags = g ()
|
let default_ocamlc_flags = g
|
||||||
let default_ocamlopt_flags = g ()
|
let default_ocamlopt_flags = g
|
||||||
|
|
||||||
let default_flags = [ "-w"; !Clflags.warnings ]
|
let dev_mode_warnings =
|
||||||
|
"@a" ^
|
||||||
|
String.concat ~sep:""
|
||||||
|
(List.map ~f:(sprintf "-%d")
|
||||||
|
[ 4
|
||||||
|
; 29
|
||||||
|
; 40
|
||||||
|
; 41
|
||||||
|
; 42
|
||||||
|
; 44
|
||||||
|
; 45
|
||||||
|
; 48
|
||||||
|
; 58
|
||||||
|
; 59
|
||||||
|
])
|
||||||
|
|
||||||
|
let default_flags () =
|
||||||
|
if !Clflags.dev_mode then
|
||||||
|
[ "-w"; dev_mode_warnings ^ !Clflags.warnings
|
||||||
|
; "-strict-sequence"
|
||||||
|
; "-strict-formats"
|
||||||
|
]
|
||||||
|
else
|
||||||
|
[ "-w"; !Clflags.warnings ]
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ common : string list
|
{ common : string list
|
||||||
|
@ -27,10 +48,10 @@ module Ocaml_flags = struct
|
||||||
|
|
||||||
let make { Buildable. flags; ocamlc_flags; ocamlopt_flags; _ } =
|
let make { Buildable. flags; ocamlc_flags; ocamlopt_flags; _ } =
|
||||||
let eval = Ordered_set_lang.eval_with_standard in
|
let eval = Ordered_set_lang.eval_with_standard in
|
||||||
{ common = eval flags ~standard:default_flags
|
{ common = eval flags ~standard:(default_flags ())
|
||||||
; specific =
|
; specific =
|
||||||
{ byte = eval ocamlc_flags ~standard:default_ocamlc_flags
|
{ byte = eval ocamlc_flags ~standard:(default_ocamlc_flags ())
|
||||||
; native = eval ocamlopt_flags ~standard:default_ocamlopt_flags
|
; native = eval ocamlopt_flags ~standard:(default_ocamlopt_flags ())
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -38,7 +59,13 @@ module Ocaml_flags = struct
|
||||||
|
|
||||||
let get_for_cm t ~cm_kind = get t (Mode.of_cm_kind cm_kind)
|
let get_for_cm t ~cm_kind = get t (Mode.of_cm_kind cm_kind)
|
||||||
|
|
||||||
let default = make (Sexp.Of_sexp.record Buildable.v1 (List []))
|
let default () =
|
||||||
|
{ common = default_flags ()
|
||||||
|
; specific =
|
||||||
|
{ byte = default_ocamlc_flags ()
|
||||||
|
; native = default_ocamlopt_flags ()
|
||||||
|
}
|
||||||
|
}
|
||||||
end
|
end
|
||||||
|
|
||||||
let default_c_flags = g ()
|
let default_c_flags = g ()
|
||||||
|
@ -978,7 +1005,7 @@ module Gen(P : Params) = struct
|
||||||
|
|
||||||
build_modules ~flags ~dir ~dep_graph ~modules ~requires ~alias_module;
|
build_modules ~flags ~dir ~dep_graph ~modules ~requires ~alias_module;
|
||||||
Option.iter alias_module ~f:(fun m ->
|
Option.iter alias_module ~f:(fun m ->
|
||||||
let flags = Ocaml_flags.default in
|
let flags = Ocaml_flags.default () in
|
||||||
build_module m
|
build_module m
|
||||||
~flags:{ flags with common = "-w" :: "-49" :: flags.common }
|
~flags:{ flags with common = "-w" :: "-49" :: flags.common }
|
||||||
~dir
|
~dir
|
||||||
|
|
|
@ -12,7 +12,7 @@ let load ~dir ~visible_packages ~version =
|
||||||
let version, stanzas =
|
let version, stanzas =
|
||||||
Sexp_load.many (Path.relative dir "jbuild" |> Path.to_string)
|
Sexp_load.many (Path.relative dir "jbuild" |> Path.to_string)
|
||||||
(fun sexps ->
|
(fun sexps ->
|
||||||
let versions, stanzas =
|
let versions, sexps =
|
||||||
List.partition_map sexps ~f:(function
|
List.partition_map sexps ~f:(function
|
||||||
| List [Atom ("jbuilder_version" | "Jbuilder_version"); ver] as sexp ->
|
| List [Atom ("jbuilder_version" | "Jbuilder_version"); ver] as sexp ->
|
||||||
Inl (Jbuilder_version.t ver, sexp)
|
Inl (Jbuilder_version.t ver, sexp)
|
||||||
|
|
|
@ -840,7 +840,7 @@ module Stanza = struct
|
||||||
match String_map.keys visible_packages with
|
match String_map.keys visible_packages with
|
||||||
| [pkg] -> pkg
|
| [pkg] -> pkg
|
||||||
| [] -> error "no packages are defined here"
|
| [] -> error "no packages are defined here"
|
||||||
| pkgs ->
|
| _ :: _ :: _ ->
|
||||||
error "there is more than one package visible here:\n\
|
error "there is more than one package visible here:\n\
|
||||||
%s\n\
|
%s\n\
|
||||||
You need to add a (package ...) field in your (install ...) stanzas"
|
You need to add a (package ...) field in your (install ...) stanzas"
|
||||||
|
|
|
@ -97,8 +97,11 @@ let bootstrap () =
|
||||||
let pkg = "jbuilder" in
|
let pkg = "jbuilder" in
|
||||||
let main () =
|
let main () =
|
||||||
let anon s = raise (Arg.Bad (Printf.sprintf "don't know what to do with %s\n" s)) in
|
let anon s = raise (Arg.Bad (Printf.sprintf "don't know what to do with %s\n" s)) in
|
||||||
Arg.parse [ "-j", Set_int Clflags.concurrency, "JOBS concurrency" ]
|
Arg.parse
|
||||||
anon "Usage: boot.exe [-j JOBS]\nOptions are:";
|
[ "-j" , Set_int Clflags.concurrency, "JOBS concurrency"
|
||||||
|
; "--dev", Set Clflags.dev_mode , " set development mode"
|
||||||
|
]
|
||||||
|
anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:";
|
||||||
Future.Scheduler.go ~log:(create_log ())
|
Future.Scheduler.go ~log:(create_log ())
|
||||||
(setup () >>= fun { build_system = bs; _ } ->
|
(setup () >>= fun { build_system = bs; _ } ->
|
||||||
Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")])
|
Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")])
|
||||||
|
|
14
src/sexp.ml
14
src/sexp.ml
|
@ -185,9 +185,9 @@ module Of_sexp = struct
|
||||||
|
|
||||||
let field name ?default value_of_sexp state =
|
let field name ?default value_of_sexp state =
|
||||||
match Name_map.find name state.unparsed with
|
match Name_map.find name state.unparsed with
|
||||||
| Some { value = Some value } ->
|
| Some { value = Some value; _ } ->
|
||||||
(value_of_sexp value, consume name state)
|
(value_of_sexp value, consume name state)
|
||||||
| Some { value = None } ->
|
| Some { value = None; _ } ->
|
||||||
of_sexp_error state.record (Printf.sprintf "field %s needs a value" name)
|
of_sexp_error state.record (Printf.sprintf "field %s needs a value" name)
|
||||||
| None ->
|
| None ->
|
||||||
match default with
|
match default with
|
||||||
|
@ -197,17 +197,17 @@ module Of_sexp = struct
|
||||||
|
|
||||||
let field_o name value_of_sexp state =
|
let field_o name value_of_sexp state =
|
||||||
match Name_map.find name state.unparsed with
|
match Name_map.find name state.unparsed with
|
||||||
| Some { value = Some value } ->
|
| Some { value = Some value; _ } ->
|
||||||
(Some (value_of_sexp value), consume name state)
|
(Some (value_of_sexp value), consume name state)
|
||||||
| Some { value = None } ->
|
| Some { value = None; _ } ->
|
||||||
of_sexp_error state.record (Printf.sprintf "field %s needs a value" name)
|
of_sexp_error state.record (Printf.sprintf "field %s needs a value" name)
|
||||||
| None -> (None, add_known name state)
|
| None -> (None, add_known name state)
|
||||||
|
|
||||||
let field_b name state =
|
let field_b name state =
|
||||||
match Name_map.find name state.unparsed with
|
match Name_map.find name state.unparsed with
|
||||||
| Some { value = Some value } ->
|
| Some { value = Some value; _ } ->
|
||||||
(bool value, consume name state)
|
(bool value, consume name state)
|
||||||
| Some { value = None } ->
|
| Some { value = None; _ } ->
|
||||||
(true, consume name state)
|
(true, consume name state)
|
||||||
| None ->
|
| None ->
|
||||||
(false, add_known name state)
|
(false, add_known name state)
|
||||||
|
@ -273,8 +273,6 @@ module Of_sexp = struct
|
||||||
; args : ('a, 'b) Constructor_args_spec.t
|
; args : ('a, 'b) Constructor_args_spec.t
|
||||||
; make : 'a
|
; make : 'a
|
||||||
} -> 'b t
|
} -> 'b t
|
||||||
|
|
||||||
let name (T t) = t.name
|
|
||||||
end
|
end
|
||||||
|
|
||||||
let cstr name args make =
|
let cstr name args make =
|
||||||
|
|
Loading…
Reference in New Issue