Skip to content

Commit

Permalink
Remove [Ignore_assert_all] and [opt] from Lambda onwards
Browse files Browse the repository at this point in the history
  • Loading branch information
gretay-js committed Jun 25, 2024
1 parent df7fe63 commit 80ba68a
Show file tree
Hide file tree
Showing 9 changed files with 32 additions and 38 deletions.
7 changes: 2 additions & 5 deletions middle_end/flambda2/from_lambda/closure_conversion.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1880,8 +1880,7 @@ let make_unboxed_function_wrapper acc function_slot ~unarized_params:params
(Poll_attribute.from_lambda (Function_decl.poll_attribute decl))
~zero_alloc_attribute:
(Zero_alloc_attribute.from_lambda
(Function_decl.zero_alloc_attribute decl)
(Debuginfo.Scoped_location.to_location (Function_decl.loc decl)))
(Function_decl.zero_alloc_attribute decl))
~is_a_functor:(Function_decl.is_a_functor decl)
~is_opaque:false ~recursive ~newer_version_of:None ~cost_metrics
~inlining_arguments:(Inlining_arguments.create ~round:0)
Expand Down Expand Up @@ -2249,8 +2248,7 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot
(Poll_attribute.from_lambda (Function_decl.poll_attribute decl))
~zero_alloc_attribute:
(Zero_alloc_attribute.from_lambda
(Function_decl.zero_alloc_attribute decl)
(Debuginfo.Scoped_location.to_location (Function_decl.loc decl)))
(Function_decl.zero_alloc_attribute decl))
~is_a_functor:(Function_decl.is_a_functor decl)
~is_opaque:(Function_decl.is_opaque decl)
~recursive ~newer_version_of:None ~cost_metrics
Expand Down Expand Up @@ -2379,7 +2377,6 @@ let close_functions acc external_env ~current_region function_declarations =
let zero_alloc_attribute =
Zero_alloc_attribute.from_lambda
(Function_decl.zero_alloc_attribute decl)
(Debuginfo.Scoped_location.to_location (Function_decl.loc decl))
in
let cost_metrics = Cost_metrics.zero in
let dbg = Debuginfo.from_location (Function_decl.loc decl) in
Expand Down
2 changes: 1 addition & 1 deletion middle_end/flambda2/simplify/simplify_set_of_closures.ml
Original file line number Diff line number Diff line change
Expand Up @@ -511,7 +511,7 @@ let simplify_function context ~outer_dacc function_slot code_id
let code_metadata = Code_or_metadata.code_metadata code_or_metadata in
let never_delete =
match Code_metadata.zero_alloc_attribute code_metadata with
| Default_check -> !Clflags.zero_alloc_check_assert_all
| Default_check -> false
| Assume _ -> false
| Check _ -> true
in
Expand Down
19 changes: 6 additions & 13 deletions middle_end/flambda2/terms/zero_alloc_attribute.ml
Original file line number Diff line number Diff line change
Expand Up @@ -35,21 +35,14 @@ let print ppf t =
Format.fprintf ppf "@[assert_zero_alloc%s@]"
(if strict then "_strict" else "")

let from_lambda : Lambda.zero_alloc_attribute -> Location.t -> t =
fun a loc ->
let from_lambda : Lambda.zero_alloc_attribute -> t =
fun a ->
match a with
| Default_zero_alloc ->
if !Clflags.zero_alloc_check_assert_all
&& Builtin_attributes.is_zero_alloc_check_enabled ~opt:false
then Check { strict = false; loc }
else Default_check
| Ignore_assert_all -> Default_check
| Assume { strict; never_returns_normally; never_raises; loc; arity = _ } ->
| Default_zero_alloc -> Default_check
| Assume { strict; never_returns_normally; never_raises; loc; } ->
Assume { strict; never_returns_normally; never_raises; loc }
| Check { strict; opt; loc; arity = _ } ->
if Builtin_attributes.is_zero_alloc_check_enabled ~opt
then Check { strict; loc }
else Default_check
| Check { strict; loc; } ->
Check { strict; loc }

let equal x y =
match x, y with
Expand Down
2 changes: 1 addition & 1 deletion middle_end/flambda2/terms/zero_alloc_attribute.mli
Original file line number Diff line number Diff line change
Expand Up @@ -29,4 +29,4 @@ val equal : t -> t -> bool

val is_default : t -> bool

val from_lambda : Lambda.zero_alloc_attribute -> Location.t -> t
val from_lambda : Lambda.zero_alloc_attribute -> t
8 changes: 2 additions & 6 deletions ocaml/lambda/lambda.ml
Original file line number Diff line number Diff line change
Expand Up @@ -634,18 +634,14 @@ type poll_attribute =
| Error_poll (* [@poll error] *)
| Default_poll (* no [@poll] attribute *)

