changed concat functionality, other minor changes

alex-snezhko · alex-snezhko · commit 7af1d6a7994d · 2023-06-05T02:05:08.000+02:00
diff --git a/compiler/src/codegen/compcore.re b/compiler/src/codegen/compcore.re
@@ -3016,14 +3016,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);
+  | MCollectionConcat(t, collections) =>
+    let collections_arr = allocate_array(wasm_mod, env, collections);
     let concat =
       switch (t) {
       | TExpListConcat => call_list_concat
       | TExpArrayConcat => call_array_concat
       };
-    concat(wasm_mod, env, [colls_arr]);
+    concat(wasm_mod, env, [collections_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)
diff --git a/compiler/src/formatting/debug.re b/compiler/src/formatting/debug.re
@@ -61,7 +61,7 @@ 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) =>
+  | PExpCollectionConcat(t, collections) =>
     print_loc("PExpCollectionConcat", expr.pexp_loc)
   | PExpMatch(expression, match_branches) =>
     print_loc("PExpMatch", expr.pexp_loc)
diff --git a/compiler/src/formatting/format.re b/compiler/src/formatting/format.re
@@ -2971,8 +2971,8 @@ and print_expression_inner =
           print_ident(txt),
         ]);
       print_assignment(~original_source, ~comments, left, expression2);
-    | PExpCollectionConcat(concat_t, colls) =>
-      let list_length = List.length(colls);
+    | PExpCollectionConcat(concat_t, collections) =>
+      let list_length = List.length(collections);
 
       let items =
         List.mapi(
@@ -2988,7 +2988,7 @@ and print_expression_inner =
             //  3]
             let end_line_comments =
               if (index < list_length - 2) {
-                let (_, next_e) = List.nth(colls, index + 1);
+                let (_, next_e) = List.nth(collections, index + 1);
                 Comment_utils.get_comments_between_locations(
                   ~loc1=e.Parsetree.pexp_loc,
                   ~loc2=next_e.pexp_loc,
@@ -3050,7 +3050,7 @@ and print_expression_inner =
               };
             (expr, end_line_comments);
           },
-          colls,
+          collections,
         );
 
       let (last_line_breaks_for_comments, list_items) =
diff --git a/compiler/src/middle_end/analyze_free_vars.re b/compiler/src/middle_end/analyze_free_vars.re
@@ -109,11 +109,11 @@ module FreeVarsArg: Anf_iterator.IterArgument = {
           Ident.Set.empty,
           [arg1, arg2, arg3],
         )
-      | CCollectionConcat(t, colls) =>
+      | CCollectionConcat(t, collections) =>
         List.fold_left(
           (acc, a) => Ident.Set.union(imm_free_vars(a), acc),
           Ident.Set.empty,
-          colls,
+          collections,
         )
       | CRecord(_, _, args) =>
         List.fold_left(
diff --git a/compiler/src/middle_end/anf_helper.re b/compiler/src/middle_end/anf_helper.re
@@ -146,13 +146,13 @@ module Comp = {
       ~env?,
       CSetRecordItem(idx, record, arg),
     );
-  let collection_concat = (~loc=?, ~attributes=?, ~env=?, t, colls) =>
+  let collection_concat = (~loc=?, ~attributes=?, ~env=?, t, collections) =>
     mk(
       ~loc?,
       ~attributes?,
       ~allocation_type=Managed,
       ~env?,
-      CCollectionConcat(t, colls),
+      CCollectionConcat(t, collections),
     );
   let if_ = (~loc=?, ~attributes=?, ~allocation_type, ~env=?, cond, tru, fals) =>
     mk(~loc?, ~attributes?, ~allocation_type, ~env?, CIf(cond, tru, fals));
diff --git a/compiler/src/middle_end/anf_iterator.re b/compiler/src/middle_end/anf_iterator.re
@@ -83,7 +83,8 @@ module MakeIter = (Iter: IterArgument) => {
     | CSetRecordItem(_, record, arg) =>
       iter_imm_expression(record);
       iter_imm_expression(arg);
-    | CCollectionConcat(_, colls) => List.iter(iter_imm_expression, colls)
+    | CCollectionConcat(_, collections) =>
+      List.iter(iter_imm_expression, collections)
     | CIf(c, t, f) =>
       iter_imm_expression(c);
       iter_anf_expression(t);
diff --git a/compiler/src/middle_end/anf_mapper.re b/compiler/src/middle_end/anf_mapper.re
@@ -196,9 +196,9 @@ module MakeMap = (Iter: MapArgument) => {
           process_imm_expression(arg),
         ),
       )
-    | CCollectionConcat(t, colls) =>
+    | CCollectionConcat(t, collections) =>
       leave_with(
-        CCollectionConcat(t, List.map(process_imm_expression, colls)),
+        CCollectionConcat(t, List.map(process_imm_expression, collections)),
       )
     | CIf(cond, t, f) =>
       let cond = process_imm_expression(cond);
diff --git a/compiler/src/middle_end/linearize.re b/compiler/src/middle_end/linearize.re
@@ -929,9 +929,10 @@ let rec transl_imm =
         ),
       ],
     );
