Refactoring

- add Super_context.resolve_program and use it everywhere.
- add src/js_of_ocaml.mli

CHANGES.org

@@ -1,6 +1,7 @@
 * next
 
 - Add support for building Reason projects (Rudi Grinberg, #58)
+
 - Add support for building javascript with js_of_ocaml (Hugo Heuzard, #60)
 
 - Hint for mistyped targets. Only suggest correction on the basename

doc/manual.org

@@ -940,14 +940,17 @@ as follows:
 #+end_src
 
 ***** Js_of_ocaml
+
 In =library= and =executables= stanzas, you can specify Js_of_ocaml
 options using =(js_of_ocaml (<js_of_ocaml-options>))=.
 
 =<js_of_ocaml-options>= are all optional:
+
 - =(flags <flags>)= to specify flags passed to =js_of_ocaml=
+
 - =(javascript_files (<files-list>))= to specify js_of_ocaml
   JavaScript runtime files.
-  
+
 =<flags>= is specified in the [[Ordered set language][ordered set language]].
 
 The default value for =(flags ...)= depends on whether =--dev= is passed to

src/artifacts.ml

@@ -43,20 +43,38 @@ let create context stanzas =
   ; local_libs
   }
 
-let binary t name =
-  if String_set.mem name t.local_bins then
-    Ok (Path.relative (Config.local_install_bin_dir ~context:t.context.name) name)
-  else
-    match String_map.find name t.provides with
-    | Some p -> Ok p
-    | None ->
-      match Context.which t.context name with
+let binary t ?hint ?(in_the_tree=true) name =
+  if not (Filename.is_relative name) then
+    Ok (Path.absolute name)
+  else if in_the_tree then begin
+    if String_set.mem name t.local_bins then
+      Ok (Path.relative (Config.local_install_bin_dir ~context:t.context.name) name)
+    else
+      match String_map.find name t.provides with
       | Some p -> Ok p
       | None ->
-        Error
-          { fail = fun () ->
-              die "Program %s not found in the tree or in the PATH" name
-          }
+        match Context.which t.context name with
+        | Some p -> Ok p
+        | None ->
+          Error
+            { fail = fun () ->
+                Utils.program_not_found name
+                  ~context:t.context.name
+                  ?hint
+                  ~in_the_tree:true
+            }
+  end else begin
+    match Context.which t.context name with
+    | Some p -> Ok p
+    | None ->
+      Error
+        { fail = fun () ->
+            Utils.program_not_found name
+              ~context:t.context.name
+              ?hint
+              ~in_the_tree:false
+        }
+  end
 
 let file_of_lib ?(use_provides=false) t ~from ~lib ~file =
   match String_map.find lib t.local_libs with

src/artifacts.mli

@@ -4,8 +4,17 @@ type t
 
 val create : Context.t -> (Path.t * Jbuild_types.Stanza.t list) list -> t
 
-(** A named artifact that is looked up in the PATH if not found in the tree *)
-val binary : t -> string -> (Path.t, fail) result
+(** A named artifact that is looked up in the PATH if not found in the tree or
+    [in_the_tree] is [false].
+
+    If the name is an absolute path, it is used as it.
+*)
+val binary
+  :  t
+  -> ?hint:string
+  -> ?in_the_tree:bool (* default true *)
+  -> string
+  -> (Path.t, fail) result
 
 (** [file_of_lib ?use_provides t ~from name] a named artifact that is looked up in the
     given library.

src/build.ml

@@ -10,14 +10,6 @@ module Prog_spec = struct
   type 'a t =
     | Dep of Path.t
     | Dyn of ('a -> Path.t)
-
-  let of_prog_name ctx s =
-    if Filename.is_relative s then
-      Dep (Path.absolute s)
-    else
-      match Context.which ctx s with
-      | Some path -> Dep path
-      | None -> Dyn (fun _ -> Utils.program_not_found s)
 end
 
 type lib_dep_kind =

src/build.mli

@@ -53,8 +53,6 @@ module Prog_spec : sig
   type 'a t =
     | Dep of Path.t
     | Dyn of ('a -> Path.t)
-
-  val of_prog_name : Context.t -> string -> 'a t
 end
 
 val run

src/gen_rules.ml

@@ -147,7 +147,9 @@ module Gen(P : Params) = struct
          (* We have to execute the rule in the library directory as the .o is produced in
             the current directory *)
          ~dir
-         (Build.Prog_spec.of_prog_name ctx ctx.c_compiler)
+         (SC.resolve_program sctx ctx.c_compiler
+            (* The C compiler surely is not in the tree *)
+            ~in_the_tree:false)
          [ S [A "-I"; Path ctx.stdlib_dir]
          ; expand_includes ~dir lib.includes
          ; As (SC.cxx_flags sctx)
@@ -328,7 +330,7 @@ module Gen(P : Params) = struct
     (* Build *.cma.js *)
     SC.add_rules sctx (
       let src = lib_archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in
-      Js_of_ocaml_rules.build_cm ~sctx ~dir ~js_of_ocaml:lib.js_of_ocaml ~src);
+      Js_of_ocaml_rules.build_cm sctx ~dir ~js_of_ocaml:lib.js_of_ocaml ~src);
 
     if ctx.natdynlink_supported then
       Option.iter ctx.ocamlopt ~f:(fun ocamlopt ->
@@ -404,7 +406,7 @@ module Gen(P : Params) = struct
          ; Dyn (fun (_, cm_files) -> Deps cm_files)
          ]);
     if mode = Mode.Byte then
-      let rules = Js_of_ocaml_rules.build_exe ~sctx ~dir ~js_of_ocaml ~src:exe in
+      let rules = Js_of_ocaml_rules.build_exe sctx ~dir ~js_of_ocaml ~src:exe in
       SC.add_rules sctx (List.map rules ~f:(fun r -> libs_and_cm >>> r))
 
   let executables_rules (exes : Executables.t) ~dir ~all_modules =
@@ -611,7 +613,9 @@ module Gen(P : Params) = struct
     |> Merlin.add_rules sctx ~dir:ctx_dir
 
   let () = List.iter (SC.stanzas sctx) ~f:rules
-  let () = SC.add_rules sctx (Js_of_ocaml_rules.setup_findlib ~sctx)
+  let () =
+    SC.add_rules sctx (Js_of_ocaml_rules.setup_separate_compilation_rules sctx)
+
   (* +-----------------------------------------------------------------+
      | META                                                            |
      +-----------------------------------------------------------------+ *)

src/js_of_ocaml_rules.ml

@@ -1,8 +1,10 @@
 open Import
-module C = Super_context
+
+module SC = Super_context
+
 let separate_compilation_enabled () = !Clflags.dev_mode
 
-let pretty () = if !Clflags.dev_mode then ["--pretty"] else []
+let pretty    () = if !Clflags.dev_mode then ["--pretty"           ] else []
 let sourcemap () = if !Clflags.dev_mode then ["--source-map-inline"] else []
 
 let standard () = pretty () @ sourcemap ()
@@ -15,25 +17,20 @@ let in_build_dir ~ctx =
 
 let runtime_file ~sctx ~dir fname =
   let _lib, file =
-    Artifacts.file_of_lib (C.artifacts sctx) ~from:dir ~use_provides:false
+    Artifacts.file_of_lib (SC.artifacts sctx) ~from:dir ~use_provides:false
       (sprintf "js_of_ocaml-compiler:%s" fname)
   in
   match file with
   | Error _ ->
     Arg_spec.Dyn (fun _ ->
-      Utils.library_not_found ~context:(C.context sctx).name ~hint:install_jsoo_hint "js_of_ocaml-compiler")
+      Utils.library_not_found ~context:(SC.context sctx).name ~hint:install_jsoo_hint
+        "js_of_ocaml-compiler")
   | Ok f -> Arg_spec.Dep f
 
-let prog_spec ~sctx ~hint bin =  match Artifacts.binary (C.artifacts sctx) bin with
-  | Error _ ->
-    Build.Prog_spec.Dyn (fun _ ->
-      Utils.program_not_found ~context:(C.context sctx).name ~hint bin)
-  | Ok p -> Build.Prog_spec.Dep p
-
 let js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target =
-  let jsoo = prog_spec ~sctx ~hint:install_jsoo_hint "js_of_ocaml" in
+  let jsoo = SC.resolve_program sctx ~hint:install_jsoo_hint "js_of_ocaml" in
   let runtime = runtime_file ~sctx ~dir "runtime.js" in
-  Build.run ~context:(C.context sctx) ~dir
+  Build.run ~context:(SC.context sctx) ~dir
     jsoo
     [ Arg_spec.As flags
     ; Arg_spec.A "-o"; Target target
@@ -64,7 +61,7 @@ let exe_rule ~sctx ~dir ~flags ~javascript_files ~src ~target =
   js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target
 
 let link_rule ~sctx ~dir ~runtime ~target =
-  let ctx = C.context sctx in
+  let ctx = SC.context sctx in
   let get_all (libs,cm) =
     (* Special case for the stdlib because it is not referenced in the META *)
     let stdlib = Lib.External (Findlib.stdlib_with_archives ctx.findlib) in
@@ -77,11 +74,13 @@ let link_rule ~sctx ~dir ~runtime ~target =
           [ Path.relative dir (sprintf "%s.cma.js" lib.name) ]
       )
     in
-    let all_other_modules = List.map cm ~f:(fun m -> Path.extend_basename m ~suffix:".js") in
+    let all_other_modules =
+      List.map cm ~f:(fun m -> Path.extend_basename m ~suffix:".js")
+    in
     Arg_spec.Deps (List.concat [all_libs;all_other_modules])
   in
-  let jsoo_link = prog_spec ~sctx ~hint:install_jsoo_hint "jsoo_link" in
-  Build.run ~context:(C.context sctx) ~dir
+  let jsoo_link = SC.resolve_program sctx ~hint:install_jsoo_hint "jsoo_link" in
+  Build.run ~context:(SC.context sctx) ~dir
     jsoo_link
     [ Arg_spec.A "-o"; Target target
     ; Arg_spec.Dep runtime
@@ -89,7 +88,7 @@ let link_rule ~sctx ~dir ~runtime ~target =
     ; Arg_spec.Dyn get_all
     ]
 
-let build_cm ~sctx ~dir ~js_of_ocaml ~src =
+let build_cm sctx ~dir ~js_of_ocaml ~src =
   if separate_compilation_enabled ()
   then let target = Path.extend_basename src ~suffix:".js" in
     let spec = Arg_spec.Dep src in
@@ -101,10 +100,10 @@ let build_cm ~sctx ~dir ~js_of_ocaml ~src =
     [ js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target ]
   else []
 
-let setup_findlib ~sctx =
+let setup_separate_compilation_rules sctx =
   if separate_compilation_enabled ()
   then
-    let ctx = C.context sctx in
+    let ctx = SC.context sctx in
     let all_pkg =
       List.map
         (Findlib.all_packages ctx.findlib)
@@ -130,7 +129,7 @@ let setup_findlib ~sctx =
         ))
   else []
 