type zero_alloc_attribute = Builtin_attributes.zero_alloc_attribute =
type zero_alloc_attribute =
| Default_zero_alloc
| Ignore_assert_all
| Check of { strict: bool;
opt: bool;
arity: int;
loc: Location.t;
}
| Assume of { strict: bool;
never_returns_normally: bool;
never_raises: bool;
arity: int;
loc: Location.t;
}

Expand Down Expand Up @@ -925,7 +921,7 @@ let default_function_attribute = {
}

let default_stub_attribute =
{ default_function_attribute with stub = true; zero_alloc = Ignore_assert_all }
{ default_function_attribute with stub = true; zero_alloc = Default_zero_alloc }

let default_param_attribute = { unbox_param = false }

Expand Down
6 changes: 1 addition & 5 deletions ocaml/lambda/lambda.mli
Original file line number Diff line number Diff line change
Expand Up @@ -510,23 +510,19 @@ type poll_attribute =
| Error_poll (* [@poll error] *)
| Default_poll (* no [@poll] attribute *)

type zero_alloc_attribute = Builtin_attributes.zero_alloc_attribute =
type zero_alloc_attribute =
| Default_zero_alloc
| Ignore_assert_all
| Check of { strict: bool;
(* [strict=true] property holds on all paths.
[strict=false] if the function returns normally,
then the property holds (but property violations on
exceptional returns or divering loops are ignored).
This definition may not be applicable to new properties. *)
opt: bool;
arity: int;
loc: Location.t;
}
| Assume of { strict: bool;
never_returns_normally: bool;
never_raises: bool;
arity: int;
loc: Location.t;
}

Expand Down
7 changes: 2 additions & 5 deletions ocaml/lambda/printlambda.ml
Original file line number Diff line number Diff line change
Expand Up @@ -939,15 +939,12 @@ let name_of_primitive = function
let zero_alloc_attribute ppf check =
match check with
| Default_zero_alloc -> ()
| Ignore_assert_all ->
fprintf ppf "ignore assert all zero_alloc@ "
| Assume {strict; never_returns_normally; loc = _} ->
fprintf ppf "assume_zero_alloc%s%s@ "
(if strict then "_strict" else "")
(if never_returns_normally then "_never_returns_normally" else "")
| Check {strict; loc = _; opt} ->
fprintf ppf "assert_zero_alloc%s%s@ "
(if opt then "_opt" else "")
| Check {strict; loc = _; } ->
fprintf ppf "assert_zero_alloc%s@ "
(if strict then "_strict" else "")

let function_attribute ppf t =
Expand Down
15 changes: 15 additions & 0 deletions ocaml/lambda/translcore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1608,6 +1608,21 @@ and transl_function ~in_new_scope ~scopes e params body
~mode ~return_sort ~return_mode
~scopes e.exp_loc repr ~region params body)
in
let zero_alloc : Lambda.zero_alloc_attribute =
match (zero_alloc : Builtin_attributes.zero_alloc_attribute) with
| Default_zero_alloc ->
if !Clflags.zero_alloc_check_assert_all &&
Builtin_attributes.is_zero_alloc_check_enabled ~opt:false
then Check { strict = false; loc = e.exp_loc }
else Default_zero_alloc
| Check { strict; opt; arity = _; loc } ->
if Builtin_attributes.is_zero_alloc_check_enabled ~opt
then Check { strict; loc }
else Default_zero_alloc
| Assume { strict; never_returns_normally; never_raises; loc; arity = _; } ->
Assume { strict; never_returns_normally; never_raises; loc }
| Ignore_assert_all -> Default_zero_alloc
in
let attr =
{ function_attribute_disallowing_arity_fusion with zero_alloc }
in
Expand Down
4 changes: 2 additions & 2 deletions ocaml/lambda/translmod.ml
Original file line number Diff line number Diff line change
Expand Up @@ -162,7 +162,7 @@ and apply_coercion_result loc strict funct params args cc_res =
~return:Lambda.layout_module
~attr:{ default_function_attribute with
is_a_functor = true;
zero_alloc = Ignore_assert_all;
zero_alloc = Default_zero_alloc;
stub = true; }
~loc
~mode:alloc_heap
Expand Down Expand Up @@ -572,7 +572,7 @@ let rec compile_functor ~scopes mexp coercion root_path loc =
loop = Never_loop;
is_a_functor = true;
is_opaque = false;
zero_alloc = Ignore_assert_all;
zero_alloc = Default_zero_alloc;
stub = false;
tmc_candidate = false;
may_fuse_arity = true;
Expand Down

0 comments on commit 80ba68a

Please sign in to comment.