feat: Grain implementation of toString/print (#540)

* feat: Grain implementation of toString/print * Have CLI require toString and rework GC tests * Document compilation modes * Match types in re/rei * Remove unused code Co-authored-by: Blaine Bublitz <[email protected]> Co-authored-by: Blaine Bublitz <[email protected]>
grain-lang · Mar 9, 2021 · 8c77905 · 8c77905
1 parent f18d26e
commit 8c77905
Show file tree

Hide file tree

Showing 20 changed files with 1,891 additions and 2,306 deletions.
diff --git a/cli/bin/run.js b/cli/bin/run.js
@@ -9,6 +9,7 @@ module.exports = async function run(filename, options) {
     let GrainRunner = runtime.buildGrainRunner(locator);
     if (options.printOutput) {
       let result = await GrainRunner.runFileUnboxed(filename);
+      await GrainRunner.ensureStringModule();
       console.log(GrainRunner.grainValueToString(result));
     } else {
       await GrainRunner.runFile(filename);

diff --git a/compiler/src/codegen/compcore.re b/compiler/src/codegen/compcore.re
@@ -48,9 +48,9 @@ let malloc_mod = Ident.create_persistent("GRAIN$MODULE$runtime/malloc");
 let gc_mod = Ident.create_persistent("GRAIN$MODULE$runtime/gc");
 let data_structures_mod =
   Ident.create_persistent("GRAIN$MODULE$runtime/dataStructures");
-let stdlib_external_runtime_mod =
-  Ident.create_persistent("stdlib-external/runtime");
-let grain_to_string_ident = Ident.create_persistent("grainToString");
+let string_runtime_mod =
+  Ident.create_persistent("GRAIN$MODULE$runtime/string");
+let grain_to_string_ident = Ident.create_persistent("toString");
 let console_mod = Ident.create_persistent("console");
 let throw_error_ident = Ident.create_persistent("throwError");
 let malloc_ident = Ident.create_persistent("malloc");
@@ -264,14 +264,6 @@ let grain_function_imports = [
     mimp_kind: MImportWasm,
     mimp_setup: MSetupNone,
   },
-  // HACK: Depend on stdlib-external/runtime for the tests
-  {
-    mimp_mod: stdlib_external_runtime_mod,
-    mimp_name: grain_to_string_ident,
-    mimp_type: MFuncImport([I32Type], [I32Type]),
-    mimp_kind: MImportWasm,
-    mimp_setup: MSetupNone,
-  },
 ];
 
 let runtime_function_imports =

diff --git a/compiler/src/typed/env.re b/compiler/src/typed/env.re
@@ -663,9 +663,10 @@ let get_components = c =>
   };
 
 type compilation_mode =
-  | Normal
-  | Runtime
-  | MemoryAllocation;
+  | Normal /* Standard compilation with regular bells and whistles */
+  | ManagedRuntime /* Normal mode, but no Pervasives yet */
+  | Runtime /* GC doesn't exist yet, allocations happen in runtime heap */
+  | MemoryAllocation /* You _are_ the memory allocator and control the pointer to the runtime heap  */;
 
 let current_unit = ref(("", "", Normal));
 
@@ -677,14 +678,25 @@ let is_runtime_mode = () => {
   switch (current_unit^) {
   | (_, _, Runtime) => true
   | (_, _, MemoryAllocation) => true
+  | (_, _, ManagedRuntime) => false
+  | (_, _, Normal) => false
+  };
+};
+
+let is_managed_runtime_mode = () => {
+  switch (current_unit^) {
+  | (_, _, Runtime) => false
+  | (_, _, MemoryAllocation) => false
+  | (_, _, ManagedRuntime) => true
   | (_, _, Normal) => false
   };
 };
 
 let is_malloc_mode = () => {
   switch (current_unit^) {
-  | (_, _, MemoryAllocation) => true
   | (_, _, Runtime) => false
+  | (_, _, MemoryAllocation) => true
+  | (_, _, ManagedRuntime) => false
   | (_, _, Normal) => false
   };
 };

diff --git a/compiler/src/typed/env.rei b/compiler/src/typed/env.rei
@@ -162,12 +162,14 @@ let add_signature: (signature, t) => t;
 /* Remember the current compilation unit: modname * filename * compilation mode. */
 type compilation_mode =
   | Normal
+  | ManagedRuntime
   | Runtime
   | MemoryAllocation;
 
 let set_unit: ((string, string, compilation_mode)) => unit;
 let get_unit: unit => (string, string, compilation_mode);
 let is_runtime_mode: unit => bool;
+let is_managed_runtime_mode: unit => bool;
 let is_malloc_mode: unit => bool;
 
 /* Insertion of all fields of a signature, relative to the given path.

diff --git a/compiler/src/typed/typemod.re b/compiler/src/typed/typemod.re
@@ -861,7 +861,16 @@ let initial_env = () => {
   Ident.reinit();
   let initial = Env.initial_safe_string;
   let env = initial;
-  let (unit_name, source, _) = Env.get_unit();
+  let (unit_name, source, mode) = Env.get_unit();
+  let implicit_modules =
+    if (Env.is_managed_runtime_mode()) {
+      List.filter(
+        ((name, _, _)) => name != "Pervasives",
+        implicit_modules^,
+      );
+    } else {
+      implicit_modules^;
+    };
   if (Env.is_runtime_mode()) {
     env;
   } else {
@@ -875,14 +884,15 @@ let initial_env = () => {
         };
       },
       env,
-      implicit_modules^,
+      implicit_modules,
     );
   };
 };
 
 let get_compilation_mode = prog => {
   switch (prog.comments) {
   | [Block({cmt_content: "compilation-mode: runtime"}), ..._] => Env.Runtime
+  | [Block({cmt_content: "compilation-mode: managed-runtime"}), ..._] => Env.ManagedRuntime
   | [Block({cmt_content: "compilation-mode: malloc"}), ..._] => Env.MemoryAllocation
   | _ => Env.Normal
   };

diff --git a/compiler/test/input/fib-gc.gr b/compiler/test/input/fib-gc.gr
@@ -9,4 +9,4 @@ let fib = (x) => {
   };
   fib_help(x, (0, 1))
 };
-fib(30)
+print(fib(30))
diff --git a/compiler/test/input/long_lists.gr b/compiler/test/input/long_lists.gr
@@ -20,4 +20,4 @@ loop = (n) => {
   }
 };
 
-loop(25) // <- eats up a lot of heap
+print(loop(25)) // <- eats up a lot of heap
diff --git a/compiler/test/runner.re b/compiler/test/runner.re
@@ -108,11 +108,14 @@ let read_stream = cstream => {
   Bytes.to_string @@ Bytes.sub(buf, 0, i^);
 };
 
-let run_output = (~code=0, ~num_pages=?, cstate, test_ctxt) => {
+let run_output =
+    (~code=0, ~num_pages=?, ~print_output=true, cstate, test_ctxt) => {
   let program = extract_wasm(cstate);
   let file = Filename.temp_file("test", ".gr.wasm");
   Emitmod.emit_module(program, file);
 
+  let cli_flags = if (print_output) {"-pg"} else {"-g"};
+
   let stdlib = Option.get(Grain_utils.Config.stdlib_dir^);
   let testlibs = Sys.getcwd() ++ "/test-libs";
   let result = ref("");
@@ -133,7 +136,7 @@ let run_output = (~code=0, ~num_pages=?, cstate, test_ctxt) => {
     ~ctxt=test_ctxt,
     ~env,
     "grain",
-    ["-pg", "-S", stdlib, "-I", testlibs, "run", file],
+    [cli_flags, "-S", stdlib, "-I", testlibs, "run", file],
   );
   result^;
 };
@@ -148,18 +151,32 @@ let run_anf = (p, out) => {
 };
 
 let test_run =
-    (~cmp=?, ~num_pages=?, program_str, outfile, expected, test_ctxt) => {
+    (
+      ~cmp=?,
+      ~num_pages=?,
+      ~print_output=true,
+      program_str,
+      outfile,
+      expected,
+      test_ctxt,
+    ) => {
   let result =
     Config.preserve_config(() => {
       Config.include_dirs := ["test-libs", ...Config.include_dirs^];
       let cstate =
         compile_string(~hook=stop_after_compiled, ~name=outfile, program_str);
-      run_output(~num_pages?, cstate, test_ctxt);
+      run_output(~num_pages?, ~print_output, cstate, test_ctxt);
     });
+  let expected =
+    if (print_output) {
+      expected ++ "\n";
+    } else {
+      expected;
+    };
   assert_equal(
     ~printer=Fun.id,
     ~cmp=Option.value(~default=(==), cmp),
-    expected ++ "\n",
+    expected,
     result,
   );
 };
@@ -237,7 +254,15 @@ let test_run_anf = (program_anf, outfile, expected, test_ctxt) => {
   assert_equal(expected ++ "\n", result, ~printer=Fun.id);
 };
 
-let test_err = (~num_pages=?, program_str, outfile, errmsg, test_ctxt) => {
+let test_err =
+    (
+      ~num_pages=?,
+      ~print_output=true,
+      program_str,
+      outfile,
+      errmsg,
+      test_ctxt,
+    ) => {
   let result =
     try(
       Config.preserve_config(() => {
@@ -248,7 +273,7 @@ let test_err = (~num_pages=?, program_str, outfile, errmsg, test_ctxt) => {
             ~name=outfile,
             program_str,
           );
-        run_output(~num_pages?, cstate, test_ctxt);
+        run_output(~num_pages?, ~print_output, cstate, test_ctxt);
       })
     ) {
     | exn => Printexc.to_string(exn)

diff --git a/compiler/test/test_end_to_end.re b/compiler/test/test_end_to_end.re
@@ -37,7 +37,8 @@ let make_gc_program = (program, heap_size) => {
       // Calculate how much memory to leak
       let toLeak = WasmI32.sub(availableMemory, %dn)
       // Memory is not reclaimed due to no gc context
-      Memory.malloc(toLeak);
+      // This will actually leak 16 extra bytes because of the headers
+      Memory.malloc(WasmI32.sub(toLeak, 16n));
     }
   leak();
   %s
@@ -47,17 +48,29 @@ let make_gc_program = (program, heap_size) => {
   );
 };
 
-let tgc = (~todo=?, name, heap_size, program, expected) => {
+let tgc = (~todo=?, name, heap_size, program) => {
   name
   >:: wrap_todo(todo) @@
-  test_run(~num_pages=1, make_gc_program(program, heap_size), name, expected);
+  test_run(
+    ~num_pages=1,
+    ~print_output=false,
+    make_gc_program(program, heap_size),
+    name,
+    "",
+  );
 };
 let terr = (~todo=?, name, program, expected) =>
   name >:: wrap_todo(todo) @@ test_err(program, name, expected);
 let tgcerr = (~todo=?, name, heap_size, program, expected) =>
   name
   >:: wrap_todo(todo) @@
-  test_err(~num_pages=1, make_gc_program(program, heap_size), name, expected);
+  test_err(
+    ~num_pages=1,
+    ~print_output=false,
+    make_gc_program(program, heap_size),
+    name,
+    expected,
+  );
 
 let te = (~todo=?, name, program, expected) =>
   name >:: wrap_todo(todo) @@ test_err(program, name, expected);
@@ -88,6 +101,7 @@ let tgcfile = (~todo=?, name, heap_size, input_file, expected) =>
   >:: wrap_todo(todo) @@
   test_err(
     ~num_pages=1,
+    ~print_output=false,
     make_gc_program(
       read_whole_file("input/" ++ input_file ++ ".gr"),
       heap_size,
@@ -395,7 +409,7 @@ let function_tests = [
      let item = Calzone(Peppers, WholeWheat,)
      item
     ",
-    "<adt value>",
+    "<enum value>",
   ),
   t("lam_destructure_1", "((_) => 5)(\"foo\")", "5"),
   t("lam_destructure_2", "let foo = (_) => 5; foo(\"foo\")", "5"),
@@ -1037,27 +1051,25 @@ let loop_tests = [
 ];
 
 let oom = [
-  tgcerr("oomgc1", 70, "(1, (3, 4))", "Maximum memory size exceeded"),
-  tgc("oomgc2", 356, "(1, (3, 4))", "(1, (3, 4))"),
-  tgc("oomgc3", 256, "(3, 4)", "(3, 4)"),
+  tgcerr("oomgc1", 48, "(1, (3, 4))", "Maximum memory size exceeded"),
+  tgc("oomgc2", 64, "(1, (3, 4))"),
+  tgc("oomgc3", 32, "(3, 4)"),
 ];
 
 let gc = [
   tgc(
     "gc1",
-    512,
+    160,
     "let f = (() => (1, 2));\n       {\n         f();\n         f();\n         f();\n         f()\n       }",
-    "(1, 2)",
   ),
   /* Test that cyclic tuples are GC'd properly */
   tgc(
     "gc2",
-    2560,
+    256,
     "enum Opt<x> { None, Some(x) };\n     let f = (() => {\n      let x = (box(None), 2);\n      let (fst, _) = x\n      fst := Some(x)\n      });\n      {\n        f();\n        let x = (1, 2);\n        x\n      }",
-    "(1, 2)",
   ),
   tgcfile("fib_gc_err", 1024, "fib-gc", "Maximum memory size exceeded"),
-  tgcfile("fib_gc", 3424, "fib-gc", "832040"),
+  tgcfile("fib_gc", 2048, "fib-gc", "832040"),
   /* tgcfile "fib_gc_bigger" 3072 "fib-gc" "832040";
      tgcfile "fib_gc_biggest" 512 "fib-gc" "832040"; */
   /* I've manually tested this test, but see TODO for automated testing */
@@ -1966,7 +1978,7 @@ let char_tests = [
 ];
 
 let exception_tests = [
-  t("exception_1", "exception Foo; Foo", "<adt value>"),
+  t("exception_1", "exception Foo; Foo", "<enum value>"),
   t("exception_2", "export exception Foo; Foo", "Foo"),
   t(
     "exception_3",
@@ -1987,11 +1999,11 @@ let enum_tests = [
     "adtprint",
     "Foo\nBar\nBaz(\"baz\")\nQux(5, \"qux\", false)\nQuux\nFlip(\"flip\")\nvoid",
   ),
-  t("adtprint_nonexported", "enum Foo { Foo }; Foo", "<adt value>"),
+  t("adtprint_nonexported", "enum Foo { Foo }; Foo", "<enum value>"),
   t(
     "adt_trailing",
     "enum Topping { Cheese(Bool,), Pepperoni }; Pepperoni",
-    "<adt value>",
+    "<enum value>",
   ),
 ];