Skip to content

Commit

Permalink
Revert "Transform tail-recursive functions into recursive continuatio…
Browse files Browse the repository at this point in the history 
…ns (ocaml-flambda#893)"

This reverts commit 5e903ca.
  • Loading branch information
@mshinwell
mshinwell committed Oct 20, 2022
1 parent 4dcd83d commit 41454a0
Show file tree
Hide file tree
Showing 34 changed files with 68 additions and 614 deletions.
47 changes: 10 additions & 37 deletions middle_end/flambda2/from_lambda/closure_conversion.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1093,28 +1093,8 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot decl
let params = Function_decl.params decl in
let return = Function_decl.return decl in
let return_continuation = Function_decl.return_continuation decl in
let acc, exn_continuation =
close_exn_continuation acc external_env
(Function_decl.exn_continuation decl)
in
assert (
match Exn_continuation.extra_args exn_continuation with
| [] -> true
| _ :: _ -> false);
let my_closure = Variable.create "my_closure" in
let recursive = Function_decl.recursive decl in
(* Mark function available for loopify only if it is a single recursive
function *)
let is_single_recursive_function =
match recursive, Function_decls.to_list function_declarations with
| Recursive, [_] -> true
| Recursive, ([] | _ :: _ :: _) -> false
| Non_recursive, _ -> false
in
let acc =
Acc.push_closure_info acc ~return_continuation ~exn_continuation ~my_closure
~is_purely_tailrec:is_single_recursive_function
in
let my_closure = Variable.create "my_closure" in
let my_region = Function_decl.my_region decl in
let function_slot = Function_decl.function_slot decl in
let my_depth = Variable.create "my_depth" in
Expand Down Expand Up @@ -1300,6 +1280,14 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot decl
Let_with_acc.create acc bound (Named.create_rec_info next_depth_expr) ~body
in
let cost_metrics = Acc.cost_metrics acc in
let acc, exn_continuation =
close_exn_continuation acc external_env
(Function_decl.exn_continuation decl)
in
assert (
match Exn_continuation.extra_args exn_continuation with
| [] -> true
| _ :: _ -> false);
let inline : Inline_attribute.t =
(* We make a decision based on [fallback_inlining_heuristic] here to try to
mimic Closure's behaviour as closely as possible, particularly when there
Expand Down Expand Up @@ -1333,7 +1321,6 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot decl
|> Acc.remove_continuation_from_free_names
(Exn_continuation.exn_handler exn_continuation)
in
let closure_info, acc = Acc.pop_closure_info acc in
let params_arity = Bound_parameters.arity_with_subkinds params in
let is_tupled =
match Function_decl.kind decl with Curried _ -> false | Tupled -> true
Expand All @@ -1345,15 +1332,6 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot decl
then Function_decl_inlining_decision_type.Stub
else Function_decl_inlining_decision_type.Not_yet_decided
in
let loopify : Loopify_attribute.t =
match Function_decl.loop decl with
| Always_loop -> Always_loopify
| Never_loop -> Never_loopify
| Default_loop ->
if closure_info.is_purely_tailrec
then Default_loopify_and_tailrec
else Default_loopify_and_not_tailrec
in
let code =
Code.create code_id ~params_and_body
~free_names_of_params_and_body:(Acc.free_names acc) ~params_arity
Expand All @@ -1373,7 +1351,7 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot decl
~dbg ~is_tupled
~is_my_closure_used:
(Function_params_and_body.is_my_closure_used params_and_body)
~inlining_decision ~absolute_history ~relative_history ~loopify
~inlining_decision ~absolute_history ~relative_history
in
let approx =
let code = Code_or_metadata.create code in
Expand Down Expand Up @@ -1502,7 +1480,6 @@ let close_functions acc external_env ~current_region function_declarations =
~inlining_decision:Recursive
~absolute_history:(Inlining_history.Absolute.empty compilation_unit)
~relative_history:Inlining_history.Relative.empty
~loopify:Never_loopify
in
let code = Code_or_metadata.create_metadata_only metadata in
let approx =
Expand Down Expand Up @@ -1763,7 +1740,6 @@ let wrap_partial_application acc env apply_continuation (apply : IR.apply)
specialise = Default_specialise;
local = Default_local;
check = Default_check;
loop = Default_loop;
is_a_functor = false;
stub = false;
poll = Default_poll
Expand Down Expand Up @@ -2239,9 +2215,6 @@ let close_program (type mode) ~(mode : mode Flambda_features.mode)
defining_expr ~body)
(acc, body) (Acc.declared_symbols acc)
in
if Option.is_some (Acc.top_closure_info acc)
then
Misc.fatal_error "Information on nested closures should be empty at the end";
let get_code_metadata code_id =
Code_id.Map.find code_id (Acc.code acc) |> Code.code_metadata
in
Expand Down
137 changes: 8 additions & 129 deletions middle_end/flambda2/from_lambda/closure_conversion_aux.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -375,13 +375,6 @@ module Acc = struct
| Trackable_arguments of Env.value_approximation list
| Untrackable

type closure_info =
{ return_continuation : Continuation.t;
exn_continuation : Exn_continuation.t;
my_closure : Variable.t;
is_purely_tailrec : bool
}

type t =
{ declared_symbols : (Symbol.t * Static_const.t) list;
lifted_sets_of_closures :
Expand All @@ -396,8 +389,7 @@ module Acc = struct
seen_a_function : bool;
symbol_for_global : Ident.t -> Symbol.t;
slot_offsets : Slot_offsets.t;
regions_closed_early : Ident.Set.t;
closure_infos : closure_info list
regions_closed_early : Ident.Set.t
}

let cost_metrics t = t.cost_metrics
Expand All @@ -422,8 +414,7 @@ module Acc = struct
seen_a_function = false;
symbol_for_global;
slot_offsets;
regions_closed_early = Ident.Set.empty;
closure_infos = []
regions_closed_early = Ident.Set.empty
}

