Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fix(compiler): Reduce stack usage when allocating lists #2214

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
116 changes: 89 additions & 27 deletions compiler/src/middle_end/linearize.re
Original file line number Diff line number Diff line change
Expand Up @@ -266,6 +266,42 @@ let reorder_arguments = (args, order) => {
List.rev(reorder([], args, order));
};

type constuctor_meta = {
imm_type_hash: imm_expression,
imm_tytag: imm_expression,
imm_tag: imm_expression,
};

let constructor_meta = (~loc, ~env, typ, cstr_tag) => {
let (_, typath, tydecl) = Ctype.extract_concrete_typedecl(env, typ);
let ty_id = get_type_id(typath, env);
let compiled_tag = compile_constructor_tag(cstr_tag);
let type_hash =
switch (cstr_tag) {
| CstrExtension(_) => exception_type_hash
| _ => get_type_hash(tydecl)
};
let imm_type_hash =
Imm.const(
~loc,
~env,
Const_number(Const_number_int(Int64.of_int(type_hash))),
);
let imm_tytag =
Imm.const(
~loc,
~env,
Const_number(Const_number_int(Int64.of_int(ty_id))),
);
let imm_tag =
Imm.const(
~loc,
~env,
Const_number(Const_number_int(Int64.of_int(compiled_tag))),
);
{imm_type_hash, imm_tytag, imm_tag};
};

