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
|
||||
|
||||
default: boot.exe
|
||||
./boot.exe -j 4
|
||||
./boot.exe -j 4 --dev
|
||||
|
||||
boot.exe: bootstrap.ml
|
||||
ocaml bootstrap.ml
|
||||
|
|
17
bin/main.ml
17
bin/main.ml
|
@ -47,13 +47,15 @@ type common =
|
|||
; debug_rules: bool
|
||||
; debug_dep_path: bool
|
||||
; debug_findlib: bool
|
||||
; dev_mode: bool
|
||||
}
|
||||
|
||||
let set_common c =
|
||||
Clflags.concurrency := c.concurrency;
|
||||
Clflags.debug_rules := c.debug_rules;
|
||||
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 help_secs =
|
||||
|
@ -66,15 +68,22 @@ let help_secs =
|
|||
]
|
||||
|
||||
let common =
|
||||
let make concurrency debug_rules debug_dep_path debug_findlib =
|
||||
{ concurrency ; debug_rules ; debug_dep_path ; debug_findlib } in
|
||||
let make concurrency debug_rules debug_dep_path debug_findlib dev_mode =
|
||||
{ concurrency
|
||||
; debug_rules
|
||||
; debug_dep_path
|
||||
; debug_findlib
|
||||
; dev_mode
|
||||
}
|
||||
in
|
||||
let docs = copts_sect in
|
||||
let concurrency =
|
||||
Arg.(value & opt int !Clflags.concurrency & info ["j"] ~docs) in
|
||||
let drules = Arg.(value & flag & info ["drules"] ~docs) in
|
||||
let ddep_path = Arg.(value & flag & info ["ddep-path"] ~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 =
|
||||
Future.Scheduler.go ~log:(create_log ())
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
open Import
|
||||
open! Import
|
||||
|
||||
module Target : sig
|
||||
type t =
|
||||
|
|
|
@ -6,3 +6,4 @@ let debug_run = ref true
|
|||
let debug_findlib = ref false
|
||||
let warnings = ref "-40"
|
||||
let debug_dep_path = ref false
|
||||
let dev_mode = ref false
|
||||
|
|
|
@ -23,3 +23,6 @@ val debug_findlib : bool ref
|
|||
|
||||
(** Compiler warnings *)
|
||||
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")
|
||||
|
||||
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 len = String.length s in
|
||||
if len = 0 then
|
||||
|
@ -247,15 +241,6 @@ module Scheduler = struct
|
|||
| None -> 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 =
|
||||
{ id : int
|
||||
; job : job
|
||||
|
@ -322,7 +307,7 @@ module Scheduler = struct
|
|||
Hashtbl.fold running ~init:[] ~f:(fun ~key:pid ~data:job acc ->
|
||||
let pid, status = Unix.waitpid [WNOHANG] pid in
|
||||
if pid <> 0 then begin
|
||||
(pid, job, status) :: acc
|
||||
(job, status) :: acc
|
||||
end else
|
||||
acc)
|
||||
in
|
||||
|
@ -331,7 +316,7 @@ module Scheduler = struct
|
|||
Unix.sleepf 0.001;
|
||||
wait_win32 ()
|
||||
| _ ->
|
||||
List.iter finished ~f:(fun (pid, job, status) ->
|
||||
List.iter finished ~f:(fun (job, status) ->
|
||||
process_done job status)
|
||||
|
||||
let () =
|
||||
|
|
|
@ -2,8 +2,6 @@ open Import
|
|||
open Jbuild_types
|
||||
open Build.O
|
||||
|
||||
module BS = Build_system
|
||||
|
||||
(* +-----------------------------------------------------------------+
|
||||
| Utils |
|
||||
+-----------------------------------------------------------------+ *)
|
||||
|
@ -15,10 +13,33 @@ let g () =
|
|||
[]
|
||||
|
||||
module Ocaml_flags = struct
|
||||
let default_ocamlc_flags = g ()
|
||||
let default_ocamlopt_flags = g ()
|
||||
let default_ocamlc_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 =
|
||||
{ common : string list
|
||||
|
@ -27,10 +48,10 @@ module Ocaml_flags = struct
|
|||
|
||||
let make { Buildable. flags; ocamlc_flags; ocamlopt_flags; _ } =
|
||||
let eval = Ordered_set_lang.eval_with_standard in
|
||||
{ common = eval flags ~standard:default_flags
|
||||
{ common = eval flags ~standard:(default_flags ())
|
||||
; specific =
|
||||
{ byte = eval ocamlc_flags ~standard:default_ocamlc_flags
|
||||
; native = eval ocamlopt_flags ~standard:default_ocamlopt_flags
|
||||
{ byte = eval ocamlc_flags ~standard:(default_ocamlc_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 default = make (Sexp.Of_sexp.record Buildable.v1 (List []))
|
||||
let default () =
|
||||
{ common = default_flags ()
|
||||
; specific =
|
||||
{ byte = default_ocamlc_flags ()
|
||||
; native = default_ocamlopt_flags ()
|
||||
}
|
||||
}
|
||||
end
|
||||
|
||||
let default_c_flags = g ()
|
||||
|
@ -978,7 +1005,7 @@ module Gen(P : Params) = struct
|
|||
|
||||
build_modules ~flags ~dir ~dep_graph ~modules ~requires ~alias_module;
|
||||
Option.iter alias_module ~f:(fun m ->
|
||||
let flags = Ocaml_flags.default in
|
||||
let flags = Ocaml_flags.default () in
|
||||
build_module m
|
||||
~flags:{ flags with common = "-w" :: "-49" :: flags.common }
|
||||
~dir
|
||||
|
|
|
@ -12,7 +12,7 @@ let load ~dir ~visible_packages ~version =
|
|||
let version, stanzas =
|
||||
Sexp_load.many (Path.relative dir "jbuild" |> Path.to_string)
|
||||
(fun sexps ->
|
||||
let versions, stanzas =
|
||||
let versions, sexps =
|
||||
List.partition_map sexps ~f:(function
|
||||
| List [Atom ("jbuilder_version" | "Jbuilder_version"); ver] as sexp ->
|
||||
Inl (Jbuilder_version.t ver, sexp)
|
||||
|
|
|
@ -840,7 +840,7 @@ module Stanza = struct
|
|||
match String_map.keys visible_packages with
|
||||
| [pkg] -> pkg
|
||||
| [] -> error "no packages are defined here"
|
||||
| pkgs ->
|
||||
| _ :: _ :: _ ->
|
||||
error "there is more than one package visible here:\n\
|
||||
%s\n\
|
||||
You need to add a (package ...) field in your (install ...) stanzas"
|
||||
|
|
|
@ -97,8 +97,11 @@ let bootstrap () =
|
|||
let pkg = "jbuilder" in
|
||||
let main () =
|
||||
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" ]
|
||||
anon "Usage: boot.exe [-j JOBS]\nOptions are:";
|
||||
Arg.parse
|
||||
[ "-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 ())
|
||||
(setup () >>= fun { build_system = bs; _ } ->
|
||||
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 =
|
||||
match Name_map.find name state.unparsed with
|
||||
| Some { value = Some value } ->
|
||||
| Some { value = Some value; _ } ->
|
||||
(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)
|
||||
| None ->
|
||||
match default with
|
||||
|
@ -197,17 +197,17 @@ module Of_sexp = struct
|
|||
|
||||
let field_o name value_of_sexp state =
|
||||
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 = None } ->
|
||||
| Some { value = None; _ } ->
|
||||
of_sexp_error state.record (Printf.sprintf "field %s needs a value" name)
|
||||
| None -> (None, add_known name state)
|
||||
|
||||
let field_b name state =
|
||||
match Name_map.find name state.unparsed with
|
||||
| Some { value = Some value } ->
|
||||
| Some { value = Some value; _ } ->
|
||||
(bool value, consume name state)
|
||||
| Some { value = None } ->
|
||||
| Some { value = None; _ } ->
|
||||
(true, consume name state)
|
||||
| None ->
|
||||
(false, add_known name state)
|
||||
|
@ -273,8 +273,6 @@ module Of_sexp = struct
|
|||
; args : ('a, 'b) Constructor_args_spec.t
|
||||
; make : 'a
|
||||
} -> 'b t
|
||||
|
||||
let name (T t) = t.name
|
||||
end
|
||||
|
||||
let cstr name args make =
|
||||
|
|
Loading…
Reference in New Issue