feat(compiler): Arbitrary-position spreads

Author: alex-snezhko

compiler/src/codegen/compcore.re

@@ -76,6 +76,15 @@ let equal_mod = "GRAIN$MODULE$runtime/equal";
 let equal_ident = Ident.create_persistent("equal");
 let equal_closure_ident = Ident.create_persistent("GRAIN$EXPORT$equal");
 
+/* List concat */
+let collection_concat_mod = "GRAIN$MODULE$runtime/concat";
+let list_concat_ident = Ident.create_persistent("listConcat");
+let list_concat_closure_ident =
+  Ident.create_persistent("GRAIN$EXPORT$listConcat");
+let array_concat_ident = Ident.create_persistent("arrayConcat");
+let array_concat_closure_ident =
+  Ident.create_persistent("GRAIN$EXPORT$arrayConcat");
+
 /* JS-runner support */
 let console_mod = "console";
 let tracepoint_ident = Ident.create_persistent("tracepoint");
@@ -147,6 +156,24 @@ let grain_runtime_imports = [
     mimp_setup: MSetupNone,
     mimp_used: false,
   },
+  {
+    mimp_id: list_concat_closure_ident,
+    mimp_mod: collection_concat_mod,
+    mimp_name: Ident.name(list_concat_closure_ident),
+    mimp_type: MGlobalImport(Types.Unmanaged(WasmI32), true),
+    mimp_kind: MImportWasm,
+    mimp_setup: MSetupNone,
+    mimp_used: false,
+  },
+  {
+    mimp_id: array_concat_closure_ident,
+    mimp_mod: collection_concat_mod,
+    mimp_name: Ident.name(array_concat_closure_ident),
+    mimp_type: MGlobalImport(Types.Unmanaged(WasmI32), true),
+    mimp_kind: MImportWasm,
+    mimp_setup: MSetupNone,
+    mimp_used: false,
+  },
 ];
 
 let runtime_global_imports =
@@ -230,6 +257,24 @@ let grain_function_imports = [
     mimp_setup: MSetupNone,
     mimp_used: false,
   },
+  {
+    mimp_id: list_concat_ident,
+    mimp_mod: collection_concat_mod,
+    mimp_name: Ident.name(list_concat_ident),
+    mimp_type: MFuncImport([Types.Managed, Types.Managed], [Types.Managed]),
+    mimp_kind: MImportWasm,
+    mimp_setup: MSetupNone,
+    mimp_used: false,
+  },
+  {
+    mimp_id: array_concat_ident,
+    mimp_mod: collection_concat_mod,
+    mimp_name: Ident.name(array_concat_ident),
+    mimp_type: MFuncImport([Types.Managed, Types.Managed], [Types.Managed]),
+    mimp_kind: MImportWasm,
+    mimp_setup: MSetupNone,
+    mimp_used: false,
+  },
 ];
 
 let runtime_function_imports =
@@ -388,6 +433,44 @@ let call_equal = (wasm_mod, env, args) =>
     ],
     Type.int32,
   );
+let call_list_concat = (wasm_mod, env, args) => {
+  let args = [
+    Expression.Global_get.make(
+      wasm_mod,
+      get_wasm_imported_name(
+        collection_concat_mod,
+        list_concat_closure_ident,
+      ),
+      Type.int32,
+    ),
+    ...args,
+  ];
+  Expression.Call.make(
+    wasm_mod,
+    get_wasm_imported_name(collection_concat_mod, list_concat_ident),
+    args,
+    Type.int32,
+  );
+};
+let call_array_concat = (wasm_mod, env, args) => {
+  let args = [
+    Expression.Global_get.make(
+      wasm_mod,
+      get_wasm_imported_name(
+        collection_concat_mod,
+        array_concat_closure_ident,
+      ),
+      Type.int32,
+    ),
+    ...args,
+  ];
+  Expression.Call.make(
+    wasm_mod,
+    get_wasm_imported_name(collection_concat_mod, array_concat_ident),
+    args,
+    Type.int32,
+  );
+};
 
 /** Will print "tracepoint <n> reached" to the console when executed (for debugging WASM output) */
 
