Merge pull request #3859 from bsansouci/fix-existent-bs-native-stuff

Fix existing code compiled away with BS_NATIVE

Author: bobzhang

jscomp/bsb_helper/bsb_helper_depfile_gen.ml

@@ -243,6 +243,7 @@ let oc_intf
 
 
 let emit_d 
+  compilation_kind
   (index : Bsb_dir_index.t) 
   (namespace : string option) (mlast : string) (mliast : string) = 
   let data  =
@@ -251,9 +252,12 @@ let emit_d
   let buf = Ext_buffer.create 2048 in 
   let filename = 
       Ext_filename.new_extension mlast Literals.suffix_d in   
-  let lhs_suffix = Literals.suffix_cmj in   
-  let rhs_suffix = Literals.suffix_cmj in 
-  
+  let lhs_suffix, rhs_suffix =
+    match compilation_kind with
+    | Js       -> Literals.suffix_cmj, Literals.suffix_cmj
+    | Bytecode -> Literals.suffix_cmo, Literals.suffix_cmo
+    | Native   -> Literals.suffix_cmx, Literals.suffix_cmx 
+  in   
   oc_impl 
     mlast
     index 
@@ -271,64 +275,3 @@ let emit_d
       buf        
   end;          
   write_file filename buf 
-
-
-
-
-
-
-#if BS_NATIVE then
-(* OPT: Don't touch the .d file if nothing changed *)
-let emit_dep_file
-    compilation_kind
-    (fn : string)
-    (index : Bsb_dir_index.t) 
-    (namespace : string option) : unit = 
-  let data  =
-    Bsb_db_decode.read_build_cache 
-      ~dir:Filename.current_dir_name
-  in 
-  let set = read_deps fn in 
-  match Ext_string.ends_with_then_chop fn Literals.suffix_mlast with 
-  | Some  input_file -> 
-(* #if BS_NATIVE then    *)
-    let lhs_suffix, rhs_suffix =
-      match compilation_kind with
-      | Js       -> Literals.suffix_cmj, Literals.suffix_cmj
-      | Bytecode -> Literals.suffix_cmo, Literals.suffix_cmi
-      | Native   -> Literals.suffix_cmx, Literals.suffix_cmx 
-    in    
-(* #else     
-   let lhs_suffix = Literals.suffix_cmj in   
-   let rhs_suffix = Literals.suffix_cmj in 
-#end *)
-   let buf = Ext_buffer.create 64 in 
-   oc_impl 
-     set 
-     input_file 
-     index 
-     data
-     namespace
-     buf 
-     lhs_suffix 
-     rhs_suffix       
-     ;
-   write_file (input_file ^ Literals.suffix_d ) buf 
-    
-  | None -> 
-    begin match Ext_string.ends_with_then_chop fn Literals.suffix_mliast with 
-      | Some input_file -> 
-        let filename = (input_file ^ Literals.suffix_d) in 
-        let buf = Ext_buffer.create 64 in 
-        oc_intf 
-          set 
-          input_file 
-          index 
-          data 
-          namespace 
-          buf; 
-        write_file filename buf 
-      | None -> 
-        raise (Arg.Bad ("don't know what to do with  " ^ fn))
-    end
-#end

jscomp/bsb_helper/bsb_helper_depfile_gen.mli

@@ -29,22 +29,11 @@ type kind = Js | Bytecode | Native
 *)
 val deps_of_channel : in_channel -> string list
 
-#if BS_NATIVE then
-(**
-  [make compilation_kind filename index namespace]
-  emit [.d] file based on filename (shoud be [.mlast] or [.mliast])
-*)
-val emit_dep_file: 
-  kind ->
-  string -> 
-  Bsb_dir_index.t ->  
-  string option ->
-  unit
-#end
 
-val emit_d:  
+val emit_d: 
+  kind -> 
   Bsb_dir_index.t ->  
   string  option ->
   string ->
   string -> (* empty string means no mliast *)
-  unit
+  unit

jscomp/bsb_helper/bsb_helper_extract.ml

@@ -27,13 +27,8 @@ let read_dependency_graph_from_mlast_file fn  =
   try
     let dep_size = input_binary_int ic in
     let dep_data = really_input_string ic dep_size in
-    let splitted_data = Ext_string.split dep_data '\t' in
-    let set = match splitted_data with
-    | final_length :: rest ->
-      let set = String_set.of_list rest in
-      assert (String_set.cardinal set = (int_of_string final_length));
-      set
-    | _ -> assert false in
+    let splitted_data = Ext_string.split dep_data '\n' in
+    let set = String_set.of_list splitted_data in
     close_in ic;
     set
   with exn ->

jscomp/bsb_helper/bsb_helper_linker.ml

@@ -22,33 +22,66 @@
  * 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
 type link_t = LinkBytecode of string | LinkNative of string
 
-let link link_byte_or_native ~main_module ~batch_files ~includes =
+let ( // ) = Ext_path.combine
+
+(* The linker is called with object files (.cmo / .cmx) which will be namespaced and we're using
+   those names to read-in the mlast files which are not namespaced. So we strip the namespace
+   before reading them in. *)
+let module_of_filename filename = 
+  let str = Ext_filename.chop_extension_maybe filename in
+  match (String.rindex str '-') with 
+  | exception Not_found -> str
+  | len -> String.sub str 0 len
+
+let link link_byte_or_native ~main_module ~batch_files ~includes ~ocaml_dependencies ~namespace ~warnings ~warn_error ~verbose ~cwd =
   let suffix_object_files, suffix_library_files, compiler, output_file = begin match link_byte_or_native with
-  | LinkBytecode output_file -> Literals.suffix_cmo, Literals.suffix_cma , "ocamlc.opt"  , output_file
-  | LinkNative output_file   -> Literals.suffix_cmx, Literals.suffix_cmxa, "ocamlopt.opt", output_file
+  | LinkBytecode output_file -> Literals.suffix_cmo, Literals.suffix_cma , "ocamlc"  , output_file
+  | LinkNative output_file   -> Literals.suffix_cmx, Literals.suffix_cmxa, "ocamlopt", output_file
   end in
   (* Map used to track the path to the files as the dependency_graph that we're going to read from the mlast file only contains module names *)
   let module_to_filepath = Ext_list.fold_left batch_files String_map.empty
     (fun m v ->
       String_map.add m
-      (Ext_filename.module_name v)
+      (Ext_filename.module_name (module_of_filename v))
       (Ext_filename.chop_extension_maybe v)
       )    
   in
   let dependency_graph = Ext_list.fold_left batch_files String_map.empty
     (fun m file ->
+      let module_name = module_of_filename file in
+      let suffix = if Sys.file_exists (module_name ^ Literals.suffix_mlast) then Literals.suffix_mlast
+        else Literals.suffix_reast in
       String_map.add m
-        (Ext_filename.module_name file)
-        (Bsb_helper_extract.read_dependency_graph_from_mlast_file ((Ext_filename.chop_extension_maybe file) ^ Literals.suffix_mlast))
+        (Ext_filename.module_name module_name)
+        (Bsb_helper_extract.read_dependency_graph_from_mlast_file (module_name ^ suffix))
         )    
   in
+  let ocaml_dependencies =
+    List.fold_left (fun acc v -> 
+      match v with
+      | "threads" -> 
+      "-thread" :: (Bsb_global_paths.ocaml_dir // "lib" // "ocaml" // "threads" // "threads" ^ suffix_library_files) :: acc
+      | v -> (Bsb_global_paths.ocaml_dir // "lib" // "ocaml" // v ^ suffix_library_files) :: acc
+      ) [] ocaml_dependencies in
+  let warning_command = if String.length warnings > 0 then
+  "-w" :: warnings :: []
+     else [] in 
+  let warning_command = if String.length warn_error > 0 then
+  "-warn-error" :: warn_error :: warning_command
+  else warning_command in
+  
   let tasks = Bsb_helper_dep_graph.simple_collect_from_main dependency_graph main_module in
+  let namespace = match namespace with 
+     | None -> ""
+     | Some namespace -> "-" ^ namespace
+   in
   let list_of_object_files = Queue.fold
     (fun acc v -> match String_map.find_opt module_to_filepath v with
-      | Some file -> (file ^ suffix_object_files) :: acc
-      | None -> failwith @@ "build.ninja is missing the file '" ^ v ^ "' that was used in the project. Try force-regenerating but this shouldn't happen."
+      | Some file -> (file ^ namespace ^ suffix_object_files) :: acc
+      | None -> Bsb_exception.missing_object_file v
       )
     []
     tasks in
@@ -59,9 +92,16 @@ let link link_byte_or_native ~main_module ~batch_files ~includes =
     in
     (* This list will be reversed so we append the otherlibs object files at the end, and they'll end at the beginning. *)
     let otherlibs = Bsb_helper_dep_graph.get_otherlibs_dependencies dependency_graph suffix_library_files in
-    let all_object_files = List.rev (list_of_object_files @ otherlibs) in
-    Unix.execvp
-      compiler
-      (Array.of_list (compiler :: "-o" :: output_file :: library_files @ all_object_files))
+    let all_object_files = ocaml_dependencies @ library_files @ List.rev (list_of_object_files @ otherlibs) in
+    let compiler_extension = if Ext_sys.is_windows_or_cygwin then ".opt.exe" else ".opt" in
+    let local_compiler = Bsb_global_paths.ocaml_dir // "bin" // compiler ^ compiler_extension in
+    let super_errors = if false then ["-bs-super-errors"] else [] in
+    let list_of_args = (local_compiler :: "-g" ::
+      warning_command) @ super_errors @ "-o" :: output_file :: all_object_files in
+    if verbose then
+      print_endline("Bsb_helper link command:\n" ^ (String.concat "  " list_of_args) ^ "\n");
+
+    Unix.execvp local_compiler (Array.of_list (list_of_args))
   end else
     failwith @@ "No " ^ suffix_object_files ^ " to link. Hint: is the main module in the entries array right?"
+#end

jscomp/bsb_helper/bsb_helper_linker.mli

@@ -22,6 +22,19 @@
  * 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
 type link_t = LinkBytecode of string | LinkNative of string
 
-val link : link_t -> main_module:string -> batch_files:string list -> includes:string list -> unit
+val link : link_t ->
+  main_module:string ->
+  batch_files:string list ->
+  includes:string list ->
+  ocaml_dependencies:string list ->
+  namespace:string option ->
+  warnings:string ->
+  warn_error:string ->
+  verbose:bool ->
+  cwd: string ->
+  unit
+#end
+

jscomp/bsb_helper/bsb_helper_packer.ml

@@ -22,46 +22,84 @@
  * 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
 type pack_t = PackBytecode | PackNative
 
-let pack pack_byte_or_native ~batch_files ~includes =
-  let suffix_object_files, suffix_library_files, compiler = begin match pack_byte_or_native with
-  | PackBytecode -> Literals.suffix_cmo, Literals.suffix_cma , "ocamlc.opt"
-  | PackNative   -> Literals.suffix_cmx, Literals.suffix_cmxa, "ocamlopt.opt"
+let ( // ) = Ext_path.combine
+
+(* The packer is called with object files (.cmo / .cmx) which will be namespaced and we're using
+   those names to read-in the mlast files which are not namespaced. So we strip the namespace
+   before reading them in. *)
+let module_of_filename filename = 
+  let str = Ext_filename.chop_extension_maybe filename in
+  match (String.rindex str '-') with 
+  | exception Not_found -> str
+  | len -> String.sub str 0 len
+
+let pack pack_byte_or_native ~batch_files ~includes ~namespace ~warnings ~warn_error ~verbose ~cwd =
+  let suffix_object_files, suffix_library_files, compiler, nested = begin match pack_byte_or_native with
+  | PackBytecode -> Literals.suffix_cmo, Literals.suffix_cma , "ocamlc", "bytecode"
+  | PackNative   -> Literals.suffix_cmx, Literals.suffix_cmxa, "ocamlopt", "native"
   end in
   let module_to_filepath = Ext_list.fold_left batch_files  String_map.empty
     (fun m v ->
       String_map.add m
-      (Ext_filename.module_name v)
+      (Ext_filename.module_name (module_of_filename v))
       (Ext_filename.chop_extension_maybe v)
       )  
   in
   let dependency_graph = Ext_list.fold_left batch_files String_map.empty
     (fun m file ->
+      let module_name = module_of_filename file in
+      let suffix = if Sys.file_exists (module_name ^ Literals.suffix_mlast) then Literals.suffix_mlast
+        else Literals.suffix_reast in
       String_map.add m
-        (Ext_filename.module_name file)
-        (Bsb_helper_extract.read_dependency_graph_from_mlast_file ((Ext_filename.chop_extension_maybe file) ^ Literals.suffix_mlast))
+        (Ext_filename.module_name module_name)
+        (Bsb_helper_extract.read_dependency_graph_from_mlast_file (module_name ^ suffix))
         )    
   in
   let domain =
     String_map.fold dependency_graph String_set.empty 
       (fun k _ acc -> String_set.add acc k)
       in
   let sorted_tasks = Bsb_helper_dep_graph.sort_files_by_dependencies ~domain dependency_graph in
-  let list_of_object_files = Queue.fold
+  let all_object_files = Queue.fold
     (fun acc v -> match String_map.find_opt module_to_filepath v with
       | Some file -> (file ^ suffix_object_files) :: acc
       | None -> failwith @@ "build.ninja is missing the file '" ^ v ^ "' that was used in the project. Try force-regenerating but this shouldn't happen."
       )
     []
     sorted_tasks in
+  let warning_command = if String.length warnings > 0 then
+    "-w" :: warnings :: []
+  else [] in 
+  let warning_command = if String.length warn_error > 0 then
+    "-warn-error" :: warn_error :: warning_command
+  else warning_command in
+
   (* This list will be reversed so we append the otherlibs object files at the end, and they'll end at the beginning. *)
-  if list_of_object_files <> [] then
+  if all_object_files <> [] then
     let includes = Ext_list.fold_left includes [] (fun acc dir -> "-I" :: dir :: acc)  in
     let otherlibs = Bsb_helper_dep_graph.get_otherlibs_dependencies dependency_graph suffix_library_files in
-    let all_object_files = List.rev (list_of_object_files @ otherlibs) in
+    let all_object_files = match namespace with
+      | None -> all_object_files
+      | Some namespace -> (namespace ^ suffix_object_files) :: all_object_files 
+    in
+    let all_object_files = List.rev (all_object_files @ otherlibs) in
+    let compiler_extension = if Ext_sys.is_windows_or_cygwin then ".opt.exe" else ".opt" in
+    let local_compiler = Bsb_global_paths.ocaml_dir // "bin" // compiler ^ compiler_extension in
+    
+    let super_errors = if false then ["-bs-super-errors"] else [] in
+    let list_of_args = (local_compiler :: "-a" :: "-g" ::
+      warning_command) @ super_errors @ "-o" :: (cwd // Literals.library_file ^ suffix_library_files) :: includes 
+      @ all_object_files in
+
+    if verbose then
+      print_endline("Bsb_helper pack command:\n" ^ (String.concat "  " list_of_args) ^ "\n");
+
     Unix.execvp
-      compiler
-        (Array.of_list (compiler :: "-a" :: "-o" :: (Literals.library_file ^ suffix_library_files) :: includes @ all_object_files))
+      local_compiler
+        (Array.of_list list_of_args)
   else
-    failwith @@ "No " ^ suffix_object_files ^ " to pack into a lib."
+    Bsb_exception.no_files_to_pack suffix_object_files
+#end

jscomp/bsb_helper/bsb_helper_packer.mli

@@ -22,6 +22,16 @@
  * 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
 type pack_t = PackBytecode | PackNative
 
-val pack : pack_t -> batch_files:string list -> includes:string list -> unit
+val pack : pack_t -> 
+  batch_files:string list ->
+  includes:string list ->
+  namespace:string option ->
+  warnings: string -> 
+  warn_error: string ->
+  verbose: bool ->
+  cwd:string ->
+  unit
+#end

jscomp/core/js_name_of_module_id.ml

@@ -128,10 +128,10 @@ let string_of_module_id
         | Package_found pkg, Package_script 
           ->    
 #if BS_NATIVE then
-          if Filename.is_relative dep_path then 
+          if Filename.is_relative pkg.rel_path then 
             pkg.pkg_rel_path // js_file
           else 
-            pkg.dep_path // js_file
+            pkg.rel_path // js_file
 #else
           pkg.pkg_rel_path // js_file
 #end
@@ -150,10 +150,10 @@ let string_of_module_id
             begin match module_system with 
               | NodeJS | Es6 -> 
 #if BS_NATIVE then
-          if Filename.is_relative dep_path then 
+          if Filename.is_relative dep_pkg.rel_path then 
             dep_pkg.pkg_rel_path // js_file
           else 
-            dep_path // js_file
+            dep_pkg.rel_path // js_file
 #else
                 dep_pkg.pkg_rel_path // js_file
 #end