let transl_const =
(~loc=Location.dummy_loc, ~env=Env.empty, c: Types.constant)
: Either.t(imm_expression, (ident, list(anf_bind))) => {
Expand Down Expand Up @@ -851,8 +887,58 @@ let rec transl_imm =
List.concat(new_setup)
@ [BLet(tmp, Comp.tuple(~loc, ~env, new_args), Nonglobal)],
);
| TExpList({items: args, spread}) =>
let (args, arg_setup) = List.split(List.map(transl_imm, args));
let (spread_arg, spread_setup) =
switch (spread) {
| Some(imm) => transl_imm(imm)
| None =>
let empty =
Env.find_constructor(PIdent(Builtin_types.ident_empty_cstr), env);
let {imm_type_hash, imm_tytag, imm_tag} =
constructor_meta(~loc, ~env, typ, empty.cstr_tag);
let cstr = gensym("empty");
(
Imm.id(~loc, ~env, cstr),
[
BLet(
cstr,
Comp.adt(~loc, ~env, imm_type_hash, imm_tytag, imm_tag, []),
Nonglobal,
),
],
);
};
let cons =
Env.find_constructor(PIdent(Builtin_types.ident_cons_cstr), env);
let {imm_type_hash, imm_tytag, imm_tag} =
constructor_meta(~loc, ~env, typ, cons.cstr_tag);
let (list_imm, list_setup) =
List.fold_left_map(
(rest_imm, arg) => {
let cstr = gensym("cons");
(
Imm.id(~loc, ~env, cstr),
BLet(
cstr,
Comp.adt(
~loc,
~env,
imm_type_hash,
imm_tytag,
imm_tag,
[arg, rest_imm],
),
Nonglobal,
),
);
},
spread_arg,
List.rev(args),
);
(list_imm, List.concat(arg_setup) @ spread_setup @ list_setup);
| TExpArray(args) =>
let tmp = gensym("tup");
let tmp = gensym("array");
let (new_args, new_setup) = List.split(List.map(transl_imm, args));
(
Imm.id(~loc, ~env, tmp),
Expand Down Expand Up @@ -1065,9 +1151,6 @@ let rec transl_imm =
);
| TExpConstruct(_, {cstr_name, cstr_tag}, arg) =>
let tmp = gensym("adt");
let (_, typath, tydecl) = 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) =
switch (arg) {
| TExpConstrRecord(fields) =>
Expand All @@ -1084,29 +1167,8 @@ let rec transl_imm =
)
| TExpConstrTuple(args) => List.split(List.map(transl_imm, args))
};
let type_hash =
switch (cstr_tag) {
| CstrExtension(_) => exception_type_hash
| _ => get_type_hash(tydecl)
};
let imm_type_hash =
Imm.const(
~loc,
~env,
Const_number(Const_number_int(Int64.of_int(type_hash))),
);
let imm_tytag =
Imm.const(
~loc,
~env,
Const_number(Const_number_int(Int64.of_int(ty_id))),
);
let imm_tag =
Imm.const(
~loc,
~env,
Const_number(Const_number_int(Int64.of_int(compiled_tag))),
);
let {imm_type_hash, imm_tytag, imm_tag} =
constructor_meta(~loc, ~env, typ, cstr_tag);
let adt =
Comp.adt(~loc, ~env, imm_type_hash, imm_tytag, imm_tag, new_args);
(
Expand Down
79 changes: 36 additions & 43 deletions compiler/src/typed/typecore.re
Original file line number Diff line number Diff line change
Expand Up @@ -802,7 +802,6 @@ and type_expect_ =
(~in_function=?, ~recarg=Rejected, env, sexp, ty_expected_explained) => {
let {ty: ty_expected, explanation} = ty_expected_explained;
let loc = sexp.pexp_loc;
let core_loc = sexp.pexp_core_loc;
let attributes = Typetexp.type_attributes(sexp.pexp_attributes);
/* Record the expression type before unifying it with the expected type */
let type_expect = type_expect(~in_function?);
Expand Down Expand Up @@ -863,57 +862,51 @@ and type_expect_ =
exp_env: env,
});
| PExpList(es) =>
let convert_list = (~loc, ~core_loc, ~attributes=?, a) => {
open Ast_helper;
let empty =
Expression.tuple_construct(~loc, ~core_loc, ident_empty, []);
let list =
switch (List.rev(a)) {
| [] => empty
| [base, ...rest] =>
let base =
switch (base) {
| ListItem(expr) =>
Expression.tuple_construct(
~loc,
~core_loc,
~attributes?,
ident_cons,
[expr, empty],
)
| ListSpread(expr, _) => expr
};
let (args, spread) =
switch (List.rev(es)) {
| [] => ([], None)
| [base, ...rest] =>
let (items, spread) =
switch (base) {
| ListItem(expr) => ([expr], None)
| ListSpread(expr, _) => ([], Some(expr))
};
let items =
List.fold_left(
(acc, expr) => {
switch (expr) {
| ListItem(expr) =>
Expression.tuple_construct(
~loc,
~core_loc,
~attributes?,
ident_cons,
[expr, acc],
)
(items, arg) =>
switch (arg) {
| ListItem(expr) => [expr, ...items]
| ListSpread(_, loc) =>
raise(
SyntaxError(
Ast_helper.SyntaxError(
loc,
"A list spread can only appear at the end of a list.",
),
)
}
},
base,
},
items,
rest,
);
};
{...list, pexp_loc: loc};
};
type_expect(
env,
convert_list(~loc, ~core_loc, ~attributes=sexp.pexp_attributes, es),
ty_expected_explained,
);
(items, spread);
};
let ty = newgenvar();
let to_unify = Builtin_types.type_list(ty);
with_explanation(() => unify_exp_types(loc, env, to_unify, ty_expected));
let items =
List.map(sarg => type_expect(env, sarg, mk_expected(ty)), args);
let spread =
Option.map(
expr => type_expect(env, expr, mk_expected(to_unify)),
spread,
);
re({
exp_desc: TExpList({items, spread}),
exp_loc: loc,
exp_extra: [],
exp_attributes: attributes,
exp_type: instance(env, ty_expected),
exp_env: env,
});
| PExpArray(es) =>
let ty = newgenvar();
let to_unify = Builtin_types.type_array(ty);
Expand Down
4 changes: 4 additions & 0 deletions compiler/src/typed/typedtree.re
Original file line number Diff line number Diff line change
Expand Up @@ -465,6 +465,10 @@ and expression_desc =
| TExpIdent(Path.t, loc(Identifier.t), Types.value_description)
| TExpConstant(constant)
| TExpTuple(list(expression))
| TExpList({
items: list(expression),
spread: option(expression),
})
| TExpArray(list(expression))
| TExpArrayGet(expression, expression)
| TExpArraySet({
Expand Down
4 changes: 4 additions & 0 deletions compiler/src/typed/typedtree.rei
Original file line number Diff line number Diff line change
Expand Up @@ -432,6 +432,10 @@ and expression_desc =
| TExpIdent(Path.t, loc(Identifier.t), Types.value_description)
| TExpConstant(constant)
| TExpTuple(list(expression))
| TExpList({
items: list(expression),
spread: option(expression),
})
| TExpArray(list(expression))
| TExpArrayGet(expression, expression)
| TExpArraySet({
Expand Down
3 changes: 3 additions & 0 deletions compiler/src/typed/typedtreeIter.re
Original file line number Diff line number Diff line change
Expand Up @@ -233,6 +233,9 @@ module MakeIterator =
| TExpRecordSet(e1, _, _, e2) =>
iter_expression(e1);
iter_expression(e2);
| TExpList({items: args, spread}) =>
List.iter(iter_expression, args);
Option.iter(iter_expression, spread);
| TExpTuple(args)
| TExpArray(args)
| TExpBlock(args)
Expand Down
5 changes: 5 additions & 0 deletions compiler/src/typed/typedtreeMap.re
Original file line number Diff line number Diff line change
Expand Up @@ -232,6 +232,11 @@ module MakeMap =
| TExpMatch(value, branches, p) =>
TExpMatch(map_expression(value), map_match_branches(branches), p)
| TExpTuple(args) => TExpTuple(List.map(map_expression, args))
| TExpList({items, spread}) =>
TExpList({
items: List.map(map_expression, items),
spread: Option.map(map_expression, spread),
})
| TExpArray(args) => TExpArray(List.map(map_expression, args))
| TExpArrayGet(a1, a2) =>
TExpArrayGet(map_expression(a1), map_expression(a2))
Expand Down
Loading