let declared_symbols t = t.declared_symbols
Expand Down Expand Up @@ -460,47 +451,15 @@ module Acc = struct
let add_free_names free_names t =
{ t with free_names = Name_occurrences.union free_names t.free_names }

let add_free_names_and_check_my_closure_use free_names t =
let t =
match t.closure_infos with
| [] -> t
| closure_info :: closure_infos ->
if closure_info.is_purely_tailrec
&& Name_occurrences.mem_var free_names closure_info.my_closure
then
{ t with
closure_infos =
{ closure_info with is_purely_tailrec = false } :: closure_infos
}
else t
in
add_free_names free_names t

let add_name_to_free_names ~is_tail_call ~name t =
let closure_infos =
match is_tail_call, t.closure_infos with
| true, closure_infos -> closure_infos
| false, [] -> []
| false, closure_info :: closure_infos ->
if closure_info.is_purely_tailrec
&& Name.equal (Name.var closure_info.my_closure) name
then { closure_info with is_purely_tailrec = false } :: closure_infos
else t.closure_infos
in
let add_name_to_free_names ~name t =
{ t with
closure_infos;
free_names = Name_occurrences.add_name t.free_names name Name_mode.normal
}

let add_simple_to_free_names_maybe_tail_call ~is_tail_call acc simple =
let add_simple_to_free_names acc simple =
Simple.pattern_match simple
~const:(fun _ -> acc)
~name:(fun name ~coercion ->
let acc = add_name_to_free_names ~is_tail_call ~name acc in
add_free_names (Coercion.free_names coercion) acc)

let add_simple_to_free_names acc simple =
add_simple_to_free_names_maybe_tail_call ~is_tail_call:false acc simple
~name:(fun name ~coercion:_ -> add_name_to_free_names ~name acc)