-let build_exe ~sctx ~dir ~js_of_ocaml ~src =
+let build_exe sctx ~dir ~js_of_ocaml ~src =
   let {Jbuild_types.Js_of_ocaml.javascript_files; flags} = js_of_ocaml in
   let javascript_files = List.map javascript_files ~f:(Path.relative dir) in
   let mk_target ext = Path.extend_basename src ~suffix:ext in
@@ -138,7 +137,8 @@ let build_exe ~sctx ~dir ~js_of_ocaml ~src =
   let standalone_runtime = mk_target ".runtime.js" in
   if separate_compilation_enabled () then
     [ link_rule ~sctx ~dir ~runtime:standalone_runtime ~target
-    ; standalone_runtime_rule ~sctx ~dir ~flags ~javascript_files ~target:standalone_runtime
+    ; standalone_runtime_rule ~sctx ~dir ~flags ~javascript_files
+        ~target:standalone_runtime
     ]
   else
     [ exe_rule ~sctx ~dir ~flags ~javascript_files ~src ~target ]

src/js_of_ocaml_rules.mli

@@ -0,0 +1,23 @@
+(** Generate rules for js_of_ocaml *)
+
+open Jbuild_types
+
+val build_cm
+  :  Super_context.t
+  -> dir:Path.t
+  -> js_of_ocaml:Js_of_ocaml.t
+  -> src:Path.t
+  -> (unit, Action.t) Build.t list
+
+val build_exe
+  :  Super_context.t
+  -> dir:Path.t
+  -> js_of_ocaml:Js_of_ocaml.t
+  -> src:Path.t
+  -> (Lib.t list * Path.t list, Action.t) Build.t list
+
+val setup_separate_compilation_rules
+  :  Super_context.t
+  -> (unit, Action.t) Build.t list
+
+

