Skip to content

zero_alloc: refactor Translattribute.assume_zero_alloc slightly #2148

New issue

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

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

Already on GitHub? # to your account

Merged
merged 1 commit into from
Dec 14, 2023
Merged
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
9 changes: 6 additions & 3 deletions ocaml/lambda/translattribute.ml
Original file line number Diff line number Diff line change
Expand Up @@ -468,12 +468,15 @@ let assume_zero_alloc attributes =
| Assume { property = Zero_alloc; _ } -> true
| Check { property = Zero_alloc; _ } -> false

let assume_zero_alloc attributes =
(* This function is used for "look-ahead" to find attributes
let get_assume_zero_alloc ~with_warnings attributes =
if with_warnings then
assume_zero_alloc attributes
else
(* This function is used for "look-ahead" to find attributes
that affect [Scoped_location] settings before translation
of expressions in that scope.
Warnings will be produced by [add_check_attribute]. *)
Warnings.without_warnings (fun () -> assume_zero_alloc attributes)
Warnings.without_warnings (fun () -> assume_zero_alloc attributes)

let add_check_attribute expr loc attributes =
let to_string = function
Expand Down
2 changes: 1 addition & 1 deletion ocaml/lambda/translattribute.mli
Original file line number Diff line number Diff line change
Expand Up @@ -65,4 +65,4 @@ val add_function_attributes
-> Parsetree.attributes
-> Lambda.lambda

val assume_zero_alloc : Parsetree.attributes -> bool
val get_assume_zero_alloc : with_warnings:bool -> Parsetree.attributes -> bool
8 changes: 6 additions & 2 deletions ocaml/lambda/translcore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1363,7 +1363,9 @@ and transl_function ~in_new_scope ~scopes e alloc_mode param arg_mode arg_sort r
| (Texp_constraint _ | Texp_coerce _ | Texp_poly _) -> attrs)
e.exp_attributes e.exp_extra
in
let assume_zero_alloc = Translattribute.assume_zero_alloc attrs in
let assume_zero_alloc =
Translattribute.get_assume_zero_alloc ~with_warnings:false attrs
in
let scopes =
if in_new_scope then begin
if assume_zero_alloc then set_assume_zero_alloc ~scopes
Expand Down Expand Up @@ -1407,7 +1409,9 @@ and transl_bound_exp ~scopes ~in_structure pat sort expr loc attrs =
let lam =
match pat_bound_idents pat with
| (id :: _) when should_introduce_scope ->
let assume_zero_alloc = Translattribute.assume_zero_alloc attrs in
let assume_zero_alloc =
Translattribute.get_assume_zero_alloc ~with_warnings:false attrs
in
let scopes = enter_value_definition ~scopes ~assume_zero_alloc id in
transl_scoped_exp ~scopes sort expr
| _ -> transl_exp ~scopes sort expr
Expand Down