Skip to content

Alllow .res files in stdlib #5714

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 13 commits into from
Oct 3, 2022
149 changes: 76 additions & 73 deletions jscomp/core/js_implementation.ml
Original file line number Diff line number Diff line change
Expand Up @@ -45,39 +45,41 @@ let process_with_gentype cmt_file =
if !Clflags.bs_gentype then GenTypeMain.processCmtFile cmt_file

let after_parsing_sig ppf outputprefix ast =
Ast_config.iter_on_bs_config_sigi ast;
if !Js_config.modules then
output_deps_set !Location.input_name
(Ast_extract.read_parse_and_extract Mli ast);
(if !Js_config.binary_ast then
let sourcefile = !Location.input_name in
Binary_ast.write_ast Mli ~sourcefile
~output:(outputprefix ^ Literals.suffix_iast)
(* to support relocate to another directory *)
ast);
if !Js_config.as_pp then (
output_string stdout Config.ast_intf_magic_number;
output_value stdout (!Location.input_name : string);
output_value stdout ast);
if !Js_config.syntax_only then Warnings.check_fatal ()
else
let modulename = module_of_filename outputprefix in
Lam_compile_env.reset ();
let initial_env = Res_compmisc.initial_env () in
Env.set_unit_name modulename;
let tsg = Typemod.transl_signature initial_env ast in
if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg;
let sg = tsg.sig_type in
ignore (Includemod.signatures initial_env sg sg);
Delayed_checks.force_delayed_checks ();
Warnings.check_fatal ();
let deprecated = Builtin_attributes.deprecated_of_sig ast in
let sg =
Env.save_signature ~deprecated sg modulename (outputprefix ^ ".cmi")
in
Typemod.save_signature modulename tsg outputprefix !Location.input_name
initial_env sg;
process_with_gentype (outputprefix ^ ".cmti")
if !Clflags.only_parse = false then (
Ast_config.iter_on_bs_config_sigi ast;
if !Js_config.modules then
output_deps_set !Location.input_name
(Ast_extract.read_parse_and_extract Mli ast);
(if !Js_config.binary_ast then
let sourcefile = !Location.input_name in
Binary_ast.write_ast Mli ~sourcefile
~output:(outputprefix ^ Literals.suffix_iast)
(* to support relocate to another directory *)
ast);
if !Js_config.as_pp then (
output_string stdout Config.ast_intf_magic_number;
output_value stdout (!Location.input_name : string);
output_value stdout ast);
if !Js_config.syntax_only then Warnings.check_fatal ()
else
let modulename = module_of_filename outputprefix in
Lam_compile_env.reset ();
let initial_env = Res_compmisc.initial_env () in
Env.set_unit_name modulename;
let tsg = Typemod.transl_signature initial_env ast in
if !Clflags.dump_typedtree then
fprintf ppf "%a@." Printtyped.interface tsg;
let sg = tsg.sig_type in
ignore (Includemod.signatures initial_env sg sg);
Delayed_checks.force_delayed_checks ();
Warnings.check_fatal ();
let deprecated = Builtin_attributes.deprecated_of_sig ast in
let sg =
Env.save_signature ~deprecated sg modulename (outputprefix ^ ".cmi")
in
Typemod.save_signature modulename tsg outputprefix !Location.input_name
initial_env sg;
process_with_gentype (outputprefix ^ ".cmti"))

let interface ~parser ppf ?outputprefix fname =
let outputprefix =
Expand Down Expand Up @@ -126,48 +128,49 @@ let no_export (rest : Parsetree.structure) : Parsetree.structure =
| _ -> rest

let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) =
Js_config.all_module_aliases :=
!Clflags.assume_no_mli = Mli_non_exists && all_module_alias ast;
Ast_config.iter_on_bs_config_stru ast;
let ast = if !Js_config.no_export then no_export ast else ast in
if !Js_config.modules then
output_deps_set !Location.input_name
(Ast_extract.read_parse_and_extract Ml ast);
(if !Js_config.binary_ast then
let sourcefile = !Location.input_name in
Binary_ast.write_ast ~sourcefile Ml
~output:(outputprefix ^ Literals.suffix_ast)
ast);
if !Js_config.as_pp then (
output_string stdout Config.ast_impl_magic_number;
output_value stdout (!Location.input_name : string);
output_value stdout ast);
if !Js_config.syntax_only then Warnings.check_fatal ()
else
let modulename = Ext_filename.module_name outputprefix in
Lam_compile_env.reset ();
let env = Res_compmisc.initial_env () in
Env.set_unit_name modulename;
let typedtree, coercion, _, _ =
Typemod.type_implementation_more
?check_exists:(if !Js_config.force_cmi then None else Some ())
!Location.input_name outputprefix modulename env ast
in
let typedtree_coercion = (typedtree, coercion) in
print_if ppf Clflags.dump_typedtree Printtyped.implementation_with_coercion
typedtree_coercion;
(if !Js_config.cmi_only then Warnings.check_fatal ()
if !Clflags.only_parse = false then (
Js_config.all_module_aliases :=
!Clflags.assume_no_mli = Mli_non_exists && all_module_alias ast;
Ast_config.iter_on_bs_config_stru ast;
let ast = if !Js_config.no_export then no_export ast else ast in
if !Js_config.modules then
output_deps_set !Location.input_name
(Ast_extract.read_parse_and_extract Ml ast);
(if !Js_config.binary_ast then
let sourcefile = !Location.input_name in
Binary_ast.write_ast ~sourcefile Ml
~output:(outputprefix ^ Literals.suffix_ast)
ast);
if !Js_config.as_pp then (
output_string stdout Config.ast_impl_magic_number;
output_value stdout (!Location.input_name : string);
output_value stdout ast);
if !Js_config.syntax_only then Warnings.check_fatal ()
else
let lambda, exports =
Translmod.transl_implementation modulename typedtree_coercion
in
let js_program =
print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda lambda
|> Lam_compile_main.compile outputprefix exports
let modulename = Ext_filename.module_name outputprefix in
Lam_compile_env.reset ();
let env = Res_compmisc.initial_env () in
Env.set_unit_name modulename;
let typedtree, coercion, _, _ =
Typemod.type_implementation_more
?check_exists:(if !Js_config.force_cmi then None else Some ())
!Location.input_name outputprefix modulename env ast
in
if not !Js_config.cmj_only then
Lam_compile_main.lambda_as_module js_program outputprefix);
process_with_gentype (outputprefix ^ ".cmt")
let typedtree_coercion = (typedtree, coercion) in
print_if ppf Clflags.dump_typedtree
Printtyped.implementation_with_coercion typedtree_coercion;
(if !Js_config.cmi_only then Warnings.check_fatal ()
else
let lambda, exports =
Translmod.transl_implementation modulename typedtree_coercion
in
let js_program =
print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda lambda
|> Lam_compile_main.compile outputprefix exports
in
if not !Js_config.cmj_only then
Lam_compile_main.lambda_as_module js_program outputprefix);
process_with_gentype (outputprefix ^ ".cmt"))

let implementation ~parser ppf ?outputprefix fname =
let outputprefix =
Expand Down
6 changes: 3 additions & 3 deletions jscomp/main/builtin_cmi_datasets.ml

Large diffs are not rendered by default.

3 changes: 3 additions & 0 deletions jscomp/main/rescript_compiler_main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -423,6 +423,9 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array =
"-format", string_call format_file,
"*internal* Format as Res syntax";

"-only-parse", set Clflags.only_parse,
"*internal* stop after parsing";

"-where", unit_call print_standard_library,
"*internal* Print location of standard library and exit";

Expand Down
2 changes: 1 addition & 1 deletion jscomp/ml/clflags.ml
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ let dump_parsetree = ref false (* -dparsetree *)
and dump_typedtree = ref false (* -dtypedtree *)
and dump_rawlambda = ref false (* -drawlambda *)
and dump_lambda = ref false (* -dlambda *)

and only_parse = ref false (* -only-parse *)

let dont_write_files = ref false (* set to true under ocamldoc *)

Expand Down
1 change: 1 addition & 0 deletions jscomp/ml/clflags.mli
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ val dump_lambda : bool ref
val dont_write_files : bool ref
val keep_docs : bool ref
val keep_locs : bool ref
val only_parse : bool ref