src/module_compilation.ml

@@ -99,7 +99,7 @@ let build_module sctx ?sandbox ~dynlink ~js_of_ocaml ~flags m ~dir ~dep_graph ~m
       ~alias_module);
   (* Build *.cmo.js *)
   let src = Module.cm_file m ~dir Cm_kind.Cmo in
-  SC.add_rules sctx (Js_of_ocaml_rules.build_cm ~sctx ~dir ~js_of_ocaml ~src)
+  SC.add_rules sctx (Js_of_ocaml_rules.build_cm sctx ~dir ~js_of_ocaml ~src)
 
 let build_modules sctx ~dynlink ~js_of_ocaml ~flags ~dir ~dep_graph ~modules ~requires ~alias_module =
   String_map.iter

src/super_context.ml

@@ -44,6 +44,11 @@ let expand_vars t ~dir s =
   | "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir)
   | var -> String_map.find var t.vars)
 
+let resolve_program t ?hint ?(in_the_tree=true) bin =
+  match Artifacts.binary t.artifacts ?hint ~in_the_tree bin with
+  | Error fail -> Build.Prog_spec.Dyn (fun _ -> fail.fail ())
+  | Ok    path -> Build.Prog_spec.Dep path
+
 let create
       ~(context:Context.t)
       ~aliases
@@ -598,12 +603,7 @@ module PP = struct
      a new module with only OCaml sources *)
   let setup_reason_rules sctx ~dir (m : Module.t) =
     let ctx = sctx.context in
-    let refmt =
-      match Artifacts.binary (artifacts sctx) "refmt" with
-      | Error _ ->
-        Build.Prog_spec.Dyn (fun _ ->
-          Utils.program_not_found ~context:ctx.name ~hint:"opam install reason" "refmt")
-      | Ok p -> Build.Prog_spec.Dep p in
+    let refmt = resolve_program sctx "refmt" ~hint:"opam install reason" in
     let rule src target =
       let src_path = Path.relative dir src in
       Build.run ~context:ctx refmt

src/super_context.mli

@@ -47,6 +47,20 @@ val rules : t -> Build_interpret.Rule.t list
 
 val sources_and_targets_known_so_far : t -> src_path:Path.t -> String_set.t
 
+(** [prog_spec t ?hint ?in_the_tree name] resolve a program. If [in_the_tree] is [true]
+    (the default), [name] is looked up in the workspace. Otherwise, or if it is not found
+    in the tree is is looked up in the PATH. If it is not found at all, the resulting
+    [Prog_spec.t] will fail when evaluated.
+
+    [hint] should tell the user what to install when the program is not found.
+*)
+val resolve_program
+  :  t
+  -> ?hint:string
+  -> ?in_the_tree:bool (* default true *)
+  -> string
+  -> _ Build.Prog_spec.t
+
 module Libs : sig
   val find : t -> from:Path.t -> string -> Lib.t option
 

src/utils.ml

@@ -80,8 +80,12 @@ let describe_target fn =
   | _ ->
     Path.to_string fn
 
-let program_not_found ?context ?hint prog =
-  die "@{<error>Error@}: Program %s not found in PATH%s%a" prog
+let program_not_found ?context ?(in_the_tree=false) ?hint prog =
+  die "@{<error>Error@}: Program %s not found in%s PATH%s%a" prog
+    (if in_the_tree then
+       " the tree or in"
+     else
+       "")
     (match context with
      | None -> ""
      | Some name -> sprintf " (context: %s)" name)

src/utils.mli

@@ -18,8 +18,14 @@ val jbuild_name_in : dir:Path.t -> string
 (** Nice description of a target *)
 val describe_target : Path.t -> string
 
-(** Raise an error about a program not found in the PATH *)
-val program_not_found : ?context:string -> ?hint:string -> string -> _
+(** Raise an error about a program not found in the PATH. If [in_the_tree] is [true], then
+    assume that the program was looked up in the tree as well. *)
+val program_not_found
+  :  ?context:string
+  -> ?in_the_tree:bool (** default: false *)
+  -> ?hint:string
+  -> string
+  -> _
 
 (** Raise an error about a library not found *)
 val library_not_found : ?context:string -> ?hint:string -> string -> _