let remove_code_id_or_symbol_from_free_names code_id_or_symbol t =
{ t with
Expand Down Expand Up @@ -579,36 +538,6 @@ module Acc = struct
set_of_closures
in
{ t with slot_offsets }

let top_closure_info t =
match t.closure_infos with
| [] -> None
| closure_info :: _ -> Some closure_info

let push_closure_info t ~return_continuation ~exn_continuation ~my_closure
~is_purely_tailrec =
{ t with
closure_infos =
{ return_continuation; exn_continuation; my_closure; is_purely_tailrec }
:: t.closure_infos
}

let pop_closure_info t =
let closure_info, closure_infos =
match t.closure_infos with
| [] -> Misc.fatal_error "pop_closure_info called on empty stack"
| closure_info :: closure_infos -> closure_info, closure_infos
in
let closure_infos =
match closure_infos with
| [] -> []
| closure_info2 :: closure_infos2 ->
if closure_info2.is_purely_tailrec
&& Name_occurrences.mem_var t.free_names closure_info2.my_closure
then { closure_info2 with is_purely_tailrec = false } :: closure_infos2
else closure_infos
in
closure_info, { t with closure_infos }
end

module Function_decls = struct
Expand Down Expand Up @@ -687,8 +616,6 @@ module Function_decls = struct

let poll_attribute t = t.attr.poll

let loop t = t.attr.loop

let is_a_functor t = t.attr.is_a_functor

let check_attribute t = t.attr.check
Expand Down Expand Up @@ -782,40 +709,7 @@ module Expr_with_acc = struct
(Code_size.apply apply |> Cost_metrics.from_size)
acc
in
let is_tail_call =
match Acc.top_closure_info acc with
| None -> false
| Some { return_continuation; exn_continuation; _ } -> (
(match Apply_expr.continuation apply with
| Never_returns -> true
| Return cont -> Continuation.equal cont return_continuation)
&& Exn_continuation.equal
(Apply_expr.exn_continuation apply)
exn_continuation
(* If the return and exn continuation match, the call is in tail
position, but could still be an under- or over-application. By
checking that it is a direct call, we are sure it has the correct
arity. *)
&&
match Apply.call_kind apply with
| Function { function_call = Direct _; _ } -> true
| Function
{ function_call = Indirect_unknown_arity | Indirect_known_arity _;
_
} ->
false
| Method _ -> false
| C_call _ -> false)
in
let acc =
Acc.add_simple_to_free_names_maybe_tail_call ~is_tail_call acc
(Apply.callee apply)
in
let acc =
Acc.add_free_names_and_check_my_closure_use
(Apply_expr.free_names_except_callee apply)
acc
in
let acc = Acc.add_free_names (Apply_expr.free_names apply) acc in
let acc =
match Apply_expr.continuation apply with
| Never_returns -> acc
Expand Down Expand Up @@ -848,11 +742,7 @@ module Apply_cont_with_acc = struct
let create acc ?trap_action ?args_approx cont ~args ~dbg =
let apply_cont = Apply_cont.create ?trap_action cont ~args ~dbg in
let acc = Acc.add_continuation_application ~cont args_approx acc in
let acc =
Acc.add_free_names_and_check_my_closure_use
(Apply_cont.free_names apply_cont)
acc
in
let acc = Acc.add_free_names (Apply_cont.free_names apply_cont) acc in
acc, apply_cont

let goto acc cont =
Expand Down Expand Up @@ -907,18 +797,7 @@ module Let_with_acc = struct
~code_id:(fun acc cid -> Acc.remove_code_id_from_free_names cid acc)
in
let let_expr = Let.create let_bound named ~body ~free_names_of_body in
let is_project_value_slot =
match[@ocaml.warning "-4"] (named : Named.t) with
| Prim (Unary (Project_value_slot _, _), _) -> true
| _ -> false
in
let acc =
if is_project_value_slot
then Acc.add_free_names (Named.free_names named) acc
else
Acc.add_free_names_and_check_my_closure_use (Named.free_names named)
acc
in
let acc = Acc.add_free_names (Named.free_names named) acc in
acc, Expr.create_let let_expr
end

Expand Down
21 changes: 0 additions & 21 deletions middle_end/flambda2/from_lambda/closure_conversion_aux.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -179,13 +179,6 @@ end

(** Used to pipe some data through closure conversion *)
module Acc : sig
type closure_info = private
{ return_continuation : Continuation.t;
exn_continuation : Exn_continuation.t;
my_closure : Variable.t;
is_purely_tailrec : bool
}

type t

val create :
Expand Down Expand Up @@ -259,18 +252,6 @@ module Acc : sig

val add_set_of_closures_offsets :
is_phantom:bool -> t -> Set_of_closures.t -> t

val top_closure_info : t -> closure_info option

val push_closure_info :
t ->
return_continuation:Continuation.t ->
exn_continuation:Exn_continuation.t ->
my_closure:Variable.t ->
is_purely_tailrec:bool ->
t

val pop_closure_info : t -> closure_info * t
end

(** Used to represent information about a set of function declarations during
Expand Down Expand Up @@ -324,8 +305,6 @@ module Function_decls : sig

val poll_attribute : t -> Lambda.poll_attribute

val loop : t -> Lambda.loop_attribute

val is_a_functor : t -> bool

val check_attribute : t -> Lambda.check_attribute
Expand Down
2 changes: 0 additions & 2 deletions middle_end/flambda2/parser/fexpr_to_flambda.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -778,7 +778,6 @@ let rec expr env (e : Fexpr.expr) : Flambda.Expr.t =
in
let code =
(* CR mshinwell: [inlining_decision] should maybe be set properly *)
(* CR ncourant: same for loopify *)
Code.create code_id ~params_and_body ~free_names_of_params_and_body
~newer_version_of ~params_arity ~num_trailing_local_params:0
~result_arity ~result_types:Unknown
Expand All @@ -794,7 +793,6 @@ let rec expr env (e : Fexpr.expr) : Flambda.Expr.t =
(Inlining_history.Absolute.empty
(Compilation_unit.get_current_exn ()))
~relative_history:Inlining_history.Relative.empty
~loopify:Never_loopify
in
Flambda.Static_const_or_code.create_code code
in
Expand Down
Loading

0 comments on commit 41454a0

Please sign in to comment.