Commit 3e1877a1 authored by Stefan Gränitz's avatar Stefan Gränitz
Browse files

[WIP] Initialize captures only once upfront

parent 1cfad74e
Pipeline #37242 failed with stages
......@@ -1727,17 +1727,11 @@ and convert_expr_node ?(drop_temp=false) env aux e does_remove_virtual =
let signatures = List.map make_signature overloads in
let lam_type = Lambda (signatures, closures) in
let struct_name = Mangling.mangle_cc_type lam_type in
let env = lambda_create_def_struct env struct_name lam_type overloads closures in
let init_helper_name = lambda_local_init_helper_name env in
let init_helper_decl =
DECDEF(
None,
([ SpecCV CV_CONST; SpecType (Tstruct(struct_name, None,[]))],
[(init_helper_name, JUSTBASE, [], loc), NO_INIT ]),loc);
in
let aux = add_local_aux_def aux init_helper_decl in
let env = Convert_env.add_local_var env init_helper_name lam_type in
let struct_def = convert_lambda_type env lam_type overloads closures in
let env = instantiate_lambda_type env struct_def closures in
let (env, aux) =
lambda_create_init_helper env aux lam_type init_helper_name struct_name loc in
let (env, aux) = lambda_initialize_captures env aux lam_type struct_name init_helper_name closures in
let (env, aux) = convert_lambda_instantiations
env init_helper_name lam_type
overloads closures aux in
......@@ -1754,7 +1748,7 @@ and lambda_init_overload_fptr lam_type ovl =
Cxx_utils.unqual_type (Pointer (PFunctionPointer fn_sig))
(* Create the definition of the struct that represents the lambda instance *)
and convert_lambda_type env lam_type overloads closures =
and lambda_create_def_struct env name lam_type overloads closures =
let loc = Convert_env.get_loc env in
let field_of_capture cap =
let s, t = capture_name_type env cap in
......@@ -1769,15 +1763,51 @@ and convert_lambda_type env lam_type overloads closures =
in
let cap_fields = List.map field_of_capture closures in
let fptr_fields = List.map field_of_functions overloads in
let struct_name = Mangling.mangle_cc_type lam_type in
ONLYTYPEDEF (
[SpecType (Tstruct(struct_name, Some (fptr_fields @ cap_fields),[]))],loc)
(* Create a local instance and initialize the captures (TODO) *)
and instantiate_lambda_type env struct_def closures =
let _unused = closures in
let struct_def = ONLYTYPEDEF (
[SpecType (Tstruct(name, Some (fptr_fields @ cap_fields),[]))],loc) in
Convert_env.add_c_global env struct_def
and lambda_create_init_helper env aux lam_type init_helper_name struct_name loc =
let init_helper_decl =
DECDEF(
None,
([ SpecCV CV_CONST; SpecType (Tstruct(struct_name, None,[]))],
[(init_helper_name, JUSTBASE, [], loc), NO_INIT ]),loc);
in
let aux = add_local_aux_def aux init_helper_decl in
let env = Convert_env.add_local_var env init_helper_name lam_type in
(env, aux)
(* Emit a function that initializes the captures for a local lambda instance.
We don't necessarily need a function for this, but doing it like this is a
more straightforward change. *)
and lambda_initialize_captures env aux lam_type struct_name init_helper_name closures =
let loc = Convert_env.get_loc env in
let cloc = Convert_env.get_clang_loc env in
let make_arg_decl cap =
let (arg_name, arg_type) = capture_name_type env cap in
{ arg_name; arg_type; arg_loc = cloc }
in
let fn_ptr_param =
Cxx_utils.(force_ptr_to_const (obj_ptr (unqual_type lam_type))) in
let this_ptr = mk_arg_decl fn_ptr_param closure_name cloc in
let args = this_ptr :: (List.map make_arg_decl closures) in
let fn_name = struct_name ^ "_init_captures" in
let env, proto =
make_prototype loc env fn_name (FKConstructor true)
(Cxx_utils.unqual_type Void) args false false
in
let body = List.map (make_assign_cap env) closures in
let env = Convert_env.add_c_global env (FUNDEF(None, proto, raw_block body, loc, loc)) in
let mk_arg cap = mk_var env (fst (capture_name_type env cap)) in
let lam = mk_addrof env (mk_var env init_helper_name) in
let actual_args = lam :: (List.map mk_arg closures) in
let f = mk_var env fn_name in
let call = mk_expr env (CALL(f,actual_args,[])) in
let inserted_call = make_computation env call in
let aux = add_local_aux_init aux inserted_call in
(env, aux)
and convert_lambda_instantiations env init_helper_name lam_type overloads closures aux =
match overloads with
| [] -> (env, aux)
......@@ -1792,7 +1822,7 @@ and convert_lambda_instantiations env init_helper_name lam_type overloads closur
and convert_lambda_single_instance env init_helper_name lam_type ovl closures aux =
let cons_def =
convert_lambda_init env lam_type ovl closures
convert_lambda_init env lam_type ovl
in
let env = Convert_env.add_c_global env cons_def in
let env = Convert_env.add_closure_info env closures in
......@@ -1802,41 +1832,34 @@ and convert_lambda_single_instance env init_helper_name lam_type ovl closures au
let env = Convert_env.add_c_global env glob in
let env = Convert_env.reset_closure env in
let lam_init =
convert_lambda_init_call env lam_type init_helper_name ovl.id body_name closures
convert_lambda_init_call env lam_type init_helper_name ovl.id body_name
in
let aux = add_local_aux_init aux lam_init in
env, aux
and convert_lambda_init env lam_type ovl closures =
and convert_lambda_init env lam_type ovl =
let loc = Convert_env.get_loc env in
let cloc = Convert_env.get_clang_loc env in
let struct_name = Mangling.mangle_cc_type lam_type in
let ctor_name = struct_name ^ "_init_" ^ Int64.to_string ovl.id in
let fptr_type = lambda_init_overload_fptr lam_type ovl in
let fptr_arg_decl = mk_arg_decl fptr_type "__fc_func" cloc in
let make_closure_arg_decl cap =
let (arg_name, arg_type) = capture_name_type env cap in
{ arg_name; arg_type; arg_loc = cloc }
in
let fn_ptr_param =
Cxx_utils.(force_ptr_to_const (obj_ptr (unqual_type lam_type))) in
let this_ptr = mk_arg_decl fn_ptr_param closure_name cloc in
let captures = List.map make_closure_arg_decl closures in
let args = this_ptr :: fptr_arg_decl :: captures in
let args = [this_ptr; fptr_arg_decl] in
let env, proto =
make_prototype loc env ctor_name (FKConstructor true)
(Cxx_utils.unqual_type Void) args false false
in
let fn_name = lambda_unique_overload_name ovl.id in
let body = List.map (make_assign_cap env) closures in
let body =
let body_stmt =
make_computation env
(mk_assign env
(mk_expr env (make_closure_access env fn_name false))
(mk_var env "__fc_func"))
:: body
in
FUNDEF(None, proto, raw_block body, loc, loc)
FUNDEF(None, proto, raw_block [body_stmt], loc, loc)
and make_assign_cap env cap =
let name, typ = capture_name_type env cap in
......@@ -1902,14 +1925,14 @@ and convert_lambda_body env lam_type lam_inst =
env, name, FUNDEF (None, full_name, raw_block cbody,loc,loc)
and convert_lambda_init_call
env lam_type init_helper_name id body_name closures =
env lam_type init_helper_name id body_name =
let struct_name = Mangling.mangle_cc_type lam_type in
let f = mk_var env (struct_name ^ "_init_" ^ Int64.to_string id) in
let lam = mk_addrof env (mk_var env init_helper_name) in
let ptr = mk_var env body_name in
let mk_arg cap = mk_var env (fst (capture_name_type env cap)) in
let args = List.map mk_arg closures in
let call = mk_expr env (CALL(f,lam :: ptr :: args,[])) in
(*let mk_arg cap = mk_var env (fst (capture_name_type env cap)) in
let args = List.map mk_arg closures in*)
let call = mk_expr env (CALL(f,[lam; ptr],[])) in
make_computation env call
and convert_expr ?drop_temp env aux e =
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment