Small changes stepping towards supporting native compilation

Author: bsansouci

jscomp/bsb/bsb_build_schemas.ml

@@ -68,8 +68,8 @@ let reason = "reason"
 let react_jsx = "react-jsx"
 
 let entries = "entries"
-let kind = "kind"
-let main = "main"
+let backend = "backend"
+let main_module = "main-module"
 let cut_generators = "cut-generators"
 let generators = "generators"
 let command = "command"
@@ -82,4 +82,4 @@ let error = "error"
 let suffix = "suffix"
 let gentypeconfig = "gentypeconfig"
 let path = "path"
-let ignored_dirs = "ignored-dirs"
+let ignored_dirs = "ignored-dirs"

jscomp/bsb/bsb_clean.ml

@@ -29,7 +29,7 @@ let (//) = Ext_path.combine
 let ninja_clean  proj_dir =
   try
     let cmd = Bsb_global_paths.vendor_ninja in
-    let lib_artifacts_dir = Lazy.force Bsb_global_backend.lib_artifacts_dir in
+    let lib_artifacts_dir = !Bsb_global_backend.lib_artifacts_dir in
     let cwd = proj_dir // lib_artifacts_dir in
     if Sys.file_exists cwd then
       let eid =

jscomp/bsb/bsb_config_parse.ml

@@ -30,7 +30,7 @@ let resolve_package cwd  package_name =
   let x =  Bsb_pkg.resolve_bs_package ~cwd package_name  in
   {
     Bsb_config_types.package_name ;
-    package_install_path = x // Bsb_config.lib_ocaml
+    package_install_path = x // !Bsb_global_backend.lib_ocaml_dir
   }
 
 type json_map = Ext_json_types.t Map_string.t
@@ -49,8 +49,8 @@ let extract_main_entries (map :json_map) =
           let kind = ref "js" in
           let main = ref None in
           let _ = map
-                  |? (Bsb_build_schemas.kind, `Str (fun x -> kind := x))
-                  |? (Bsb_build_schemas.main, `Str (fun x -> main := Some x))
+                  |? (Bsb_build_schemas.backend, `Str (fun x -> kind := x))
+                  |? (Bsb_build_schemas.main_module, `Str (fun x -> main := Some x))
           in
           let path = begin match !main with
             (* This is technically optional when compiling to js *)
@@ -74,7 +74,15 @@ let extract_main_entries (map :json_map) =
   begin match Map_string.find_opt map Bsb_build_schemas.entries with
     | Some (Arr {content = s}) -> entries := extract_entries s
     | _ -> ()
-  end; !entries
+  end;
+  if not !Bsb_global_backend.backend_is_set then 
+    begin match !entries with
+      | []
+      | (Bsb_config_types.JsTarget _) :: _       -> Bsb_global_backend.set_backend Bsb_config_types.Js
+      | (Bsb_config_types.NativeTarget _) :: _   -> Bsb_global_backend.set_backend Bsb_config_types.Native
+      | (Bsb_config_types.BytecodeTarget _) :: _ -> Bsb_global_backend.set_backend Bsb_config_types.Bytecode
+    end;
+  !entries
 #else 
 let extract_main_entries (_ :json_map) = []  
 #end
@@ -173,7 +181,7 @@ let check_stdlib (map : json_map) cwd (*built_in_package*) =
         check_version_exit map stdlib_path;
         Some {
             Bsb_config_types.package_name = current_package;
-            package_install_path = stdlib_path // Bsb_config.lib_ocaml;
+            package_install_path = stdlib_path // !Bsb_global_backend.lib_ocaml_dir;
           }
 
       | _ -> assert false 
@@ -403,6 +411,9 @@ let interpret_json
     let refmt = extract_refmt map per_proj_dir in 
     let gentype_config  = extract_gentype_config map per_proj_dir in  
     let bs_suffix = extract_bs_suffix_exn map in   
+    (* This line has to be before any calls to Bsb_global_backend.backend, because it'll read the entries 
+         array from the bsconfig and set the backend_ref to the first entry, if any. *)
+    let entries = extract_main_entries map in
     (* The default situation is empty *)
     let built_in_package = check_stdlib map per_proj_dir in
     let package_specs =     
@@ -470,7 +481,7 @@ let interpret_json
           generate_merlin = 
             extract_boolean map Bsb_build_schemas.generate_merlin true;
           reason_react_jsx  ;  
-          entries = extract_main_entries map;
+          entries;
           generators = extract_generators map ; 
           cut_generators ;
           number_of_dev_groups;   

jscomp/bsb/bsb_global_backend.ml

@@ -22,36 +22,32 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-#if BS_NATIVE then
-let cmdline_backend = ref None
-
-(* If cmdline_backend is set we use it, otherwise we use the first entry's backend. *)
-let backend = lazy
-  begin match !cmdline_backend with
-  | Some cmdline_backend -> cmdline_backend
-  | None -> 
-    let entries = Bsb_config_parse.entries_from_bsconfig Bsb_global_paths.cwd in 
-    let new_cmdline_backend = begin match entries with
-      | []                                       -> Bsb_config_types.Js
-      | (Bsb_config_types.JsTarget _) :: _       -> Bsb_config_types.Js
-      | (Bsb_config_types.NativeTarget _) :: _   -> Bsb_config_types.Native
-      | (Bsb_config_types.BytecodeTarget _) :: _ -> Bsb_config_types.Bytecode
-    end in
-    cmdline_backend := Some (new_cmdline_backend);
-    new_cmdline_backend
-  end
-#else
-let backend = lazy Bsb_config_types.Js
-
-(* No cost of using this variable below when compiled in JS mode. *)
-let cmdline_backend = ref (Some Bsb_config_types.Js)
-#end
+let backend_is_set = ref false
+
+let backend = ref Bsb_config_types.Js
+
+let lib_artifacts_dir = ref Bsb_config.lib_bs
+
+let lib_ocaml_dir = ref Bsb_config.lib_ocaml
+
+let backend_string = ref Literals.js
 
 let (//) = Ext_path.combine
 
-let lib_artifacts_dir = lazy
-  begin match Lazy.force backend with
-  | Bsb_config_types.Js       -> Bsb_config.lib_bs
-  | Bsb_config_types.Native   -> Bsb_config.lib_lit // "native"
-  | Bsb_config_types.Bytecode -> Bsb_config.lib_lit // "bytecode"
-  end
+let set_backend b =
+  backend_is_set := true;
+  backend := b;
+  match b with
+  | Bsb_config_types.Js       -> 
+    lib_artifacts_dir := Bsb_config.lib_bs;
+    lib_ocaml_dir := Bsb_config.lib_ocaml;
+    backend_string := Literals.js;
+  | Bsb_config_types.Native   -> 
+    lib_artifacts_dir := Bsb_config.lib_lit // "bs-native";
+    lib_ocaml_dir := Bsb_config.lib_lit // "ocaml-native";
+    backend_string := Literals.native;
+  | Bsb_config_types.Bytecode -> 
+    lib_artifacts_dir := Bsb_config.lib_lit // "bs-bytecode";
+    lib_ocaml_dir := Bsb_config.lib_lit // "ocaml-bytecode";
+    backend_string := Literals.bytecode;
+

jscomp/bsb/bsb_global_backend.mli

@@ -22,8 +22,21 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-val cmdline_backend : Bsb_config_types.compilation_kind_t option ref
+(* Flag to track whether backend has been set to a value. *)
+val backend_is_set : bool ref
 
-val backend : Bsb_config_types.compilation_kind_t Lazy.t
+(* Target backend *)
+val backend : Bsb_config_types.compilation_kind_t ref
+
+(* path to all intermediate build artifacts, would be lib/bs when compiling to JS *)
+val lib_artifacts_dir : string ref
+
+(* path to the compiled artifacts, would be lib/ocaml when compiling to JS *)
+val lib_ocaml_dir : string ref
+
+(* string representation of the target backend, would be "js" when compiling to js *)
+val backend_string: string ref
+
+(* convenience setter to update all the refs according to the given target backend *)
+val set_backend : Bsb_config_types.compilation_kind_t -> unit
 
-val lib_artifacts_dir : string Lazy.t

jscomp/bsb/bsb_merlin_gen.ml

@@ -80,7 +80,7 @@ let output_merlin_namespace buffer ns=
   match ns with 
   | None -> ()
   | Some x -> 
-    let lib_artifacts_dir = Lazy.force Bsb_global_backend.lib_artifacts_dir in
+    let lib_artifacts_dir = !Bsb_global_backend.lib_artifacts_dir in
     Buffer.add_string buffer merlin_b ; 
     Buffer.add_string buffer lib_artifacts_dir ; 
     Buffer.add_string buffer merlin_flg ; 
@@ -188,7 +188,7 @@ let merlin_file_gen ~per_proj_dir:(per_proj_dir:string)
         Buffer.add_string buffer merlin_b;
         Buffer.add_string buffer path ;
       );
-    let lib_artifacts_dir = Lazy.force Bsb_global_backend.lib_artifacts_dir in
+    let lib_artifacts_dir = !Bsb_global_backend.lib_artifacts_dir in
     Ext_list.iter res_files.files (fun x -> 
         if not (Bsb_file_groups.is_empty x) then 
           begin

jscomp/bsb/bsb_ninja_check.ml

@@ -95,7 +95,7 @@ let record ~per_proj_dir ~file  (file_or_dirs : string list) : unit =
            (Unix.stat (Filename.concat per_proj_dir  x )).st_mtime
          )
   in 
-  write file
+  write (Ext_string.concat3 file "_" !Bsb_global_backend.backend_string)
     { st_mtimes ;
       dir_or_files;
       source_directory = per_proj_dir ;
@@ -108,7 +108,7 @@ let record ~per_proj_dir ~file  (file_or_dirs : string list) : unit =
     bit in case we found a different version of compiler
 *)
 let check ~(per_proj_dir:string) ~forced ~file : check_result =
-  read file  (fun  {
+  read (Ext_string.concat3 file "_" !Bsb_global_backend.backend_string)  (fun  {
       dir_or_files ; source_directory; st_mtimes
     } ->
       if per_proj_dir <> source_directory then Bsb_source_directory_changed else

jscomp/bsb/bsb_ninja_gen.ml

@@ -119,7 +119,7 @@ let output_ninja_and_namespace_map
       number_of_dev_groups;
     } : Bsb_config_types.t) : unit 
   =
-  let lib_artifacts_dir = Lazy.force Bsb_global_backend.lib_artifacts_dir in
+  let lib_artifacts_dir = !Bsb_global_backend.lib_artifacts_dir in
   let cwd_lib_bs = per_proj_dir // lib_artifacts_dir in 
   let ppx_flags = Bsb_build_util.ppx_flags ppx_files in
   let oc = open_out_bin (cwd_lib_bs // Literals.build_ninja) in          

jscomp/bsb/bsb_ninja_regen.ml

@@ -35,7 +35,7 @@ let regenerate_ninja
     ~forced ~per_proj_dir
   : Bsb_config_types.t option =  
   let toplevel = toplevel_package_specs = None in 
-  let lib_artifacts_dir = Lazy.force Bsb_global_backend.lib_artifacts_dir in
+  let lib_artifacts_dir = !Bsb_global_backend.lib_artifacts_dir in
   let lib_bs_dir =  per_proj_dir // lib_artifacts_dir  in 
   let output_deps = lib_bs_dir // bsdeps in
   let check_result  =

jscomp/bsb/bsb_world.ml

@@ -32,7 +32,7 @@ let install_targets cwd ({files_to_install; namespace; package_name = _} : Bsb_c
   let install ~destdir file = 
      Bsb_file.install_if_exists ~destdir file  |> ignore
   in
-  let lib_artifacts_dir = Lazy.force Bsb_global_backend.lib_artifacts_dir in
+  let lib_artifacts_dir = !Bsb_global_backend.lib_artifacts_dir in
   let install_filename_sans_extension destdir namespace x = 
     let x = 
       Ext_namespace_encode.make ?ns:namespace x in 
@@ -67,7 +67,7 @@ let build_bs_deps cwd (deps : Bsb_package_specs.t) (ninja_args : string array) =
     if Ext_array.is_empty ninja_args then [|vendor_ninja|] 
     else Array.append [|vendor_ninja|] ninja_args
   in 
-  let lib_artifacts_dir = Lazy.force Bsb_global_backend.lib_artifacts_dir in
+  let lib_artifacts_dir = !Bsb_global_backend.lib_artifacts_dir in
   Bsb_build_util.walk_all_deps  cwd (fun {top; proj_dir} ->
       if not top then
         begin 

jscomp/main/bsb_main.ml

@@ -85,7 +85,17 @@ let bsb_main_flags : (string * Arg.spec * string) list=
   we make it at this time to make `bsb -help` easier
 *)
     "-ws", Arg.Bool ignore, 
-    " [host:]port specify a websocket number (and optionally, a host). When a build finishes, we send a message to that port. For tools that listen on build completion." 
+    " [host:]port specify a websocket number (and optionally, a host). When a build finishes, we send a message to that port. For tools that listen on build completion." ;
+#if BS_NATIVE then
+    "-backend", Arg.String (fun s -> 
+        match s with
+        | "js"       -> Bsb_global_backend.set_backend Bsb_config_types.Js
+        | "native"   -> Bsb_global_backend.set_backend Bsb_config_types.Native
+        | "bytecode" -> Bsb_global_backend.set_backend Bsb_config_types.Bytecode
+        | _ -> failwith "-backend should be one of: 'js', 'bytecode' or 'native'."
+      ),
+    " Builds the entries specified in the bsconfig that match the given backend. Can be either 'js', 'bytecode' or 'native'.";
+#end
   ]
 
 
@@ -99,7 +109,7 @@ let exec_command_then_exit  command =
 (* Execute the underlying ninja build call, then exit (as opposed to keep watching) *)
 let ninja_command_exit   ninja_args  =
   let ninja_args_len = Array.length ninja_args in
-  let lib_artifacts_dir = Lazy.force Bsb_global_backend.lib_artifacts_dir in
+  let lib_artifacts_dir = !Bsb_global_backend.lib_artifacts_dir in
   if Ext_sys.is_windows_or_cygwin then
     let path_ninja = Filename.quote Bsb_global_paths.vendor_ninja in 
     exec_command_then_exit 

jscomp/syntax/native_ast_derive_abstract.ml

@@ -169,7 +169,7 @@ let handleTdcl light (tdcl : Parsetree.type_declaration) =
          else maker_body) in
 
         let myMaker =
-#if BS_NATIVE then          
+#if BS_NATIVE_PPX then          
 
          Str.value Nonrecursive [
            Vb.mk
@@ -204,7 +204,7 @@ let code_sig_transform sigi = match sigi with
     } ->
     Sig.value (Val.mk ~loc:pstr_loc name typ)
   | _ -> 
-#if BS_NATIVE  then
+#if BS_NATIVE_PPX  then
     Sig.type_ Nonrecursive []
 #else assert false    
 #end