feat(compiler): Record spread syntax (#1565)

Closes #778

Author: alex-snezhko

compiler/src/codegen/mashtree.re

@@ -314,7 +314,7 @@ type allocation_type =
   | MTuple(list(immediate))
   | MBox(immediate)
   | MArray(list(immediate))
-  | MRecord(immediate, list((string, immediate)))
+  | MRecord(immediate, list((option(string), immediate)))
   | MADT(immediate, immediate, list(immediate)) /* Type Tag, Variant Tag, Elements */
   | MBytes(bytes)
   | MString(string)

compiler/src/codegen/transl_anf.re

@@ -822,7 +822,11 @@ let rec compile_comp = (~id=?, env, c) => {
         MRecord(
           compile_imm(env, ttag),
           List.map(
-            (({txt: name}, arg)) => (name, compile_imm(env, arg)),
+            ((name, arg)) =>
+              (
+                Option.map(({txt: name}) => name, name),
+                compile_imm(env, arg),
+              ),
             args,
           ),
         ),

compiler/src/formatting/debug.re

@@ -56,7 +56,7 @@ let debug_expression = (expr: Parsetree.expression) => {
     print_loc("PExpArrayGet", expr.pexp_loc)
   | PExpArraySet(expression1, expression2, expression3) =>
     print_loc("PExpArraySet", expr.pexp_loc)
-  | PExpRecord(record) => print_loc("PExpRecord", expr.pexp_loc)
+  | PExpRecord(base, record) => print_loc("PExpRecord", expr.pexp_loc)
   | PExpRecordGet(expression, {txt, _}) =>
     print_loc("PExpRecordGet", expr.pexp_loc)
   | PExpRecordSet(expression, {txt, _}, expression2) =>

compiler/src/formatting/format.re

@@ -128,6 +128,10 @@ type sugared_list_item =
   | Regular(Parsetree.expression)
   | Spread(Parsetree.expression);
 
+type record_item =
+  | Field((Location.loc(Identifier.t), Parsetree.expression))
+  | RecordSpread(Parsetree.expression);
+
 type sugared_pattern_item =
   | RegularPattern(Parsetree.pattern)
   | SpreadPattern(Parsetree.pattern);
@@ -1627,53 +1631,81 @@ and print_ident = (ident: Identifier.t) => {
 
 and print_record =
     (
+      ~base: option(Parsetree.expression),
       ~fields: list((Location.loc(Identifier.t), Parsetree.expression)),
       ~original_source: array(string),
       ~comments: list(Parsetree.comment),
       recloc: Location.t,
     ) => {
-  let get_loc = (field: (Location.loc(Identifier.t), Parsetree.expression)) => {
-    let (_, expr) = field;
-    expr.pexp_loc;
+  let get_loc = item => {
+    switch (item) {
+    | Field((_, expr)) => expr.pexp_loc
+    | RecordSpread(base) => base.pexp_loc
+    };
   };
 
-  let print_item =
-      (~comments, field: (Location.loc(Identifier.t), Parsetree.expression)) => {
-    let (locidentifier, expr) = field;
-    let ident = locidentifier.txt;
-    let printed_ident = print_ident(ident);
-    let printed_expr =
-      print_expression(
-        ~expression_parent=GenericExpression,
-        ~original_source,
-        ~comments,
-        expr,
-      );
-    let punned_expr = check_for_pun(expr);
+  let print_item = (~comments, item) => {
+    switch (item) {
+    | Field(field) =>
+      let (locidentifier, expr) = field;
+      let ident = locidentifier.txt;
+      let printed_ident = print_ident(ident);
+      let printed_expr =
+        print_expression(
+          ~expression_parent=GenericExpression,
+          ~original_source,
+          ~comments,
+          expr,
+        );
+      let punned_expr = check_for_pun(expr);
 
-    let pun =
-      switch (printed_ident, punned_expr: Doc.t) {
-      | (Text(i), Text(e)) => i == e
-      | _ => false
-      };
+      let pun =
+        switch (printed_ident, punned_expr: Doc.t) {
+        | (Text(i), Text(e)) => i == e
+        | _ => false
+        };
 
-    if (!pun) {
-      Doc.group(
-        Doc.concat([printed_ident, Doc.text(":"), Doc.space, printed_expr]),
-      );
-    } else {
-      Doc.group(printed_ident);
+      if (!pun) {
+        Doc.group(
+          Doc.concat([
+            printed_ident,
+            Doc.text(":"),
+            Doc.space,
+            printed_expr,
+          ]),
+        );
+      } else {
+        Doc.group(printed_ident);
+      };
+    | RecordSpread(base) =>
+      Doc.concat([
+        Doc.text("..."),
+        print_expression(
+          ~expression_parent=GenericExpression,
+          ~original_source,
+          ~comments,
+          base,
+        ),
+      ])
     };
   };
 
+  let items =
+    Option.to_list(Option.map(x => RecordSpread(x), base))
+    @ List.map(x => Field(x), fields);
+
   let after_brace_comments =
-    switch (fields) {
-    | [field, ..._] =>
-      let (ident, expr) = field;
+    switch (items) {
+    | [item, ..._] =>
+      let loc =
+        switch (item) {
+        | Field((ident, _)) => ident.loc
+        | RecordSpread(exp) => exp.pexp_loc
+        };
 
       Comment_utils.get_after_brace_comments(
         ~loc=recloc,
-        ~first=ident.loc,
+        ~first=loc,
         comments,
       );
 
@@ -1689,7 +1721,7 @@ and print_record =
       ~print_item,
       ~comments=cleaned_comments,
       ~iterated_item=IteratedRecord,
-      fields,
+      items,
     );
   let printed_fields = Doc.join(~sep=Doc.line, items);
 
@@ -1707,7 +1739,7 @@ and print_record =
         printed_fields_after_brace,
         Doc.ifBreaks(
           Doc.nil,
-          switch (fields) {
+          switch (items) {
           | [_one] =>
             // TODO: not needed once we annotate with ::
             Doc.comma // append a comma as single argument record look like block {data:val}
@@ -2787,8 +2819,14 @@ and print_expression_inner =
         ]),
       )
 
-    | PExpRecord(record) =>
-      print_record(~fields=record, ~original_source, ~comments, expr.pexp_loc)
+    | PExpRecord(base, record) =>
+      print_record(
+        ~base,
+        ~fields=record,
+        ~original_source,
+        ~comments,
+        expr.pexp_loc,
+      )
     | PExpRecordGet(expression, {txt, _}) =>
       Doc.concat([
         print_expression(

compiler/src/middle_end/anf_helper.rei

@@ -168,7 +168,7 @@ module Comp: {
       ~attributes: attributes=?,
       ~env: env=?,
       imm_expression,
-      list((str, imm_expression))
+      list((option(str), imm_expression))
     ) =>
     comp_expression;
   let adt:

compiler/src/middle_end/anftree.re

@@ -328,7 +328,7 @@ and comp_expression_desc =
   | CArray(list(imm_expression))
   | CArrayGet(imm_expression, imm_expression)
   | CArraySet(imm_expression, imm_expression, imm_expression)
-  | CRecord(imm_expression, list((loc(string), imm_expression)))
+  | CRecord(imm_expression, list((option(loc(string)), imm_expression)))
   | CAdt(imm_expression, imm_expression, list(imm_expression))
   | CGetTupleItem(int32, imm_expression)
   | CSetTupleItem(int32, imm_expression, imm_expression)

compiler/src/middle_end/anftree.rei

@@ -308,7 +308,7 @@ and comp_expression_desc =
   | CArray(list(imm_expression))
   | CArrayGet(imm_expression, imm_expression)
   | CArraySet(imm_expression, imm_expression, imm_expression)
-  | CRecord(imm_expression, list((loc(string), imm_expression)))
+  | CRecord(imm_expression, list((option(loc(string)), imm_expression)))
   | CAdt(imm_expression, imm_expression, list(imm_expression))
   | CGetTupleItem(int32, imm_expression)
   | CSetTupleItem(int32, imm_expression, imm_expression)

compiler/src/middle_end/linearize.re

@@ -757,35 +757,56 @@ let rec transl_imm =
         ),
       ],
     );
-  | TExpRecord(args) =>
+  | TExpRecord(base, args) =>
+    let base_imm = Option.map(transl_imm, base);
     let tmp = gensym("record");
-    let definitions =
-      Array.to_list @@ Array.map(((desc, def)) => def, args);
-    let definitions =
-      List.map(
-        fun
-        | Kept(_) => assert(false)
-        | Overridden(name, def) => (name, def),
-        definitions,
-      );
     let (new_args, new_setup) =
       List.split(
         List.map(
-          (({txt: name, loc}, expr)) => {
-            let (var, setup) = transl_imm(expr);
-            (
-              (Location.mkloc(Identifier.string_of_ident(name), loc), var),
-              setup,
-            );
-          },
-          definitions,
+          arg =>
+            switch (arg) {
+            | (ld, Kept) =>
+              let (base_var, _) = Option.get(base_imm);
+              let fieldtmp = gensym("field");
+              (
+                (None, Imm.id(~loc, ~env, fieldtmp)),
+                [
+                  BLet(
+                    fieldtmp,
+                    Comp.record_get(
+                      ~loc,
+                      ~env,
+                      ~allocation_type,
+                      Int32.of_int(ld.lbl_pos),
+                      base_var,
+                    ),
+                    Nonglobal,
+                  ),
+                ],
+              );
+            | (_, Overridden({txt: name, loc}, expr)) =>
+              let (var, setup) = transl_imm(expr);
+              (
+                (
+                  Some(
+                    Location.mkloc(Identifier.string_of_ident(name), loc),
+                  ),
+                  var,
+                ),
+                setup,
+              );
+            },
+          Array.to_list(args),
         ),
       );
     let (typath, _, _) = Typepat.extract_concrete_record(env, typ);
     let ty_id = get_type_id(typath);
     (
       Imm.id(~loc, ~env, tmp),
-      List.concat(new_setup)
+      List.concat(
+        Option.to_list(Option.map(((_, setup)) => setup, base_imm))
+        @ new_setup,
+      )
       @ [
         BLet(
           tmp,

compiler/src/parsing/ast_helper.re

@@ -24,6 +24,10 @@ type listitem('a) =
   | ListItem('a)
   | ListSpread('a, Location.t);
 
+type recorditem =
+  | RecordItem(loc(Identifier.t), expression)
+  | RecordSpread(expression, Location.t);
+
 type id = loc(Identifier.t);
 type str = loc(string);
 type loc = Location.t;
@@ -192,8 +196,47 @@ module Exp = {
     mk(~loc?, ~attributes?, PExpConstant(a));
   let tuple = (~loc=?, ~attributes=?, a) =>
     mk(~loc?, ~attributes?, PExpTuple(a));
-  let record = (~loc=?, ~attributes=?, a) =>
-    mk(~loc?, ~attributes?, PExpRecord(a));
+  let record = (~loc=?, ~attributes=?, a, b) =>
+    mk(~loc?, ~attributes?, PExpRecord(a, b));
+  let record_fields = (~loc=?, ~attributes=?, a) =>
+    switch (a) {
+    | [] => failwith("Impossible: empty record field list")
+    | [base, ...rest] =>
+      let (spread_base, record_items) =
+        switch (base) {
+        | RecordItem(id, expr) => (None, [(id, expr)])
+        | RecordSpread(expr, _) => (Some(expr), [])
+        };
+      let record_items =
+        List.fold_left(
+          (acc, expr) => {
+            switch (expr) {
+            | RecordItem(id, expr) => [(id, expr), ...acc]
+            | RecordSpread(_, loc) =>
+              switch (spread_base) {
+              | None =>
+                raise(
+                  SyntaxError(
+                    loc,
+                    "A record spread can only appear at the beginning of a record expression.",
+                  ),
+                )
+              | Some(_) =>
+                raise(
+                  SyntaxError(
+                    loc,
+                    "A record expression may only contain one record spread.",
+                  ),
+                )
+              }
+            }
+          },
+          record_items,
+          rest,
+        );
+      let record_items = List.rev(record_items);
+      record(~loc?, ~attributes?, spread_base, record_items);
+    };
   let record_get = (~loc=?, ~attributes=?, a, b) =>
     mk(~loc?, ~attributes?, PExpRecordGet(a, b));
   let record_set = (~loc=?, ~attributes=?, a, b, c) =>

compiler/src/parsing/ast_helper.rei

@@ -24,6 +24,10 @@ type listitem('a) =
   | ListItem('a)
   | ListSpread('a, Location.t);
 
+type recorditem =
+  | RecordItem(loc(Identifier.t), expression)
+  | RecordSpread(expression, Location.t);
+
 type id = loc(Identifier.t);
 type str = loc(string);
 type loc = Location.t;
@@ -113,8 +117,15 @@ module Exp: {
   let tuple:
     (~loc: loc=?, ~attributes: attributes=?, list(expression)) => expression;
   let record:
-    (~loc: loc=?, ~attributes: attributes=?, list((id, expression))) =>
+    (
+      ~loc: loc=?,
+      ~attributes: attributes=?,
+      option(expression),
+      list((id, expression))
+    ) =>
     expression;
+  let record_fields:
+    (~loc: loc=?, ~attributes: attributes=?, list(recorditem)) => expression;
   let record_get:
     (~loc: loc=?, ~attributes: attributes=?, expression, id) => expression;
   let record_set: