feat(compiler)!: Inline record constructors (#1586)

chore(compiler): Rework a bunch of oprint to print inline records correctly Co-authored-by: Blaine Bublitz <[email protected]> Co-authored-by: Oscar Spencer <[email protected]>
grain-lang · Jan 26, 2023 · 43082f5 · 43082f5
1 parent b437c13
commit 43082f5
Show file tree

Hide file tree

Showing 45 changed files with 1,392 additions and 469 deletions.
diff --git a/compiler/src/codegen/compcore.re b/compiler/src/codegen/compcore.re
@@ -3178,7 +3178,7 @@ and compile_instr = (wasm_mod, env, instr) =>
   };
 
 type type_metadata =
-  | ADTMeta(int, list((int, string)))
+  | ADTMeta(int, list((int, string, Types.adt_constructor_type)))
   | RecordMeta(int, list(string));
 
 let compile_type_metadata = (wasm_mod, env, type_metadata) => {
@@ -3218,7 +3218,11 @@ let compile_type_metadata = (wasm_mod, env, type_metadata) => {
           List.map(
             meta => {
               switch (meta) {
-              | ExceptionMetadata(_, variant, name) => (variant, name)
+              | ExceptionMetadata(_, variant, name) => (
+                  variant,
+                  name,
+                  TupleConstructor,
+                )
               | _ => failwith("impossible by partition")
               }
             },
@@ -3247,26 +3251,77 @@ let compile_type_metadata = (wasm_mod, env, type_metadata) => {
     meta => {
       switch (meta) {
       | ADTMeta(id, cstrs) =>
+        // For inline record constructors, store field names after other ADT info
+        let extra_required =
+          List.map(
+            ((_, _, cstr_type)) =>
+              switch (cstr_type) {
+              | TupleConstructor => 0
+              | RecordConstructor(fields) =>
+                List.fold_left(
+                  (total, field) =>
+                    total + 8 + round_to_8(String.length(field)),
+                  0,
+                  fields,
+                )
+              },
+            cstrs,
+          );
+
         let section_length =
-          List.fold_left(
-            (total, (_, cstr)) =>
-              total + 12 + round_to_8(String.length(cstr)),
+          List.fold_left2(
+            (total, (_, cstr, cstr_type), extra) => {
+              total + 16 + round_to_8(String.length(cstr)) + extra
+            },
             8,
             cstrs,
+            extra_required,
           );
         Buffer.add_int32_le(buf, Int32.of_int(section_length));
         Buffer.add_int32_le(buf, Int32.of_int(id));
-        List.iter(
-          ((id, cstr)) => {
+        List.iter2(
+          ((id, cstr, cstr_type), fields_section_length) => {
             let length = String.length(cstr);
             let aligned_length = round_to_8(length);
-            Buffer.add_int32_le(buf, Int32.of_int(aligned_length + 12));
+            let constr_length = aligned_length + 16;
+            Buffer.add_int32_le(
+              buf,
+              Int32.of_int(constr_length + fields_section_length),
+            );
+            // Indicates offset to field data; special value of 0 can be interpreted
+            // to indicate that this is not a record variant
+            Buffer.add_int32_le(
+              buf,
+              Int32.of_int(
+                if (cstr_type == TupleConstructor) {
+                  0;
+                } else {
+                  constr_length;
+                },
+              ),
+            );
             Buffer.add_int32_le(buf, Int32.of_int(id));
             Buffer.add_int32_le(buf, Int32.of_int(length));
             Buffer.add_string(buf, cstr);
             alignBuffer(aligned_length - length);
+            switch (cstr_type) {
+            | TupleConstructor => ()
+            | RecordConstructor(fields) =>
+              List.iter(
+                field => {
+                  let length = String.length(field);
+                  let aligned_length = round_to_8(length);
+                  Buffer.add_int32_le(buf, Int32.of_int(aligned_length + 8));
+                  Buffer.add_int32_le(buf, Int32.of_int(length));
+                  Buffer.add_string(buf, field);
+                  alignBuffer(aligned_length - length);
+                },
+                fields,
+              )
+            };
           },
           cstrs,
+          extra_required,
         );
       | RecordMeta(id, fields) =>
         let section_length =

diff --git a/compiler/src/formatting/format.re b/compiler/src/formatting/format.re
@@ -1125,7 +1125,7 @@ and resugar_pattern_list_inner = (patterns: list(Parsetree.pattern)) => {
   switch (patterns) {
   | [arg1, arg2, ..._] =>
     switch (arg2.ppat_desc) {
-    | PPatConstruct(innercstr, innerpatterns) =>
+    | PPatConstruct(innercstr, PPatConstrTuple(innerpatterns)) =>
       let cstr =
         switch (innercstr.txt) {
         | IdentName({txt: name}) => name
@@ -1309,10 +1309,15 @@ and resugar_list_inner = (expressions: list(Parsetree.expression)) =>
   switch (expressions) {
   | [arg1, arg2] =>
     switch (arg2.pexp_desc) {
-    | PExpConstruct({txt: IdentName({txt: "[...]"})}, innerexpressions) =>
+    | PExpConstruct(
+        {txt: IdentName({txt: "[...]"})},
+        PExpConstrTuple(innerexpressions),
+      ) =>
       let inner = resugar_list_inner(innerexpressions);
       List.append([Regular(arg1)], inner);
-    | PExpConstruct({txt: IdentName({txt: "[]"})}, _) => [Regular(arg1)]
+    | PExpConstruct({txt: IdentName({txt: "[]"})}, PExpConstrTuple(_)) => [
+        Regular(arg1),
+      ]
     | _ => [Regular(arg1), Spread(arg2)]
     }
   | _ =>
@@ -1338,6 +1343,7 @@ and print_record_pattern =
     ) => {
   let close =
     switch (closedflag) {
+    | Open when patternlocs == [] => Doc.text("_")
     | Open => Doc.concat([Doc.text(","), Doc.space, Doc.text("_")])
     | Closed => Doc.nil
     };
@@ -1462,7 +1468,7 @@ and print_pattern =
         ]),
         false,
       )
-    | PPatConstruct(location, patterns) =>
+    | PPatConstruct(location, PPatConstrTuple(patterns)) =>
       let func =
         switch (location.txt) {
         | IdentName({txt: name}) => name
@@ -1502,7 +1508,20 @@ and print_pattern =
           false,
         );
       };
-
+    | PPatConstruct(location, PPatConstrRecord(patternlocs, closedflag)) => (
+        Doc.concat([
+          print_ident(location.txt),
+          print_record_pattern(
+            ~patternlocs,
+            ~closedflag,
+            ~original_source,
+            ~comments,
+            ~next_loc,
+            pat.ppat_loc,
+          ),
+        ]),
+        false,
+      )
     | PPatOr(pattern1, pattern2) => (
         Doc.group(
           Doc.concat([
@@ -3604,12 +3623,18 @@ and print_expression_inner =
         ~comments=comments_in_expression,
         func,
       );
-    | PExpConstruct({txt: IdentName({txt: "[...]"})}, expressions) =>
+    | PExpConstruct(
+        {txt: IdentName({txt: "[...]"})},
+        PExpConstrTuple(expressions),
+      ) =>
       resugar_list(~original_source, ~comments, expressions)
-    | PExpConstruct({txt: IdentName({txt: "[]"})}, expressions) =>
+    | PExpConstruct(
+        {txt: IdentName({txt: "[]"})},
+        PExpConstrTuple(expressions),
+      ) =>
       Doc.text("[]")
-    | PExpConstruct({txt: id}, []) => print_ident(id)
-    | PExpConstruct(constr, expressions) =>
+    | PExpConstruct({txt: id}, PExpConstrTuple([])) => print_ident(id)
+    | PExpConstruct(constr, PExpConstrTuple(expressions)) =>
       let comments_in_expression =
         Comment_utils.get_comments_inside_location(
           ~location=expr.pexp_loc,
@@ -3622,6 +3647,17 @@ and print_expression_inner =
         ~comments=comments_in_expression,
         Ast_helper.Exp.ident(constr),
       );
+    | PExpConstruct(id, PExpConstrRecord(record)) =>
+      Doc.concat([
+        print_ident(id.txt),
+        print_record(
+          ~base=None,
+          ~fields=record,
+          ~original_source,
+          ~comments,
+          expr.pexp_loc,
+        ),
+      ])
     | PExpBlock(expressions) =>
       switch (expressions) {
       | [] =>
@@ -4223,6 +4259,61 @@ let rec print_data =
                 ]),
               );
             }
+          | PConstrRecord(label_declarations) =>
+            let get_loc = (lbl: Parsetree.label_declaration) => {
+              lbl.pld_loc;
+            };
+
+            let print_item = (~comments, lbl: Parsetree.label_declaration) => {
+              Doc.concat([
+                print_ident(lbl.pld_name.txt),
+                Doc.text(":"),
+                Doc.space,
+                print_type(~original_source, ~comments, lbl.pld_type),
+              ]);
+            };
+
+            let pre_brace_comments = []; // We can't determine from AST if comment comes before or after brace
+
+            let remaining_comments =
+              remove_used_comments(
+                ~remove_comments=pre_brace_comments,
+                comments,
+              );
+
+            let after_brace_comments =
+              Comment_utils.get_after_brace_comments(
+                ~loc=data.pdata_loc,
+                remaining_comments,
+              );
+
+            let cleaned_comments =
+              remove_used_comments(
+                ~remove_comments=after_brace_comments,
+                remaining_comments,
+              );
+
+            let decl_items =
+              item_iterator(
+                ~get_loc,
+                ~print_item,
+                ~comments=cleaned_comments,
+                ~iterated_item=IteratedRecordLabels,
+                label_declarations,
+              );
+            let printed_decls = Doc.join(~sep=Doc.hardLine, decl_items);
+            let printed_decls_after_brace =
+              Doc.concat([Doc.hardLine, printed_decls]);
+
+            Doc.group(
+              Doc.concat([
+                Doc.lbrace,
+                Comment_utils.single_line_of_comments(after_brace_comments),
+                Doc.indent(printed_decls_after_brace),
+                Doc.hardLine,
+                Doc.rbrace,
+              ]),
+            );
           | PConstrSingleton => Doc.nil
           },
         ]),
@@ -4820,6 +4911,10 @@ let toplevel_print =
             } else {
               Doc.nil;
             }
+          | PConstrRecord(_) =>
+            failwith(
+              "Impossible: exception should not have a record constructor",
+            )
           }
 
         | PExtRebind(lid) => print_ident(lid.txt)

diff --git a/compiler/src/middle_end/linearize.re b/compiler/src/middle_end/linearize.re
@@ -900,12 +900,27 @@ let rec transl_imm =
       Imm.id(~loc, ~env, tmp),
       (exp_setup @ setup) @ [BLet(tmp, ans, Nonglobal)],
     );
-  | TExpConstruct(_, {cstr_tag}, args) =>
+  | TExpConstruct(_, {cstr_tag}, arg) =>
     let tmp = gensym("adt");
     let (_, typath, _) = Ctype.extract_concrete_typedecl(env, typ);
     let ty_id = get_type_id(typath, env);
     let compiled_tag = compile_constructor_tag(cstr_tag);
-    let (new_args, new_setup) = List.split(List.map(transl_imm, args));
+    let (new_args, new_setup) =
+      switch (arg) {
+      | TExpConstrRecord(fields) =>
+        List.split(
+          List.map(
+            field =>
+              switch (field) {
+              | (_, Kept) =>
+                failwith("Impossible: inline record variant with Kept field")
+              | (_, Overridden({txt: name, loc}, expr)) => transl_imm(expr)
+              },
+            Array.to_list(fields),
+          ),
+        )
+      | TExpConstrTuple(args) => List.split(List.map(transl_imm, args))
+      };
     let imm_tytag =
       Imm.const(
         ~loc,
@@ -999,7 +1014,7 @@ and transl_comp_expression =
                 TExpConstruct(
                   assertion_error_identifier,
                   assertion_error,
-                  [error_message],
+                  TExpConstrTuple([error_message]),
                 ),
             },
           ),
@@ -1613,6 +1628,23 @@ let gather_type_metadata = statements => {
                       (
                         compile_constructor_tag(cstr.cstr_tag),
                         cstr.cstr_name,
+                        switch (cstr.cstr_inlined) {
+                        | None => TupleConstructor
+                        | Some(t) =>
+                          let label_names =
+                            switch (t.type_kind) {
+                            | TDataRecord(rfs) =>
+                              List.map(
+                                rf => Ident.name(rf.Types.rf_name),
+                                rfs,
+                              )
+                            | _ =>
+                              failwith(
+                                "Impossible: inlined record constructor with non-record underlying type",
+                              )
+                            };
+                          RecordConstructor(label_names);
+                        },
                       ),
                     descrs,
                   );

diff --git a/compiler/src/middle_end/matchcomp.re b/compiler/src/middle_end/matchcomp.re
@@ -609,9 +609,23 @@ let rec compile_matrix = mtx =>
       let constructors = matrix_head_constructors(mtx);
       /* Printf.eprintf "constructors:\n%s\n" (Sexplib.Sexp.to_string_hum ((Sexplib.Conv.sexp_of_list sexp_of_constructor_description) constructors)); */
       let handle_constructor = ((_, switch_branches), cstr) => {
-        let arity = cstr.cstr_arity;
         let specialized = specialize_matrix(cstr, alias, mtx);
-        let result = compile_matrix(specialized);
+        let (arity, mtx) =
+          switch (cstr.cstr_inlined) {
+          | None => (cstr.cstr_arity, specialized)
+          | Some(t) =>
+            switch (t.type_kind) {
+            | TDataRecord(rfs) =>
+              let arity = List.length(rfs);
+              let mtx = flatten_matrix(arity, alias, specialized);
+              (arity, mtx);
+            | _ =>
+              failwith(
+                "Impossible: inlined record constructor pattern with non-record data",
+              )
+            }
+          };
+        let result = compile_matrix(mtx);
         let final_tree =
           Explode(ConstructorMatrix(Some(arity)), alias, result);
         (