From 6e314cebf816944685e24621f312a6797dd1eb9f Mon Sep 17 00:00:00 2001 From: Oscar Spencer Date: Thu, 2 May 2024 17:52:03 -0500 Subject: [PATCH] feat(compiler): Enable single-file compilation --- cli/bin/grain.js | 4 + compiler/grainc/grainc.re | 82 ++++++++++++---- compiler/graindoc/docblock.re | 2 +- compiler/graindoc/graindoc.re | 32 ++++-- compiler/src/codegen/linkedtree.re | 8 +- compiler/src/compile.re | 114 ++++------------------ compiler/src/compile.rei | 14 +-- compiler/src/formatting/fmt.re | 1 - compiler/src/language_server/code_file.re | 23 +++-- compiler/src/link.re | 11 +++ compiler/src/parsing/driver.re | 16 +++ compiler/src/parsing/driver.rei | 3 + compiler/src/typed/cmi_format.re | 16 ++- compiler/src/typed/cmi_format.rei | 3 +- compiler/src/typed/dependency_graph.re | 50 +++------- compiler/src/typed/dependency_graph.rei | 11 +-- compiler/src/typed/env.re | 57 +---------- compiler/src/typed/env.rei | 4 +- compiler/src/typed/module_resolution.re | 88 ++++++----------- compiler/src/typed/module_resolution.rei | 14 +-- compiler/src/typed/typemod.re | 1 + compiler/test/runner.re | 110 ++++++++++++++++++--- compiler/test/suites/foreigns.re | 1 + compiler/test/suites/linking.re | 5 +- compiler/test/suites/modules.re | 13 ++- compiler/test/suites/provides.re | 41 ++++---- 26 files changed, 367 insertions(+), 357 deletions(-) create mode 100644 compiler/src/link.re diff --git a/cli/bin/grain.js b/cli/bin/grain.js index d74fe28199..32f861c850 100755 --- a/cli/bin/grain.js +++ b/cli/bin/grain.js @@ -188,6 +188,10 @@ program .command("compile ") .description("compile a grain program into wasm") .forwardOption("-o ", "output filename") + .forwardOption( + "--single-file", + "compile a single file without compiling dependencies" + ) .forwardOption( "--use-start-section", "replaces the _start export with a start section during linking" diff --git a/compiler/grainc/grainc.re b/compiler/grainc/grainc.re index 3555c0c83e..5b85c1a958 100644 --- a/compiler/grainc/grainc.re +++ b/compiler/grainc/grainc.re @@ -1,4 +1,5 @@ open Grain; +open Grain_typed; open Compile; open Printf; open Lexing; @@ -26,24 +27,8 @@ let () = } ); -let compile_file = (name, outfile_arg) => { - if (!Printexc.backtrace_status() && Grain_utils.Config.verbose^) { - Printexc.record_backtrace(true); - }; - try({ - let outfile = - Option.value( - ~default=Compile.default_wasm_filename(name), - outfile_arg, - ); - let hook = - if (Grain_utils.Config.statically_link^) { - Compile.stop_after_assembled; - } else { - Compile.stop_after_object_emitted; - }; - ignore(Compile.compile_file(~is_root_file=true, ~hook, ~outfile, name)); - }) { +let error_wrapped = f => + try(f()) { | exn => let bt = if (Printexc.backtrace_status()) { @@ -63,6 +48,59 @@ let compile_file = (name, outfile_arg) => { ); exit(2); }; + +let compile_file = (~outfile=?, filename) => { + let outfile = + Option.value( + ~default=Compile.default_object_filename(filename), + outfile, + ); + ignore(Compile.compile_file(~outfile, filename)); +}; +let compile_file = (~outfile=?, filename) => + error_wrapped(() => compile_file(~outfile?, filename)); + +let grainc = (single_file_mode, name, outfile) => { + Grain_utils.Config.set_root_config(); + + if (!Printexc.backtrace_status() && Grain_utils.Config.verbose^) { + Printexc.record_backtrace(true); + }; + + if (single_file_mode) { + compile_file(~outfile?, name); + } else { + switch (Grain_utils.Config.wasi_polyfill^) { + | Some(name) => + Grain_utils.Config.preserve_config(() => { + Grain_utils.Config.compilation_mode := Grain_utils.Config.Runtime; + Module_resolution.load_dependency_graph(name); + let to_compile = Module_resolution.get_out_of_date_dependencies(); + List.iter(compile_file, to_compile); + compile_file(name); + }) + | None => () + }; + + Module_resolution.load_dependency_graph(name); + let to_compile = Module_resolution.get_out_of_date_dependencies(); + List.iter(compile_file, to_compile); + compile_file(name); + + if (Grain_utils.Config.statically_link^) { + let main_object = + Option.value( + ~default=Compile.default_object_filename(name), + outfile, + ); + let outfile = + Option.value(~default=Compile.default_wasm_filename(name), outfile); + let dependencies = Module_resolution.get_dependencies(); + + Link.link(~main_object, ~outfile, dependencies); + }; + }; + `Ok(); }; @@ -107,6 +145,11 @@ let output_filename = { ); }; +let single_file_mode = { + let doc = sprintf("Compile a single file without compiling dependencies"); + Arg.(value & vflag(false, [(true, info(["single-file"], ~doc))])); +}; + let cmd = { let doc = sprintf("Compile Grain programs"); let version = @@ -118,7 +161,8 @@ let cmd = { Cmd.info(Sys.argv[0], ~version, ~doc), Term.( ret( - Grain_utils.Config.with_cli_options(compile_file) + Grain_utils.Config.with_cli_options(grainc) + $ single_file_mode $ input_filename $ output_filename, ) diff --git a/compiler/graindoc/docblock.re b/compiler/graindoc/docblock.re index a38719e5f4..dd6b10061c 100644 --- a/compiler/graindoc/docblock.re +++ b/compiler/graindoc/docblock.re @@ -330,7 +330,7 @@ let get_comments_from_loc = (loc: Grain_parsing.Location.t) => { | Some(comments) => comments | None => let comments = - switch (compile_file(~is_root_file=true, ~hook=stop_after_parse, file)) { + switch (compile_file(~hook=stop_after_parse, file)) { | exception exn => [] | {cstate_desc: Parsed(parsed_program)} => parsed_program.comments | _ => failwith("Invalid compilation state") diff --git a/compiler/graindoc/graindoc.re b/compiler/graindoc/graindoc.re index f68c5b1576..8dcbd8bee3 100644 --- a/compiler/graindoc/graindoc.re +++ b/compiler/graindoc/graindoc.re @@ -47,14 +47,26 @@ type params = { current_version: option(string), }; -let compile_typed = (input: Fp.t(Fp.absolute)) => { - switch ( - Compile.compile_file( - ~is_root_file=true, - ~hook=stop_after_typed, - Filepath.to_string(input), - ) - ) { +let compile_typed = file => { + Module_resolution.load_dependency_graph(file); + let to_compile = Module_resolution.get_out_of_date_dependencies(); + List.iter( + file => + ignore( + compile_file( + ~hook=stop_after_object_emitted, + ~outfile=Compile.default_wasm_filename(file), + file, + ), + ), + to_compile, + ); + compile_file(~hook=stop_after_typed, file); +}; + +let compile = (input: Fp.t(Fp.absolute)) => { + reset_compiler_state(); + switch (compile_typed(Filepath.to_string(input))) { | exception exn => let bt = if (Printexc.backtrace_status()) { @@ -180,9 +192,11 @@ let enumerate_runs = opts => }; let graindoc = (opts, runs) => { + Config.set_root_config(); + List.iter( ({input_path, output_path}) => { - let program = compile_typed(input_path); + let program = compile(input_path); try( generate_docs( ~current_version=opts.current_version, diff --git a/compiler/src/codegen/linkedtree.re b/compiler/src/codegen/linkedtree.re index b80b6b6174..7086acd4e6 100644 --- a/compiler/src/codegen/linkedtree.re +++ b/compiler/src/codegen/linkedtree.re @@ -29,9 +29,7 @@ let max_stack_size = (s1, s2) => { let wasi_module = "wasi_snapshot_preview1"; -let link = main_mashtree => { - let main_module = Module_resolution.current_filename^(); - +let link = (~main_object, dependencies) => { let new_base_dir = Filepath.String.dirname; let resolve = (~base_dir=?, mod_name) => @@ -43,7 +41,6 @@ let link = main_mashtree => { Config.wasi_polyfill_path(), ); - let dependencies = Module_resolution.get_dependencies(); let dependencies = switch (wasi_polyfill) { | Some(polyfill) => [polyfill, ...dependencies] @@ -199,7 +196,8 @@ let link = main_mashtree => { dependencies, ); - let main_program = process_mashtree(~main=true, main_module, main_mashtree); + let main_mashtree = Emitmod.load_object(main_object); + let main_program = process_mashtree(~main=true, main_object, main_mashtree); let programs = List.rev([main_program, ...programs]); let num_function_table_elements = num_function_table_elements^; let signature = main_mashtree.signature; diff --git a/compiler/src/compile.re b/compiler/src/compile.re index 7a314f459d..8f6dfd97da 100644 --- a/compiler/src/compile.re +++ b/compiler/src/compile.re @@ -13,16 +13,12 @@ type compilation_state_desc = | Initial(input_source) | Parsed(Parsetree.parsed_program) | WellFormed(Parsetree.parsed_program) - | DependenciesCompiled(Parsetree.parsed_program) | TypeChecked(Typedtree.typed_program) | TypedWellFormed(Typedtree.typed_program) | Linearized(Anftree.anf_program) | Optimized(Anftree.anf_program) | Mashed(Mashtree.mash_program) - | ObjectEmitted(Mashtree.mash_program) - | ObjectsLinked(Linkedtree.linked_program) - | Compiled(Compmod.compiled_program) - | Assembled; + | ObjectEmitted; type compilation_state = { cstate_desc: compilation_state_desc, @@ -78,7 +74,6 @@ let log_state = state => prerr_string("\nParsed program:\n"); prerr_sexp(Grain_parsing.Parsetree.sexp_of_parsed_program, p); | WellFormed(_) => prerr_string("\nWell-Formedness passed") - | DependenciesCompiled(_) => prerr_string("\nDependencies compiled") | TypeChecked(typed_mod) => prerr_string("\nTyped program:\n"); prerr_sexp(Grain_typed.Typedtree.sexp_of_typed_program, typed_mod); @@ -93,17 +88,12 @@ let log_state = state => | Mashed(mashed) => prerr_string("\nMashed program:\n"); prerr_sexp(Mashtree.sexp_of_mash_program, mashed); - | ObjectEmitted(mashed) => - prerr_string("\nMashfile emitted successfully") - | ObjectsLinked(linked) => - prerr_string("\nMashfiles linked successfully") - | Compiled(compiled) => prerr_string("\nCompiled successfully") - | Assembled => prerr_string("\nAssembled successfully") + | ObjectEmitted => prerr_string("\nObject emitted successfully") }; prerr_string("\n\n"); }; -let next_state = (~is_root_file=false, {cstate_desc, cstate_filename} as cs) => { +let next_state = ({cstate_desc, cstate_filename} as cs) => { let cstate_desc = switch (cstate_desc) { | Initial(input) => @@ -153,16 +143,7 @@ let next_state = (~is_root_file=false, {cstate_desc, cstate_filename} as cs) => Well_formedness.check_well_formedness(p); WellFormed(p); - | WellFormed(p) => - if (is_root_file) { - let base_file = Option.value(~default="", cstate_filename); - Module_resolution.compile_dependency_graph( - ~base_file, - Driver.read_imports(p), - ); - }; - DependenciesCompiled(p); - | DependenciesCompiled(p) => TypeChecked(Typemod.type_implementation(p)) + | WellFormed(p) => TypeChecked(Typemod.type_implementation(p)) | TypeChecked(typed_mod) => Typed_well_formedness.check_well_formedness(typed_mod); TypedWellFormed(typed_mod); @@ -180,18 +161,8 @@ let next_state = (~is_root_file=false, {cstate_desc, cstate_filename} as cs) => | Some(outfile) => Emitmod.emit_object(mashed, outfile) | None => () }; - ObjectEmitted(mashed); - | ObjectEmitted(mashed) => ObjectsLinked(Linkedtree.link(mashed)) - | ObjectsLinked(linked) => - Compiled(Compmod.compile_wasm_module(~name=?cstate_filename, linked)) - | Compiled(compiled) => - switch (cs.cstate_wasm_outfile) { - | Some(outfile) => - Emitmod.emit_binary(compiled.asm, compiled.signature, outfile) - | None => () - }; - Assembled; - | Assembled => Assembled + ObjectEmitted; + | ObjectEmitted => ObjectEmitted }; let ret = {...cs, cstate_desc}; @@ -199,19 +170,19 @@ let next_state = (~is_root_file=false, {cstate_desc, cstate_filename} as cs) => ret; }; -let rec compile_resume = (~is_root_file=false, ~hook=?, s: compilation_state) => { - let next_state = next_state(~is_root_file, s); +let rec compile_resume = (~hook=?, s: compilation_state) => { + let next_state = next_state(s); switch (hook) { | Some(func) => switch (func(next_state)) { - | Continue({cstate_desc: Assembled} as s) => s - | Continue(s) => compile_resume(~is_root_file, ~hook?, s) + | Continue({cstate_desc: ObjectEmitted} as s) => s + | Continue(s) => compile_resume(~hook?, s) | Stop => next_state } | None => switch (next_state.cstate_desc) { - | Assembled => next_state - | _ => compile_resume(~is_root_file, ~hook?, next_state) + | ObjectEmitted => next_state + | _ => compile_resume(~hook?, next_state) } }; }; @@ -253,17 +224,7 @@ let stop_after_mashed = let stop_after_object_emitted = fun - | {cstate_desc: ObjectEmitted(_)} => Stop - | s => Continue(s); - -let stop_after_compiled = - fun - | {cstate_desc: Compiled(_)} => Stop - | s => Continue(s); - -let stop_after_assembled = - fun - | {cstate_desc: Assembled} => Stop + | {cstate_desc: ObjectEmitted} => Stop | s => Continue(s); let compile_wasi_polyfill = () => { @@ -277,13 +238,7 @@ let compile_wasi_polyfill = () => { cstate_wasm_outfile: Some(default_wasm_filename(file)), cstate_object_outfile: Some(default_object_filename(file)), }; - ignore( - compile_resume( - ~is_root_file=true, - ~hook=stop_after_object_emitted, - cstate, - ), - ); + ignore(compile_resume(~hook=stop_after_object_emitted, cstate)); }) | None => () }; @@ -293,21 +248,13 @@ let reset_compiler_state = () => { Driver.reset(); Ident.setup(); Ctype.reset_levels(); - Env.clear_imports(); + Env.clear_persistent_structures(); Module_resolution.clear_dependency_graph(); Grain_utils.Fs_access.flush_all_cached_data(); Grain_utils.Warnings.reset_warnings(); }; -let compile_string = - (~is_root_file=false, ~hook=?, ~name=?, ~outfile=?, ~reset=true, str) => { - if (reset) { - reset_compiler_state(); - compile_wasi_polyfill(); - }; - if (is_root_file) { - Grain_utils.Config.set_root_config(); - }; +let compile_string = (~hook=?, ~name=?, ~outfile=?, str) => { Ident.setup(); let cstate = { cstate_desc: Initial(InputString(str)), @@ -316,19 +263,11 @@ let compile_string = cstate_object_outfile: Option.map(default_object_filename, outfile), }; Grain_utils.Config.preserve_all_configs(() => - compile_resume(~is_root_file, ~hook?, cstate) + compile_resume(~hook?, cstate) ); }; -let compile_file = - (~is_root_file=false, ~hook=?, ~outfile=?, ~reset=true, filename) => { - if (reset) { - reset_compiler_state(); - compile_wasi_polyfill(); - }; - if (is_root_file) { - Grain_utils.Config.set_root_config(); - }; +let compile_file = (~hook=?, ~outfile=?, filename) => { Ident.setup(); let cstate = { cstate_desc: Initial(InputFile(filename)), @@ -337,7 +276,7 @@ let compile_file = cstate_object_outfile: Option.map(default_object_filename, outfile), }; Grain_utils.Config.preserve_all_configs(() => - compile_resume(~is_root_file, ~hook?, cstate) + compile_resume(~hook?, cstate) ); }; @@ -360,18 +299,3 @@ let () = | InlineFlagsError(loc, err) => Some(report_error(loc, err)) | _ => None, ); - -let () = - Module_resolution.compile_module_dependency := - ( - (input, outfile) => - ignore( - compile_file( - ~is_root_file=false, - ~outfile, - ~reset=false, - ~hook=stop_after_object_emitted, - input, - ), - ) - ); diff --git a/compiler/src/compile.rei b/compiler/src/compile.rei index 0e1022af88..0363b6d854 100644 --- a/compiler/src/compile.rei +++ b/compiler/src/compile.rei @@ -11,16 +11,12 @@ type compilation_state_desc = | Initial(input_source) | Parsed(Parsetree.parsed_program) | WellFormed(Parsetree.parsed_program) - | DependenciesCompiled(Parsetree.parsed_program) | TypeChecked(Typedtree.typed_program) | TypedWellFormed(Typedtree.typed_program) | Linearized(Anftree.anf_program) | Optimized(Anftree.anf_program) | Mashed(Mashtree.mash_program) - | ObjectEmitted(Mashtree.mash_program) - | ObjectsLinked(Linkedtree.linked_program) - | Compiled(Compmod.compiled_program) - | Assembled; + | ObjectEmitted; type compilation_state = { cstate_desc: compilation_state_desc, @@ -58,27 +54,23 @@ let stop_after_mashed: compilation_state => compilation_action; let stop_after_object_emitted: compilation_state => compilation_action; -let stop_after_compiled: compilation_state => compilation_action; +let reset_compiler_state: unit => unit; -let stop_after_assembled: compilation_state => compilation_action; +let compile_wasi_polyfill: unit => unit; let compile_string: ( - ~is_root_file: bool=?, ~hook: compilation_state => compilation_action=?, ~name: string=?, ~outfile: string=?, - ~reset: bool=?, string ) => compilation_state; let compile_file: ( - ~is_root_file: bool=?, ~hook: compilation_state => compilation_action=?, ~outfile: string=?, - ~reset: bool=?, string ) => compilation_state; diff --git a/compiler/src/formatting/fmt.re b/compiler/src/formatting/fmt.re index d384c0b823..28a54e7bd8 100644 --- a/compiler/src/formatting/fmt.re +++ b/compiler/src/formatting/fmt.re @@ -23,7 +23,6 @@ let parse_source = program_str => { let eol = Fs_access.determine_eol(List.nth_opt(lines, 0)); let compile_state = Compile.compile_string( - ~is_root_file=true, ~hook=stop_after_parse, ~name=?None, program_str, diff --git a/compiler/src/language_server/code_file.re b/compiler/src/language_server/code_file.re index b8d1432d99..2efdd622ee 100644 --- a/compiler/src/language_server/code_file.re +++ b/compiler/src/language_server/code_file.re @@ -47,19 +47,26 @@ let warning_to_diagnostic = }; }; +let compile = (file, src) => { + Module_resolution.load_dependency_graph_from_string(file, src); + let to_compile = Module_resolution.get_out_of_date_dependencies(); + List.iter( + file => { + ignore( + compile_file(~outfile=Compile.default_object_filename(file), file), + ) + }, + to_compile, + ); + compile_string(~hook=stop_after_typed_well_formed, ~name=file, src); +}; + let compile_source = (uri, source) => { let filename = Utils.uri_to_filename(uri); Trace.log("Compiling " ++ filename); - switch ( - Compile.compile_string( - ~is_root_file=true, - ~hook=stop_after_typed_well_formed, - ~name=filename, - source, - ) - ) { + switch (compile(filename, source)) { | exception exn => switch (Grain_parsing.Location.error_of_exn(exn)) { | Some(`Ok(e)) => diff --git a/compiler/src/link.re b/compiler/src/link.re new file mode 100644 index 0000000000..9655eff294 --- /dev/null +++ b/compiler/src/link.re @@ -0,0 +1,11 @@ +open Grain_codegen; + +let link = (~main_object, ~outfile, dependencies) => { + let linked_program = Linkedtree.link(~main_object, dependencies); + let compiled_program = Compmod.compile_wasm_module(linked_program); + Emitmod.emit_binary( + compiled_program.asm, + compiled_program.signature, + outfile, + ); +}; diff --git a/compiler/src/parsing/driver.re b/compiler/src/parsing/driver.re index dcfa1612ad..5326116d35 100644 --- a/compiler/src/parsing/driver.re +++ b/compiler/src/parsing/driver.re @@ -202,6 +202,22 @@ let scan_for_imports = }; }; +let scan_string_for_imports = + (~defer_errors=true, name: string, src: string): list(loc(string)) => { + let lexbuf = Sedlexing.Utf8.from_string(src); + try({ + let source = () => src; + let prog = parse(~name, lexbuf, source); + read_imports(prog); + }) { + | e => + if (!defer_errors) { + raise(e); + }; + []; // <- defer parse error until we try to compile this dependency + }; +}; + let print_syntax_error = Printf.( Location.( diff --git a/compiler/src/parsing/driver.rei b/compiler/src/parsing/driver.rei index 7b67afd6ef..5db4d4d57d 100644 --- a/compiler/src/parsing/driver.rei +++ b/compiler/src/parsing/driver.rei @@ -9,4 +9,7 @@ let read_imports: Parsetree.parsed_program => list(Location.loc(string)); let scan_for_imports: (~defer_errors: bool=?, string) => list(Location.loc(string)); +let scan_string_for_imports: + (~defer_errors: bool=?, string, string) => list(Location.loc(string)); + let reset: unit => unit; diff --git a/compiler/src/typed/cmi_format.re b/compiler/src/typed/cmi_format.re index b842ed6437..2e8b7cf917 100644 --- a/compiler/src/typed/cmi_format.re +++ b/compiler/src/typed/cmi_format.re @@ -14,6 +14,7 @@ /**************************************************************************/ open Sexplib.Conv; +open Grain_parsing; open Grain_utils; open Wasm_utils; @@ -25,7 +26,8 @@ type pers_flags = type error = | Not_an_interface(string) | Wrong_version_interface(string, string) - | Corrupted_interface(string); + | Corrupted_interface(string) + | Interface_file_not_found(string); exception Error(error); @@ -152,7 +154,10 @@ let read_cmi = (ic, filename): cmi_infos => { Marshal.from_channel(ic); }; let read_cmi = filename => { - let ic = open_in_bin(filename); + let ic = + try(open_in_bin(filename)) { + | _ => raise(Error(Interface_file_not_found(filename))) + }; let cmi = try(read_cmi(ic, filename)) { | Error(_) as exn => @@ -197,6 +202,13 @@ let report_error = ppf => "Corrupted compiled interface@ %a", Location.print_filename, filename, + ) + | Interface_file_not_found(filename) => + fprintf( + ppf, + "Interface file not found@ %a", + Location.print_filename, + filename, ); let () = diff --git a/compiler/src/typed/cmi_format.rei b/compiler/src/typed/cmi_format.rei index b53fa47a0d..60d4ce95cc 100644 --- a/compiler/src/typed/cmi_format.rei +++ b/compiler/src/typed/cmi_format.rei @@ -52,7 +52,8 @@ let read_cmi: string => cmi_infos; type error = | Not_an_interface(string) | Wrong_version_interface(string, string) - | Corrupted_interface(string); + | Corrupted_interface(string) + | Interface_file_not_found(string); exception Error(error); diff --git a/compiler/src/typed/dependency_graph.re b/compiler/src/typed/dependency_graph.re index e33262b1d8..6e54be0c19 100644 --- a/compiler/src/typed/dependency_graph.re +++ b/compiler/src/typed/dependency_graph.re @@ -6,10 +6,10 @@ open Graph; module type Dependency_value = { type t; let get_dependencies: (t, string => option(t)) => list(t); + let get_srcname: t => string; let get_filename: t => string; let is_up_to_date: t => bool; let check_up_to_date: t => unit; - let compile_module: (~loc: Grain_parsing.Location.t=?, t) => unit; let compare: (t, t) => int; let hash: t => int; let equal: (t, t) => bool; @@ -106,45 +106,27 @@ module Make = (DV: Dependency_value) => { do_register(dependency); }; - let solve_next_out_of_date = (~stop=?, ()) => { - let (stop_found, ret) = + let get_dependencies = () => { + List.rev( G_topological.fold( - ((dep, state), acc) => { - switch (acc) { - | (true, _) => acc - | (false, Some(_)) => acc - | (false, None) => - let stop_found = - switch (stop) { - | Some(d) when DV.equal(d, dep) => true - | _ => false - }; - DV.check_up_to_date(dep); - if (!DV.is_up_to_date(dep)) { - (stop_found, Some(dep)); - } else { - (stop_found, None); - }; - } - }, + ((v1, _), acc) => [DV.get_filename(v1), ...acc], graph, - (false, None), - ); - ret; - }; - - let compile_graph = () => { - let to_compile = ref(solve_next_out_of_date()); - while (Option.is_some(to_compile^)) { - DV.compile_module(Option.get(to_compile^)); - to_compile := solve_next_out_of_date(); - }; + [], + ), + ); }; - let get_dependencies = () => { + let get_out_of_date_dependencies = () => { List.rev( G_topological.fold( - ((v1, _), acc) => [DV.get_filename(v1), ...acc], + ((v1, _), acc) => { + DV.check_up_to_date(v1); + if (DV.is_up_to_date(v1)) { + acc; + } else { + [DV.get_srcname(v1), ...acc]; + }; + }, graph, [], ), diff --git a/compiler/src/typed/dependency_graph.rei b/compiler/src/typed/dependency_graph.rei index 026f5cdf59..fee2488f92 100644 --- a/compiler/src/typed/dependency_graph.rei +++ b/compiler/src/typed/dependency_graph.rei @@ -1,11 +1,10 @@ module type Dependency_value = { type t; let get_dependencies: (t, string => option(t)) => list(t); + let get_srcname: t => string; let get_filename: t => string; let is_up_to_date: t => bool; let check_up_to_date: t => unit; - // Guaranteed to only be called when dependencies are compiled. - let compile_module: (~loc: Grain_parsing.Location.t=?, t) => unit; let compare: (t, t) => int; let hash: t => int; let equal: (t, t) => bool; @@ -26,14 +25,14 @@ module Make: let lookup_filename: string => option(DV.t); /** - Compiles the full dependency graph. + Returns a topologically sorted list of all dependencies. */ - let compile_graph: unit => unit; + let get_dependencies: unit => list(string); /** - Returns a topologically sorted list of all dependencies. + Returns a topologically sorted list of out of date dependencies. */ - let get_dependencies: unit => list(string); + let get_out_of_date_dependencies: unit => list(string); /** Dumps the edges in this graph to stderr. diff --git a/compiler/src/typed/env.re b/compiler/src/typed/env.re index 8bc0f848c7..706df2903d 100644 --- a/compiler/src/typed/env.re +++ b/compiler/src/typed/env.re @@ -714,27 +714,14 @@ let add_import = s => { imported_units := StringSet.add(s, imported_units^); }; -let imported_opaque_units = ref(StringSet.empty); - -let add_imported_opaque = s => - imported_opaque_units := StringSet.add(s, imported_opaque_units^); - -let with_cleared_imports = thunk => { - let old_imported_units = imported_units^; - let old_opaque_units = imported_opaque_units^; +let clear_imports = () => { imported_units := StringSet.empty; - imported_opaque_units := StringSet.empty; - let ret = thunk(); - imported_units := old_imported_units; - imported_opaque_units := old_opaque_units; - ret; }; -let clear_imports = () => { +let clear_persistent_structures = () => { Consistbl.clear(crc_units); Hashtbl.clear(persistent_structures); imported_units := StringSet.empty; - imported_opaque_units := StringSet.empty; }; let check_consistency = ps => @@ -759,12 +746,6 @@ let check_consistency = ps => let save_pers_struct = ps => { Hashtbl.add(persistent_structures, ps.ps_filename, Some(ps)); - List.iter( - fun - | Unsafe_string => () - | Opaque => add_imported_opaque(ps.ps_filename), - ps.ps_flags, - ); }; let get_dependency_chain = (~loc, unit_name) => { @@ -855,7 +836,7 @@ let acknowledge_pers_struct = (check, {Persistent_signature.filename, cmi}) => { let (unit_name, _) = get_unit(); error(Depend_on_unsafe_string_unit(ps.ps_name, unit_name)); } - | Opaque => add_imported_opaque(filename), + | Opaque => (), ps.ps_flags, ); if (check) { @@ -2276,9 +2257,6 @@ let imports = () => { ); }; -/* Returns true if [s] is an imported opaque module */ -let is_imported_opaque = s => StringSet.mem(s, imported_opaque_units^); - /* Build a module signature */ let build_signature_with_imports = (~deprecated=?, sg, modname, filename, imports, type_metadata) => { @@ -2574,35 +2552,6 @@ let () = ); let () = { - Module_resolution.with_preserve_unit := - ( - (~loc, unit_name, srcpath, thunk) => { - mark_in_progress(~loc, unit_name, srcpath); - let saved_unit = get_unit(); - let saved = Ident.save_state(); - let cleanup = () => { - Ident.restore_state(saved); - set_unit(saved_unit); - mark_completed(unit_name, srcpath); - }; - try({ - let ret = with_cleared_imports(thunk); - cleanup(); - ret; - }) { - | e => - cleanup(); - raise(e); - }; - } - ); - Module_resolution.current_unit_name := - ( - () => { - let (uname, _) = get_unit(); - uname; - } - ); Module_resolution.current_filename := ( () => { diff --git a/compiler/src/typed/env.rei b/compiler/src/typed/env.rei index d3bd7fad4e..d0ead26378 100644 --- a/compiler/src/typed/env.rei +++ b/compiler/src/typed/env.rei @@ -206,9 +206,6 @@ let crc_of_unit: string => Digest.t; let imports: unit => list((string, Digest.t)); -/* [is_imported_opaque md] returns true if [md] is an opaque imported module */ -let is_imported_opaque: string => bool; - /* Direct access to the table of imported compilation units with their CRC */ module Consistbl: (module type of { @@ -218,6 +215,7 @@ module Consistbl: (module type of { let crc_units: Consistbl.t; let add_import: string => unit; let clear_imports: unit => unit; +let clear_persistent_structures: unit => unit; /* By-name insertions */ /** Adds a value identifier with the given name and description. diff --git a/compiler/src/typed/module_resolution.re b/compiler/src/typed/module_resolution.re index fe171fbba0..20e129e669 100644 --- a/compiler/src/typed/module_resolution.re +++ b/compiler/src/typed/module_resolution.re @@ -14,20 +14,6 @@ type module_location_result = | GrainModule(string, option(string)) /* Grain Source file, Compiled object */ | ObjectFile(string); /* Compiled object */ -let compile_module_dependency: ref((string, string) => unit) = - ref((filename, output_file) => - failwith("compile_module Should be filled in by compile.re") - ); - -let with_preserve_unit: - ref((~loc: Grain_parsing.Location.t, string, string, unit => unit) => unit) = - ref((~loc, _, _, _) => - failwith("with_preserve_unit should be filled in by env.re") - ); - -let current_unit_name: ref(unit => string) = - ref(() => failwith("current_unit_name should be filled in by env.re")); - let current_filename: ref(unit => string) = ref(() => failwith("current_filename should be filled in by env.re")); @@ -313,6 +299,15 @@ module Dependency_graph = let equal = (dn1, dn2) => String.equal(dn1.dn_file_name, dn2.dn_file_name); + let get_srcname = dn => { + switch (dn.dn_latest_resolution^) { + | None => failwith("impossible: get_srcname > No resolution") + | Some(ObjectFile(_)) => + failwith("impossible: get_srcname > No source") + | Some(GrainModule(srcpath, _)) => + Filepath.to_string(Filepath.String.derelativize(srcpath)) + }; + }; let get_filename = dn => dn.dn_file_name; let rec get_dependencies: (t, string => option(t)) => list(t) = @@ -432,9 +427,6 @@ module Dependency_graph = cmi.cmi_crcs, ) }; - if (!up_to_date) { - Hashtbl.remove(cmi_cache, objpath); - }; dn.dn_up_to_date := up_to_date; }; }; @@ -442,38 +434,6 @@ module Dependency_graph = let is_up_to_date = dn => { dn.dn_up_to_date^; }; - - let compile_module = (~loc=?, dn) => { - let srcpath = - switch (dn.dn_latest_resolution^) { - | None => failwith("impossible: compile_module > None") - | Some(ObjectFile(_)) => - failwith("impossible: compile_module > ObjectFile") - | Some(GrainModule(srcpath, _)) => - Filepath.to_string(Filepath.String.derelativize(srcpath)) - }; - let outpath = get_object_name(srcpath); - let loc = Option.value(loc, ~default=Grain_parsing.Location.dummy_loc); - let chosen_unit_name = - switch (Hashtbl.to_seq(dn.dn_unit_name, ())) { - | Seq.Nil => failwith("Impossible: empty dn_unit_name") - | Seq.Cons((parent, unit_name), _) => unit_name - }; - with_preserve_unit^(~loc, chosen_unit_name, srcpath, () => - Warnings.with_preserve_warnings(() => - Config.preserve_config(() => - compile_module_dependency^(srcpath, outpath) - ) - ) - ); - dn.dn_latest_resolution := Some(GrainModule(srcpath, Some(outpath))); - dn.dn_up_to_date := true; - PathTbl.add( - current_located_module_cache(), - (Filepath.String.dirname(outpath), chosen_unit_name), - GrainModule(srcpath, Some(outpath)), - ); - }; }); let locate_object_file = (~loc, ~disable_relpath=false, unit_name) => { @@ -509,14 +469,24 @@ let process_dependency = (~loc, ~base_file, unit_name) => { Dependency_graph.register(dn); }; -let compile_dependency_graph = (~base_file, dependencies) => { - open Location; - List.iter( - ({txt: dependency, loc}) => - process_dependency(~loc, ~base_file, dependency), - dependencies, +let process_dependencies = (~base_file, dependencies) => { + Location.( + List.iter( + ({txt: dependency, loc}) => + process_dependency(~loc, ~base_file, dependency), + dependencies, + ) ); - Dependency_graph.compile_graph(); +}; + +let load_dependency_graph = base_file => { + let dependencies = Driver.scan_for_imports(base_file); + process_dependencies(~base_file, dependencies); +}; + +let load_dependency_graph_from_string = (name, src) => { + let dependencies = Driver.scan_string_for_imports(name, src); + process_dependencies(~base_file=name, dependencies); }; let clear_dependency_graph = () => { @@ -527,6 +497,12 @@ let get_dependencies = () => { Dependency_graph.get_dependencies(); }; +let get_out_of_date_dependencies = () => { + let out_of_date = Dependency_graph.get_out_of_date_dependencies(); + Hashtbl.clear(cmi_cache); + out_of_date; +}; + let () = { Fs_access.register_cache_flusher(( Hashtbl.remove(cmi_cache), diff --git a/compiler/src/typed/module_resolution.rei b/compiler/src/typed/module_resolution.rei index 22ff8105ed..048c514338 100644 --- a/compiler/src/typed/module_resolution.rei +++ b/compiler/src/typed/module_resolution.rei @@ -15,23 +15,17 @@ let resolve_unit: ) => string; -let compile_module_dependency: ref((string, string) => unit); - -let compile_dependency_graph: - (~base_file: string, list(Grain_parsing.Location.loc(string))) => unit; +let load_dependency_graph: string => unit; +let load_dependency_graph_from_string: (string, string) => unit; let read_file_cmi: string => Cmi_format.cmi_infos; let clear_dependency_graph: unit => unit; -// Patched in by env.re: -let with_preserve_unit: - ref((~loc: Grain_parsing.Location.t, string, string, unit => unit) => unit); - -let current_unit_name: ref(unit => string); - let current_filename: ref(unit => string); let get_dependencies: unit => list(string); +let get_out_of_date_dependencies: unit => list(string); + let dump_dependency_graph: unit => unit; diff --git a/compiler/src/typed/typemod.re b/compiler/src/typed/typemod.re index da7bb8d768..418caf754d 100644 --- a/compiler/src/typed/typemod.re +++ b/compiler/src/typed/typemod.re @@ -1051,6 +1051,7 @@ let initial_env = () => { let type_implementation = (prog: Parsetree.parsed_program) => { let sourcefile = prog.prog_loc.loc_start.pos_fname; let module_name = prog.module_name.txt; + Env.clear_imports(); Env.set_unit((module_name, sourcefile)); let initenv = initial_env(); let (statements, sg, finalenv) = type_module(initenv, prog.statements); diff --git a/compiler/test/runner.re b/compiler/test/runner.re index 58dc6293c9..b06f1d1f30 100644 --- a/compiler/test/runner.re +++ b/compiler/test/runner.re @@ -3,6 +3,7 @@ open WarningExtensions; open BinaryFileExtensions; open Grain.Compile; open Grain_utils; +open Grain_typed; open Grain_middle_end.Anftree; open Grain_middle_end.Anf_helper; @@ -22,10 +23,12 @@ let stdlibfile = name => Filepath.to_string(Fp.At.(test_stdlib_dir / (name ++ ".gr"))); let runtimefile = name => Filepath.to_string(Fp.At.(test_runtime_dir / (name ++ ".gr"))); +let objectfile = name => + Filepath.to_string(Fp.At.(test_input_dir / (name ++ ".gro"))); let wasmfile = name => Filepath.to_string(Fp.At.(test_output_dir / (name ++ ".wasm"))); let mashfile = name => - Filepath.to_string(Fp.At.(test_output_dir / (name ++ ".mashtree"))); + Filepath.to_string(Fp.At.(test_input_dir / (name ++ ".mashtree"))); let grainfmt_out_file = name => Filepath.to_string(Fp.At.(test_grainfmt_dir / (name ++ ".expected.gr"))); @@ -39,7 +42,13 @@ let graindoc_out_file = name => let gaindoc_in_file = name => Filepath.to_string(Fp.At.(test_gaindoc_dir / (name ++ ".input.gr"))); -let compile = (~num_pages=?, ~config_fn=?, ~hook=?, name, prog) => { +let compile_dependency = filename => { + let outfile = default_object_filename(filename); + let hook = stop_after_object_emitted; + ignore(compile_file(~hook, ~outfile, filename)); +}; + +let compile = (~num_pages=?, ~config_fn=?, ~hook=?, ~link=false, name, prog) => { Config.preserve_all_configs(() => { Config.with_config( Config.empty, @@ -57,13 +66,43 @@ let compile = (~num_pages=?, ~config_fn=?, ~hook=?, name, prog) => { Config.include_dirs := [Filepath.to_string(test_libs_dir), ...Config.include_dirs^]; let outfile = wasmfile(name); - compile_string(~is_root_file=true, ~hook?, ~name, ~outfile, prog); + + Config.set_root_config(); + reset_compiler_state(); + + switch (Config.wasi_polyfill^) { + | Some(name) => + Config.preserve_config(() => { + Config.compilation_mode := Grain_utils.Config.Runtime; + Module_resolution.load_dependency_graph(name); + let to_compile = Module_resolution.get_out_of_date_dependencies(); + List.iter(compile_dependency, to_compile); + compile_dependency(name); + }) + | None => () + }; + + Module_resolution.load_dependency_graph_from_string(name, prog); + let to_compile = Module_resolution.get_out_of_date_dependencies(); + List.iter(compile_dependency, to_compile); + + let main_object = default_object_filename(grainfile(name)); + let cstate = + compile_string(~hook?, ~name, ~outfile=main_object, prog); + + if (link) { + let dependencies = Module_resolution.get_dependencies(); + Grain.Link.link(~main_object, ~outfile, dependencies); + }; + + cstate; }, ) }); }; -let compile_file = (~num_pages=?, ~config_fn=?, ~hook=?, filename, outfile) => { +let compile_file = + (~num_pages=?, ~config_fn=?, ~hook=?, ~link=false, filename, outfile) => { Config.preserve_all_configs(() => { Config.with_config( Config.empty, @@ -80,7 +119,35 @@ let compile_file = (~num_pages=?, ~config_fn=?, ~hook=?, filename, outfile) => { }; Config.include_dirs := [Filepath.to_string(test_libs_dir), ...Config.include_dirs^]; - compile_file(~is_root_file=true, ~hook?, ~outfile, filename); + + Config.set_root_config(); + reset_compiler_state(); + + switch (Config.wasi_polyfill^) { + | Some(name) => + Config.preserve_config(() => { + Config.compilation_mode := Grain_utils.Config.Runtime; + Module_resolution.load_dependency_graph(name); + let to_compile = Module_resolution.get_out_of_date_dependencies(); + List.iter(compile_dependency, to_compile); + compile_dependency(name); + }) + | None => () + }; + + Module_resolution.load_dependency_graph(filename); + let to_compile = Module_resolution.get_out_of_date_dependencies(); + List.iter(compile_dependency, to_compile); + + let main_object = default_object_filename(filename); + let cstate = compile_file(~hook?, ~outfile=main_object, filename); + + if (link) { + let dependencies = Module_resolution.get_dependencies(); + Grain.Link.link(~main_object, ~outfile, dependencies); + }; + + cstate; }, ) }); @@ -236,7 +303,7 @@ let makeFilesizeRunner = (test, ~config_fn=?, ~module_header=module_header, name, prog, size) => { test(name, ({expect}) => { Config.preserve_all_configs(() => { - ignore @@ compile(~config_fn?, name, module_header ++ prog); + ignore @@ compile(~config_fn?, ~link=true, name, module_header ++ prog); let ic = open_in_bin(wasmfile(name)); let filesize = in_channel_length(ic); close_in(ic); @@ -250,7 +317,7 @@ let makeSnapshotFileRunner = (test, ~config_fn=?, name, filename) => { Config.preserve_all_configs(() => { Config.sexp_locs_enabled := false; let infile = grainfile(filename); - let outfile = wasmfile(name); + let outfile = objectfile(filename); ignore @@ compile_file( ~hook=stop_after_object_emitted, @@ -258,7 +325,7 @@ let makeSnapshotFileRunner = (test, ~config_fn=?, name, filename) => { infile, outfile, ); - expect.file(mashfile(name)).toMatchSnapshot(); + expect.file(mashfile(filename)).toMatchSnapshot(); }) }); }; @@ -318,7 +385,14 @@ let makeRunner = ) => { test(name, ({expect}) => { Config.preserve_all_configs(() => { - ignore @@ compile(~num_pages?, ~config_fn?, name, module_header ++ prog); + ignore @@ + compile( + ~num_pages?, + ~config_fn?, + ~link=true, + name, + module_header ++ prog, + ); let (result, _) = run(~num_pages?, ~extra_args?, wasmfile(name)); expect.string(result).toEqual(expected); }) @@ -338,7 +412,14 @@ let makeErrorRunner = ) => { test(name, ({expect}) => { Config.preserve_all_configs(() => { - ignore @@ compile(~num_pages?, ~config_fn?, name, module_header ++ prog); + ignore @@ + compile( + ~num_pages?, + ~config_fn?, + ~link=true, + name, + module_header ++ prog, + ); let (result, _) = run(~num_pages?, wasmfile(name)); if (check_exists) { expect.string(result).toMatch(expected); @@ -355,7 +436,8 @@ let makeFileRunner = Config.preserve_all_configs(() => { let infile = grainfile(filename); let outfile = wasmfile(name); - ignore @@ compile_file(~num_pages?, ~config_fn?, infile, outfile); + ignore @@ + compile_file(~num_pages?, ~config_fn?, ~link=true, infile, outfile); let (result, _) = run(outfile); expect.string(result).toEqual(expected); }) @@ -386,7 +468,7 @@ let makeFileErrorRunner = (test, name, filename, expected) => { ({expect}) => { let infile = grainfile(filename); let outfile = wasmfile(name); - ignore @@ compile_file(infile, outfile); + ignore @@ compile_file(~link=true, infile, outfile); let (result, _) = run(outfile); expect.string(result).toMatch(expected); }, @@ -400,7 +482,7 @@ let makeStdlibRunner = (test, ~code=0, name) => { Config.profile := Some(Release); let infile = stdlibfile(name); let outfile = wasmfile(name); - ignore @@ compile_file(infile, outfile); + ignore @@ compile_file(~link=true, infile, outfile); let (result, exit_code) = run(outfile); expect.int(exit_code).toBe(code); expect.string(result).toEqual(""); @@ -415,7 +497,7 @@ let makeRuntimeRunner = (test, ~code=0, name) => { Config.profile := Some(Release); let infile = runtimefile(name); let outfile = wasmfile(name); - ignore @@ compile_file(infile, outfile); + ignore @@ compile_file(~link=true, infile, outfile); let (result, exit_code) = run(outfile); expect.int(exit_code).toBe(code); expect.string(result).toEqual(""); diff --git a/compiler/test/suites/foreigns.re b/compiler/test/suites/foreigns.re index 8dd9de60cc..dd77c0dfe2 100644 --- a/compiler/test/suites/foreigns.re +++ b/compiler/test/suites/foreigns.re @@ -7,6 +7,7 @@ describe("foreigns", ({test}) => { let outfile = wasmfile(name); ignore @@ compile( + ~link=true, name, {| module Test diff --git a/compiler/test/suites/linking.re b/compiler/test/suites/linking.re index 9ff4975ce6..83ca926d6d 100644 --- a/compiler/test/suites/linking.re +++ b/compiler/test/suites/linking.re @@ -54,7 +54,8 @@ describe("linking", ({test, testSkip}) => { test("no_start_section", ({expect}) => { let name = "no_start_section"; let outfile = wasmfile(name); - ignore @@ compile(name, {|module Test; print("Hello, world!")|}); + ignore @@ + compile(~link=true, name, {|module Test; print("Hello, world!")|}); let ic = open_in_bin(outfile); let sections = Grain_utils.Wasm_utils.get_wasm_sections(ic); close_in(ic); @@ -90,6 +91,7 @@ describe("linking", ({test, testSkip}) => { ignore @@ compile( ~config_fn=() => {Grain_utils.Config.use_start_section := true}, + ~link=true, name, {|module Test; print("Hello, world!")|}, ); @@ -128,6 +130,7 @@ describe("linking", ({test, testSkip}) => { ignore @@ compile( ~config_fn=() => {Grain_utils.Config.import_memory := true}, + ~link=true, name, {|module Test; print("Hello, world!")|}, ); diff --git a/compiler/test/suites/modules.re b/compiler/test/suites/modules.re index ef4102b413..ac66ec4de5 100644 --- a/compiler/test/suites/modules.re +++ b/compiler/test/suites/modules.re @@ -1,5 +1,7 @@ open Grain_tests.TestFramework; open Grain_tests.Runner; +open Grain_codegen; +open Grain_typed; describe("modules", ({test, testSkip}) => { let test_or_skip = @@ -129,17 +131,14 @@ describe("modules", ({test, testSkip}) => { test("reprovided_module", ({expect}) => { let name = "reprovided_module"; let outfile = wasmfile(name); - ignore @@ - compile( - ~hook=Grain.Compile.stop_after_assembled, - name, - {| + let prog = {| module ReprovidedSimple from "simpleModule" include Simple provide { module Simple } - |}, - ); + |}; + ignore @@ compile(~link=true, name, prog); + let ic = open_in_bin(outfile); let sections = Grain_utils.Wasm_utils.get_wasm_sections(ic); close_in(ic); diff --git a/compiler/test/suites/provides.re b/compiler/test/suites/provides.re index 59938b7cd5..fca1c01c4b 100644 --- a/compiler/test/suites/provides.re +++ b/compiler/test/suites/provides.re @@ -1,5 +1,7 @@ open Grain_tests.TestFramework; open Grain_tests.Runner; +open Grain_typed; +open Grain_codegen; describe("provides", ({test, testSkip}) => { let test_or_skip = @@ -19,26 +21,25 @@ describe("provides", ({test, testSkip}) => { test( name, ({expect}) => { - let state = - compile(~hook=Grain.Compile.stop_after_compiled, name, prog); - (); - switch (state.Grain.Compile.cstate_desc) { - | Compiled({asm}) => - let num_exports = Binaryen.Export.get_num_exports(asm); - let exports = - List.init( - num_exports, - i => { - let export = Binaryen.Export.get_export_by_index(asm, i); - ( - Binaryen.Export.get_name(export), - Binaryen.Export.export_get_kind(export), - ); - }, - ); - List.iter(expect.list(exports).toContainEqual, expectedExports); - | _ => assert(false) - }; + ignore(compile(name, prog)); + + let main_object = objectfile(name); + let dependencies = Module_resolution.get_dependencies(); + let linked_program = Linkedtree.link(~main_object, dependencies); + let asm = Compmod.compile_wasm_module(linked_program).asm; + let num_exports = Binaryen.Export.get_num_exports(asm); + let exports = + List.init( + num_exports, + i => { + let export = Binaryen.Export.get_export_by_index(asm, i); + ( + Binaryen.Export.get_name(export), + Binaryen.Export.export_get_kind(export), + ); + }, + ); + List.iter(expect.list(exports).toContainEqual, expectedExports); }, ); };