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

grain-lang · Mar 4, 2023 · ffd4d44 · ffd4d44
1 parent c5cd21f
commit ffd4d44
Show file tree

Hide file tree

Showing 19 changed files with 151 additions and 109 deletions.
diff --git a/compiler/src/codegen/compcore.re b/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")
  }

diff --git a/compiler/src/language_server/sourcetree.re b/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,
  ) =>

diff --git a/compiler/src/middle_end/linearize.re b/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,
  ];

diff --git a/compiler/src/parsing/ast_helper.re b/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 = {

diff --git a/compiler/src/parsing/ast_helper.rei b/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: {

diff --git a/compiler/src/parsing/parser.mly b/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 }

diff --git a/compiler/src/typed/ctype.re b/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));
diff --git a/compiler/src/typed/datarepr.re b/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 == []) {