-  | TExpCollectionConcat(t, colls) =>
+  | TExpCollectionConcat(t, collections) =>
     let tmp = gensym("catcollection");
-    let (new_args, new_setup) = List.split(List.map(transl_imm, colls));
+    let (new_args, new_setup) =
+      List.split(List.map(transl_imm, collections));
     (
       Imm.id(~loc, ~env, tmp),
       List.concat(new_setup)
diff --git a/compiler/src/parsing/ast_helper.re b/compiler/src/parsing/ast_helper.re
@@ -38,6 +38,10 @@ type id = loc(Identifier.t);
 type str = loc(string);
 type loc = Location.t;
 
+type array_concat_item =
+  | ArrayConcatItems(list(expression))
+  | ArrayConcatSpread(expression);
+
 let ident_empty = {
   txt: Identifier.IdentName(Location.mknoloc("[]")),
   loc: Location.dummy_loc,
@@ -433,41 +437,49 @@ module Expression = {
             tuple_construct(~loc, ~attributes?, ident_cons, [expr, empty])
           | ListSpread(expr, _) => expr
           };
-        if (List.exists(
-              expr =>
-                switch (expr) {
-                | ListSpread(_) => true
-                | ListItem(_) => false
-                },
-              rest,
-            )) {
-          collection_concat(
-            ~loc,
-            ~attributes?,
-            PExpListConcat,
-            List.map(
-              expr =>
+        let has_nonfinal_spread =
+          List.exists(
+            expr =>
+              switch (expr) {
+              | ListSpread(_) => true
+              | ListItem(_) => false
+              },
+            rest,
+          );
+        if (has_nonfinal_spread) {
+          let grouped =
+            List.fold_left(
+              (acc, expr) => {
                 switch (expr) {
-                | ListSpread(expr, loc) => (
-                    PExpSpreadExpr,
+                | ListSpread(expr, loc) => [
                     {...expr, pexp_loc: loc},
-                  )
-                | ListItem(expr) => (
-                    PExpNonSpreadExpr,
-                    // Still convert to a single-element list to make later compilation steps easier
+                    ...acc,
+                  ]
+                | ListItem(expr) =>
+                  let (first, rest) =
+                    switch (acc) {
+                    | [first, ...rest] => (first, rest)
+                    | _ => assert(false)
+                    };
+                  [
                     tuple_construct(
-                      ~loc=expr.pexp_loc,
+                      ~loc,
                       ~attributes?,
                       ident_cons,
-                      [
-                        expr,
-                        tuple_construct(~loc=expr.pexp_loc, ident_empty, []),
-                      ],
+                      [expr, first],
                     ),
-                  )
-                },
-              a,
-            ),
+                    ...rest,
+                  ];
+                }
+              },
+              [base],
+              rest,
+            );
+          collection_concat(
+            ~loc,
+            ~attributes?,
+            PExpListConcat,
+            List.map(expr => (PExpSpreadExpr, expr), grouped),
           );
         } else {
           List.fold_left(
@@ -489,51 +501,70 @@ module Expression = {
     {...list, pexp_loc: loc};
   };
   let array_items = (~loc, ~attributes=?, a) => {
-    let no_spreads =
-      List.for_all(
+    let has_spread =
+      List.exists(
         x => {
           switch (x) {
-          | ArrayItem(_) => true
-          | ArraySpread(_) => false
+          | ArraySpread(_) => true
+          | ArrayItem(_) => false
           }
         },
         a,
       );
-    if (no_spreads) {
-      array(
-        ~loc,
-        ~attributes?,
-        List.map(
-          expr =>
+    if (has_spread) {
+      let grouped =
+        List.fold_right(
+          (expr, acc) => {
             switch (expr) {
-            | ArraySpread(_) =>
-              failwith(
-                "Impossible: spread in array when existence has been disproven",
-              )
-            | ArrayItem(expr) => expr
-            },
+            | ArrayItem(expr) =>
+              switch (acc) {
+              | [ArrayConcatItems(exprs), ...rest] => [
+                  ArrayConcatItems([expr, ...exprs]),
+                  ...rest,
+                ]
+              | _ => [ArrayConcatItems([expr]), ...acc]
+              }
+            | ArraySpread(expr, loc) => [
+                ArrayConcatSpread({...expr, pexp_loc: loc}),
+                ...acc,
+              ]
+            }
+          },
           a,
-        ),
-      );
-    } else {
+          [],
+        );
       collection_concat(
         ~loc,
         ~attributes?,
         PExpArrayConcat,
         List.map(
           x => {
             switch (x) {
-            | ArrayItem(expr) => (
+            | ArrayConcatItems([first, ...rest] as exprs) => (
                 PExpNonSpreadExpr,
-                // Still convert to a single-element array to make later compilation steps easier
-                array(~loc=expr.pexp_loc, ~attributes?, [expr]),
-              )
-            | ArraySpread(expr, loc) => (
-                PExpSpreadExpr,
-                {...expr, pexp_loc: loc},
+                array(~loc=first.pexp_loc, ~attributes?, exprs),
               )
+            | ArrayConcatItems([]) =>
+              failwith("Impossible: empty ArrayConcatItems")
+            | ArrayConcatSpread(expr) => (PExpSpreadExpr, expr)
             }
           },
+          grouped,
+        ),
+      );
+    } else {
+      array(
+        ~loc,
+        ~attributes?,
+        List.map(
+          expr =>
+            switch (expr) {
+            | ArraySpread(_) =>
+              failwith(
+                "Impossible: spread in array when existence has been disproven",
+              )
+            | ArrayItem(expr) => expr
+            },
           a,
         ),
       );
diff --git a/compiler/src/parsing/ast_mapper.re b/compiler/src/parsing/ast_mapper.re
@@ -87,12 +87,12 @@ module E = {
         map_loc(sub, f),
         sub.expr(sub, v),
       )
-    | PExpCollectionConcat(t, colls) =>
+    | PExpCollectionConcat(t, collections) =>
       collection_concat(
         ~loc,
         ~attributes,
         t,
-        List.map(((t, expr)) => (t, sub.expr(sub, expr)), colls),
+        List.map(((t, expr)) => (t, sub.expr(sub, expr)), collections),
       )
     | PExpLet(r, m, vbs) =>
       let_(~loc, ~attributes, r, m, List.map(sub.value_binding(sub), vbs))
diff --git a/compiler/src/typed/typecore.re b/compiler/src/typed/typecore.re
@@ -979,25 +979,28 @@ and type_expect_ =
       exp_type: Builtin_types.type_void,
       exp_env: env,
     });
-  | PExpCollectionConcat(t, colls) =>
+  | PExpCollectionConcat(t, collections) =>
     let (mk_builtin_type, texp_type) =
       switch (t) {
       | PExpListConcat => (Builtin_types.type_list, TExpListConcat)
       | PExpArrayConcat => (Builtin_types.type_array, TExpArrayConcat)
       };
-    let coll_type = mk_builtin_type(newvar());
-    with_explanation(() => unify_exp_types(loc, env, coll_type, ty_expected));
-    let typed_colls =
+    let collection_type = mk_builtin_type(newvar());
+    with_explanation(() =>
+      unify_exp_types(loc, env, collection_type, ty_expected)
+    );
+    let typed_collections =
       List.map(
-        ((_, expr)) => type_expect(env, expr, mk_expected(coll_type)),
-        colls,
+        ((_, expr)) =>
+          type_expect(env, expr, mk_expected(collection_type)),
+        collections,
       );
     rue({
-      exp_desc: TExpCollectionConcat(texp_type, typed_colls),
+      exp_desc: TExpCollectionConcat(texp_type, typed_collections),
       exp_loc: loc,
       exp_extra: [],
       exp_attributes: attributes,
-      exp_type: coll_type,
+      exp_type: collection_type,
       exp_env: env,
     });
   | PExpLet(rec_flag, mut_flag, pats) =>
diff --git a/compiler/src/typed/typedtreeIter.re b/compiler/src/typed/typedtreeIter.re
@@ -247,7 +247,8 @@ module MakeIterator =
       iter_expression(a1);
       iter_expression(a2);
       iter_expression(a3);
-    | TExpCollectionConcat(_, colls) => List.iter(iter_expression, colls)
+    | TExpCollectionConcat(_, collections) =>
+      List.iter(iter_expression, collections)
     | TExpIf(c, t, f) =>
       iter_expression(c);
       iter_expression(t);
diff --git a/compiler/src/typed/typedtreeMap.re b/compiler/src/typed/typedtreeMap.re
@@ -249,8 +249,8 @@ module MakeMap =
           ld,
           map_expression(arg),
         )
-      | TExpCollectionConcat(t, colls) =>
-        TExpCollectionConcat(t, List.map(map_expression, colls))
+      | TExpCollectionConcat(t, collections) =>
+        TExpCollectionConcat(t, List.map(map_expression, collections))
       | TExpBlock(args) => TExpBlock(List.map(map_expression, args))
       | TExpConstruct(a, b, TExpConstrTuple(args)) =>
         TExpConstruct(a, b, TExpConstrTuple(List.map(map_expression, args)))
diff --git a/compiler/test/suites/arrays.re b/compiler/test/suites/arrays.re
@@ -122,8 +122,8 @@ describe("arrays", ({test, testSkip}) => {
   );
   assertRun(
     "array_spread2",
-    "let a = [> 1, 2, 3]; print([> 0, ...a])",
-    "[> 0, 1, 2, 3]\n",
+    "let a = [> 4, 5]; print([> 1, 2, 3, ...a, 6])",
+    "[> 1, 2, 3, 4, 5, 6]\n",
   );
   assertRun(
     "array_spread3",
diff --git a/compiler/test/suites/lists.re b/compiler/test/suites/lists.re
diff --git a/stdlib/runtime/concat.gr b/stdlib/runtime/concat.gr
diff --git a/stdlib/runtime/concat.md b/stdlib/runtime/concat.md

Original file line number	Diff line number	Diff line change
`@@ -109,11 +109,11 @@ module FreeVarsArg: Anf_iterator.IterArgument = {`
`109`	`109`	`Ident.Set.empty,`
`110`	`110`	`[arg1, arg2, arg3],`
`111`	`111`	`)`
`112`		`- \| CCollectionConcat(t, colls) =>`
	`112`	`+ \| CCollectionConcat(t, collections) =>`
`113`	`113`	`List.fold_left(`
`114`	`114`	`(acc, a) => Ident.Set.union(imm_free_vars(a), acc),`
`115`	`115`	`Ident.Set.empty,`
`116`		`- colls,`
	`116`	`+ collections,`
`117`	`117`	`)`
`118`	`118`	`\| CRecord(_, _, args) =>`
`119`	`119`	`List.fold_left(`
Original file line number	Diff line number	Diff line change
`@@ -196,9 +196,9 @@ module MakeMap = (Iter: MapArgument) => {`
`196`	`196`	`process_imm_expression(arg),`
`197`	`197`	`),`
`198`	`198`	`)`
`199`		`- \| CCollectionConcat(t, colls) =>`
	`199`	`+ \| CCollectionConcat(t, collections) =>`
`200`	`200`	`leave_with(`
`201`		`- CCollectionConcat(t, List.map(process_imm_expression, colls)),`
	`201`	`+ CCollectionConcat(t, List.map(process_imm_expression, collections)),`
`202`	`202`	`)`
`203`	`203`	`\| CIf(cond, t, f) =>`
`204`	`204`	`let cond = process_imm_expression(cond);`