Add a development mode and cleanup the code

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

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 ())

src/build_interpret.mli

@@ -1,4 +1,4 @@
-open Import
+open! Import
 
 module Target : sig
   type t =

src/clflags.ml

@@ -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

src/clflags.mli

@@ -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

src/future.ml

@@ -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 () =

src/gen_rules.ml

@@ -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

src/jbuild_load.ml

@@ -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)

src/jbuild_types.ml

@@ -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"

src/main.ml

@@ -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")])

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 =