fix(compiler): Inline record exception constructors (#1709)

Author: alex-snezhko

compiler/src/codegen/compcore.re

@@ -3304,16 +3304,16 @@ let compile_type_metadata = (wasm_mod, env, type_metadata) => {
     );
   let type_metadata =
     switch (exception_meta) {
-    | [ExceptionMetadata(id, _, _), ..._] => [
+    | [ExceptionMetadata(id, _, _, _), ..._] => [
         ADTMeta(
           id,
           List.map(
             meta => {
               switch (meta) {
-              | ExceptionMetadata(_, variant, name) => (
+              | ExceptionMetadata(_, variant, name, cstr_type) => (
                   variant,
                   name,
-                  TupleConstructor,
+                  cstr_type,
                 )
               | _ => failwith("impossible by partition")
               }

compiler/src/language_server/sourcetree.re

@@ -241,7 +241,7 @@ module Sourcetree: Sourcetree = {
             Path.(
               switch (exp.exp_desc) {
               | TExpIdent(
-                  PExternal(path, _, _),
+                  PExternal(path, _),
                   {txt: IdentExternal(IdentName({loc}), _)},
                   desc,
                 ) =>

compiler/src/middle_end/linearize.re

@@ -38,7 +38,7 @@ let get_type_id = (typath, env) =>
 let lookup_symbol = (~env, ~allocation_type, ~repr, path) => {
   switch (path) {
   | Path.PIdent(id) => id
-  | Path.PExternal(mod_, name, _pos) =>
+  | Path.PExternal(mod_, name) =>
     let mod_map =
       switch (Path_tbl.find_opt(module_symbol_map, mod_)) {
       | Some(map) => map
@@ -1618,6 +1618,20 @@ let rec gather_type_metadata = statements => {
             ty_id,
             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 exception record constructor with non-record underlying type",
+                  )
+                };
+              RecordConstructor(label_names);
+            },
           ),
           ...metadata,
         ];

compiler/src/parsing/ast_helper.re

@@ -164,6 +164,21 @@ module Exception = {
   };
   let singleton = (~loc=?, n) => mk(~loc?, n, PConstrSingleton);
   let tuple = (~loc=?, n, args) => mk(~loc?, n, PConstrTuple(args));
+  let record = (~loc=?, n, args) => {
+    List.iter(
+      ld =>
+        if (ld.pld_mutable == Mutable) {
+          raise(
+            SyntaxError(
+              ld.pld_loc,
+              "A record exception constructor cannot have mutable fields.",
+            ),
+          );
+        },
+      args,
+    );
+    mk(~loc?, n, PConstrRecord(args));
+  };
 };
 
 module Pattern = {

compiler/src/parsing/ast_helper.rei

@@ -99,6 +99,7 @@ module Exception: {
   let mk: (~loc: loc=?, str, constructor_arguments) => type_exception;
   let singleton: (~loc: loc=?, str) => type_exception;
   let tuple: (~loc: loc=?, str, list(parsed_type)) => type_exception;
+  let record: (~loc: loc=?, str, list(label_declaration)) => type_exception;
 };
 
 module Pattern: {

compiler/src/parsing/parser.mly

@@ -656,6 +656,7 @@ primitive_stmt:
 exception_stmt:
   | EXCEPTION type_id_str { Exception.singleton ~loc:(to_loc $loc) $2 }
   | EXCEPTION type_id_str lparen typs? rparen { Exception.tuple ~loc:(to_loc $loc) $2 (Option.value ~default:[] $4) }
+  | EXCEPTION type_id_str data_labels { Exception.record ~loc:(to_loc $loc) $2 $3 }
 
 module_stmt:
   | MODULE UIDENT lbrace toplevel_stmts RBRACE { ModuleDeclaration.mk ~loc:(to_loc $loc) (mkstr $loc($2) $2) $4 }

compiler/src/typed/ctype.re

@@ -138,7 +138,7 @@ let is_object_type = path => {
   let name =
     switch (path) {
     | Path.PIdent(id) => Ident.name(id)
-    | Path.PExternal(_, s, _) => s
+    | Path.PExternal(_, s) => s
     };
   name.[0] == '#';
 };
@@ -3331,5 +3331,5 @@ let maybe_pointer_type = (env, typ) =>
 let rec lid_of_path = (~hash="") =>
   fun
   | Path.PIdent(id) => Identifier.IdentName(mknoloc(hash ++ Ident.name(id)))
-  | Path.PExternal(p1, s, _) =>
+  | Path.PExternal(p1, s) =>
     Identifier.IdentExternal(lid_of_path(p1), mknoloc(hash ++ s));

compiler/src/typed/datarepr.re

@@ -114,11 +114,7 @@ let constructor_descrs = (ty_path, decl, cstrs) => {
       };
     let cstr_name = Ident.name(cd_id);
     let (existentials, cstr_args, cstr_inlined) =
-      constructor_args(
-        cd_args,
-        cd_res,
-        Path.PExternal(ty_path, cstr_name, Path.nopos),
-      );
+      constructor_args(cd_args, cd_res, Path.PExternal(ty_path, cstr_name));
 
     let cstr = {
       cstr_name,
@@ -141,7 +137,11 @@ let extension_descr = (path_ext, ext) => {
   let ty_res = newgenconstr(ext.ext_type_path, ext.ext_type_params);
 
   let (existentials, cstr_args, cstr_inlined) =
-    constructor_args(ext.ext_args, Some(ty_res), path_ext);
+    constructor_args(
+      ext.ext_args,
+      Some(ty_res),
+      Path.PExternal(path_ext, "#extension#"),
+    );
 
   let cstr_ext_type =
     if (cstr_args == []) {