@@ -3029,6 +3112,14 @@ and compile_instr = (wasm_mod, env, instr) =>
     compile_record_op(wasm_mod, env, record, record_op)
   | MClosureOp(closure_op, closure) =>
     compile_closure_op(wasm_mod, env, closure, closure_op)
+  | MCollectionConcat(t, colls) =>
+    let colls_arr = allocate_array(wasm_mod, env, colls);
+    let concat =
+      switch (t) {
+      | TExpListConcat => call_list_concat
+      | TExpArrayConcat => call_array_concat
+      };
+    concat(wasm_mod, env, [colls_arr]);
   | MPrim0(p0) => compile_prim0(wasm_mod, env, p0)
   | MPrim1(p1, arg) => compile_prim1(wasm_mod, env, p1, arg, instr.instr_loc)
   | MPrim2(p2, arg1, arg2) => compile_prim2(wasm_mod, env, p2, arg1, arg2)

compiler/src/codegen/mashtree.re

@@ -438,6 +438,7 @@ and instr_desc =
   | MAdtOp(adt_op, immediate)
   | MRecordOp(record_op, immediate)
   | MClosureOp(closure_op, immediate)
+  | MCollectionConcat(Typedtree.collection_concat_type, list(immediate))
   | MStore(list((binding, instr))) /* Items in the same list have their backpatching delayed until the end of that list */
   | MSet(binding, instr)
   | MDrop(instr, Types.allocation_type) /* Ignore the result of an expression. Used for sequences. */

compiler/src/codegen/transl_anf.re

@@ -185,6 +185,8 @@ module RegisterAllocation = {
       | MArrayOp(aop, i) => MArrayOp(aop, apply_allocation_to_imm(i))
       | MRecordOp(rop, i) => MRecordOp(rop, apply_allocation_to_imm(i))
       | MAdtOp(aop, i) => MAdtOp(aop, apply_allocation_to_imm(i))
+      | MCollectionConcat(t, colls) =>
+        MCollectionConcat(t, List.map(apply_allocation_to_imm, colls))
       | MClosureOp(cop, i) => MClosureOp(cop, apply_allocation_to_imm(i))
       | MCallRaw({func, func_type, args}) =>
         MCallRaw({
@@ -308,6 +310,7 @@ let run_register_allocation = (instrs: list(Mashtree.instr)) => {
     | MAdtOp(_, imm)
     | MClosureOp(_, imm) => imm_live_local(imm)
     | MCallRaw({args: is})
+    | MCollectionConcat(_, is)
     | MError(_, is) => List.concat(List.map(imm_live_local, is))
     | MCallKnown({closure: imm, args: is})
     | MReturnCallKnown({closure: imm, args: is})
@@ -908,6 +911,8 @@ let rec compile_comp = (~id=?, env, c) => {
         MRecordSet(idx, compile_imm(env, arg)),
         compile_imm(env, record),
       )
+    | CCollectionConcat(t, lists) =>
+      MCollectionConcat(t, List.map(compile_imm(env), lists))
     | CLambda(name, args, body) =>
       let (body, return_type) = body;
       let body = (body, [return_type]);

compiler/src/formatting/debug.re

@@ -61,6 +61,8 @@ let debug_expression = (expr: Parsetree.expression) => {
     print_loc("PExpRecordGet", expr.pexp_loc)
   | PExpRecordSet(expression, {txt, _}, expression2) =>
     print_loc("PExpRecordSet", expr.pexp_loc)
+  | PExpCollectionConcat(t, colls) =>
+    print_loc("PExpCollectionConcat", expr.pexp_loc)
   | PExpMatch(expression, match_branches) =>
     print_loc("PExpMatch", expr.pexp_loc)
   | PExpPrim0(prim0) => print_loc("PExpPrim0", expr.pexp_loc)