Skip to content

Commit

Permalink
Fix existing code compiled away with BS_NATIVE
Browse files Browse the repository at this point in the history
And this sets us better for rescript-lang#3762 :)
This shouldn't affect bsb / bsc, everything's compiled away.
  • Loading branch information
bsansouci committed Oct 2, 2019
1 parent 7cea069 commit c6a41f7
Show file tree
Hide file tree
Showing 11 changed files with 206 additions and 145 deletions.
71 changes: 7 additions & 64 deletions jscomp/bsb_helper/bsb_helper_depfile_gen.ml
Expand Up @@ -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 =
Expand All @@ -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
Expand All @@ -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
17 changes: 3 additions & 14 deletions jscomp/bsb_helper/bsb_helper_depfile_gen.mli
Expand Up @@ -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
9 changes: 2 additions & 7 deletions jscomp/bsb_helper/bsb_helper_extract.ml
Expand Up @@ -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 ->
Expand Down
64 changes: 52 additions & 12 deletions jscomp/bsb_helper/bsb_helper_linker.ml
Expand Up @@ -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
Expand All @@ -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
15 changes: 14 additions & 1 deletion jscomp/bsb_helper/bsb_helper_linker.mli
Expand Up @@ -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

64 changes: 51 additions & 13 deletions jscomp/bsb_helper/bsb_helper_packer.ml
Expand Up @@ -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
12 changes: 11 additions & 1 deletion jscomp/bsb_helper/bsb_helper_packer.mli
Expand Up @@ -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
8 changes: 4 additions & 4 deletions jscomp/core/js_name_of_module_id.ml
Expand Up @@ -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
Expand All @@ -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
Expand Down

0 comments on commit c6a41f7

Please sign in to comment.