val parse_color_setting : string -> Misc.Color.setting option
Expand Down
3 changes: 2 additions & 1 deletion lib/4.06.1/unstable/all_ounit_tests.ml
Original file line number Diff line number Diff line change
Expand Up @@ -9143,6 +9143,7 @@ val dump_lambda : bool ref
val dont_write_files : bool ref
val keep_docs : bool ref
val keep_locs : bool ref
val only_parse : bool ref


val parse_color_setting : string -> Misc.Color.setting option
Expand Down Expand Up @@ -9191,7 +9192,7 @@ let dump_parsetree = ref false (* -dparsetree *)
and dump_typedtree = ref false (* -dtypedtree *)
and dump_rawlambda = ref false (* -drawlambda *)
and dump_lambda = ref false (* -dlambda *)

and only_parse = ref false (* -only-parse *)

let dont_write_files = ref false (* set to true under ocamldoc *)

Expand Down
9 changes: 5 additions & 4 deletions lib/4.06.1/unstable/js_compiler.ml

Large diffs are not rendered by default.

9 changes: 5 additions & 4 deletions lib/4.06.1/unstable/js_playground_compiler.ml

Large diffs are not rendered by default.

161 changes: 84 additions & 77 deletions lib/4.06.1/whole_compiler.ml

Large diffs are not rendered by default.

42 changes: 37 additions & 5 deletions scripts/ninja.js
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
#!/usr/bin/env node
//@ts-check

var os = require("os");
var fs = require("fs");
var path = require("path");
var cp = require("child_process");
Expand Down Expand Up @@ -585,25 +586,53 @@ function sourceToTarget(y) {
*/
function ocamlDepForBscAsync(files, dir, depsMap) {
return new Promise((resolve, reject) => {
var tmpdir = null;
const mlfiles = []; // convert .res files to temporary .ml files in tmpdir
files.forEach(f => {
const { name, ext } = path.parse(f);
if (ext === ".res" || ext === ".resi") {
const mlname = ext === ".resi" ? name + ".mli" : name + ".ml";
if (tmpdir == null) {
tmpdir = fs.mkdtempSync(path.join(os.tmpdir(), "resToMl"));
}
try {
const mlfile = path.join(tmpdir, mlname);
cp.execSync(`${bsc_exe} -dsource -only-parse ${f} 2>${mlfile}`, {
cwd: dir,
shell: "true",
encoding: "ascii",
});
mlfiles.push(mlfile);
} catch (err) {
console.log(err);
}
}
});
const minusI = tmpdir == null ? "" : `-I ${tmpdir}`;
cp.exec(
`ocamldep.opt -allow-approx -one-line -native ${files.join(" ")}`,
`ocamldep.opt -allow-approx -one-line ${minusI} -native ${files.join(
" "
)} ${mlfiles.join(" ")}`,
{
cwd: dir,
encoding: "ascii",
},
function (error, stdout, stderr) {
if (tmpdir != null) {
fs.rmSync(tmpdir, { recursive: true, force: true });
}
if (error !== null) {
return reject(error);
} else {
var pairs = stdout.split("\n").map(x => x.split(":"));
const pairs = stdout.split("\n").map(x => x.split(":"));
pairs.forEach(x => {
var deps;
let source = replaceCmj(x[0]);
let source = replaceCmj(path.basename(x[0]));
if (x[1] !== undefined && (deps = x[1].trim())) {
deps = deps.split(" ");
updateDepsKVsByFile(
source,
deps.map(x => replaceCmj(x)),
deps.map(x => replaceCmj(path.basename(x))),
depsMap
);
}
Expand Down Expand Up @@ -1014,7 +1043,10 @@ ${ninjaQuickBuidList([
var jsPrefixSourceFiles = othersDirFiles.filter(
x =>
x.startsWith("js") &&
(x.endsWith(".ml") || x.endsWith(".mli")) &&
(x.endsWith(".ml") ||
x.endsWith(".mli") ||
x.endsWith(".res") ||
x.endsWith(".resi")) &&
!x.includes(".cppo") &&
!x.includes(".pp") &&
!x.includes("#") &&
Expand Down