From f72a092af3b1008aee7747cd2af482050c858f5c Mon Sep 17 00:00:00 2001 From: Tom Barthe Date: Tue, 22 Dec 2020 20:54:16 +0100 Subject: [PATCH] Add support for _local_in in cexprs --- compiler/obc/c/cgen.ml | 140 ++++++++++++++++++++++++----------------- 1 file changed, 82 insertions(+), 58 deletions(-) diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml index 2105e2e..87e4327 100644 --- a/compiler/obc/c/cgen.ml +++ b/compiler/obc/c/cgen.ml @@ -77,6 +77,24 @@ struct raise Errors.Error end +(* This type describes how of step functions' bodies must access + * their inputs. *) +type step_input = + { struct_expr : cexpr option; + inputs : var_dec list } + +let cvar_step_input var si = + let is_input = List.mem var (List.map (fun v -> v.v_ident) si.inputs) in + match si.struct_expr with + | Some sexp when is_input -> Cfield (sexp, local_qn (name var)) + | _ -> Cvar (name var) + +let mk_step_input inputs = + { struct_expr = None; inputs = inputs } + +let mk_step_input_packed sexp inputs = + { struct_expr = Some sexp; inputs = inputs } + let struct_name ty = match ty with | Cty_id n -> n @@ -303,18 +321,18 @@ let rec cexpr_of_static_exp se = | Stuple _ -> Misc.internal_error "cgen: static tuple" (** [cexpr_of_exp exp] translates the Obj action [exp] to a C expression. *) -and cexpr_of_exp out out_env var_env exp = +and cexpr_of_exp si out out_env var_env exp = match exp.e_desc with - | Eextvalue w -> cexpr_of_ext_value out out_env var_env w + | Eextvalue w -> cexpr_of_ext_value si out out_env var_env w (* Operators *) - | Eop(op, exps) -> cop_of_op out out_env var_env op exps + | Eop(op, exps) -> cop_of_op si out out_env var_env op exps (* Structure literals. *) | Estruct (tyn, fl) -> - let cexpr = cexpr_of_exp out out_env var_env in + let cexpr = cexpr_of_exp si out out_env var_env in let cexps_assoc = List.rev_map (fun (f, e) -> f, cexpr e) fl in cexpr_of_struct tyn cexps_assoc | Earray e_list -> - Carraylit (cexprs_of_exps out out_env var_env e_list) + Carraylit (cexprs_of_exps si out out_env var_env e_list) and cexpr_of_struct tyn cexps_assoc = let cexps = List.fold_left @@ -323,8 +341,8 @@ and cexpr_of_struct tyn cexps_assoc = (* Reverse `cexps' here because of the previous use of `List.fold_left'. *) Cstructlit (cname_of_qn tyn, List.rev cexps) -and cexprs_of_exps out out_env var_env exps = - List.map (cexpr_of_exp out out_env var_env) exps +and cexprs_of_exps si out out_env var_env exps = + List.map (cexpr_of_exp si out out_env var_env) exps and cop_of_op_aux op_name cexps = match op_name with | { qual = Pervasives; name = op } -> @@ -348,18 +366,20 @@ and cop_of_op_aux op_name cexps = match op_name with Cfun_call("fprintf", file::s::args) | { name = op } -> Cfun_call(op,cexps) -and cop_of_op out out_env var_env op_name exps = - let cexps = cexprs_of_exps out out_env var_env exps in +and cop_of_op si out out_env var_env op_name exps = + let cexps = cexprs_of_exps si out out_env var_env exps in cop_of_op_aux op_name cexps -and clhs_of_pattern out out_env var_env l = match l.pat_desc with +and clhs_of_pattern si out out_env var_env l = match l.pat_desc with (* Each Obc variable corresponds to a real local C variable. *) | Lvar v -> let n = name v in let n_lhs = if IdentSet.mem v out_env then CLfield (clhs_of_cexpr out, local_qn n) - else CLvar n + (* FIXME(Arduino): This is almost certainly useless, as inputs can't + * be lhs. *) + else clhs_of_cexpr (cvar_step_input v si) in if List.mem_assoc n var_env then @@ -373,15 +393,15 @@ and clhs_of_pattern out out_env var_env l = match l.pat_desc with (* Dereference our [self] struct holding the node's memory. *) | Lmem v -> CLfield (CLderef (CLvar "self"), local_qn (name v)) (* Field access. /!\ Indexed Obj expression should be a valid lhs! *) - | Lfield (l, fn) -> CLfield(clhs_of_pattern out out_env var_env l, fn) + | Lfield (l, fn) -> CLfield(clhs_of_pattern si out out_env var_env l, fn) | Larray (l, idx) -> - CLarray(clhs_of_pattern out out_env var_env l, - cexpr_of_exp out out_env var_env idx) + CLarray(clhs_of_pattern si out out_env var_env l, + cexpr_of_exp si out out_env var_env idx) -and clhs_list_of_pattern_list out out_env var_env lhss = - List.map (clhs_of_pattern out out_env var_env) lhss +and clhs_list_of_pattern_list si out out_env var_env lhss = + List.map (clhs_of_pattern si out out_env var_env) lhss -and cexpr_of_pattern out out_env var_env l = match l.pat_desc with +and cexpr_of_pattern si out out_env var_env l = match l.pat_desc with (* Each Obc variable corresponds to a real local C variable. *) | Lvar v -> let n = name v in @@ -402,12 +422,12 @@ and cexpr_of_pattern out out_env var_env l = match l.pat_desc with (* Dereference our [self] struct holding the node's memory. *) | Lmem v -> Cfield (Cderef (Cvar "self"), local_qn (name v)) (* Field access. /!\ Indexed Obj expression should be a valid lhs! *) - | Lfield (l, fn) -> Cfield(cexpr_of_pattern out out_env var_env l, fn) + | Lfield (l, fn) -> Cfield(cexpr_of_pattern si out out_env var_env l, fn) | Larray (l, idx) -> - Carray(cexpr_of_pattern out out_env var_env l, - cexpr_of_exp out out_env var_env idx) + Carray(cexpr_of_pattern si out out_env var_env l, + cexpr_of_exp si out out_env var_env idx) -and cexpr_of_ext_value out out_env var_env w = match w.w_desc with +and cexpr_of_ext_value si out out_env var_env w = match w.w_desc with | Wconst c -> cexpr_of_static_exp c (* Each Obc variable corresponds to a plain local C variable. *) | Wvar v -> @@ -415,7 +435,7 @@ and cexpr_of_ext_value out out_env var_env w = match w.w_desc with let n_lhs = if IdentSet.mem v out_env then Cfield (out, local_qn n) - else Cvar n + else cvar_step_input v si in if List.mem_assoc n var_env then @@ -428,10 +448,10 @@ and cexpr_of_ext_value out out_env var_env w = match w.w_desc with (* Dereference our [self] struct holding the node's memory. *) | Wmem v -> Cfield (Cderef (Cvar "self"), local_qn (name v)) (* Field access. /!\ Indexed Obj expression should be a valid lhs! *) - | Wfield (l, fn) -> Cfield(cexpr_of_ext_value out out_env var_env l, fn) + | Wfield (l, fn) -> Cfield(cexpr_of_ext_value si out out_env var_env l, fn) | Warray (l, idx) -> - Carray(cexpr_of_ext_value out out_env var_env l, - cexpr_of_exp out out_env var_env idx) + Carray(cexpr_of_ext_value si out out_env var_env l, + cexpr_of_exp si out out_env var_env idx) let rec assoc_obj instance obj_env = match obj_env with @@ -454,7 +474,7 @@ let out_var_name_of_objn o = (** Creates the list of arguments to call a node. [targeting] is the targeting of the called node, [mem] represents the node context and [args] the argument list.*) -let step_fun_call out_env var_env sig_info objn out args = +let step_fun_call si out_v out_env var_env sig_info objn out args = let rec add_targeting l ads = match l, ads with | [], [] -> [] | e::l, ad::ads -> @@ -473,8 +493,7 @@ let step_fun_call out_env var_env sig_info objn out args = let rec mk_idx pl = match pl with | [] -> f | p::pl -> - Carray (mk_idx pl, cexpr_of_pattern (Cderef (Cvar "_out")) - out_env var_env p) + Carray (mk_idx pl, cexpr_of_pattern si out_v out_env var_env p) in mk_idx l ) in @@ -486,7 +505,7 @@ let step_fun_call out_env var_env sig_info objn out args = [outvl] is a list of lhs where to put the results. [args] is the list of expressions to use as arguments. [mem] is the lhs where is stored the node's context.*) -let generate_function_call out_env var_env obj_env outvl objn args = +let generate_function_call si out_v out_env var_env obj_env outvl objn args = (* Class name for the object to step. *) let classln = assoc_cn objn obj_env in let classn = cname_of_qn classln in @@ -499,7 +518,9 @@ let generate_function_call out_env var_env obj_env outvl objn args = else (* The step function takes scalar arguments and its own internal memory holding structure. *) - let args = step_fun_call out_env var_env sig_info objn out args in + let args = + step_fun_call si out_v out_env var_env sig_info objn out args + in (* Our C expression for the function call. *) Cfun_call (classn ^ "_step", args) in @@ -557,23 +578,23 @@ let rec create_affect_const var_env (dest : clhs) c = (** [cstm_of_act obj_env mods act] translates the Obj action [act] to a list of C statements, using the association list [obj_env] to map object names to class names. *) -let rec cstm_of_act out out_env var_env obj_env act = +let rec cstm_of_act si out out_env var_env obj_env act = match act with (* Cosmetic : cases on boolean values are converted to if statements. *) | Acase (c, [({name = "true"}, te); ({ name = "false" }, fe)]) | Acase (c, [({name = "false"}, fe); ({ name = "true"}, te)]) -> - let cc = cexpr_of_exp out out_env var_env c in - let cte = cstm_of_act_list out out_env var_env obj_env te in - let cfe = cstm_of_act_list out out_env var_env obj_env fe in + let cc = cexpr_of_exp si out out_env var_env c in + let cte = cstm_of_act_list si out out_env var_env obj_env te in + let cfe = cstm_of_act_list si out out_env var_env obj_env fe in [Cif (cc, cte, cfe)] | Acase (c, [({name = "true"}, te)]) -> - let cc = cexpr_of_exp out out_env var_env c in - let cte = cstm_of_act_list out out_env var_env obj_env te in + let cc = cexpr_of_exp si out out_env var_env c in + let cte = cstm_of_act_list si out out_env var_env obj_env te in let cfe = [] in [Cif (cc, cte, cfe)] | Acase (c, [({name = "false"}, fe)]) -> - let cc = Cuop ("!", (cexpr_of_exp out out_env var_env c)) in - let cte = cstm_of_act_list out out_env var_env obj_env fe in + let cc = Cuop ("!", (cexpr_of_exp si out out_env var_env c)) in + let cte = cstm_of_act_list si out out_env var_env obj_env fe in let cfe = [] in [Cif (cc, cte, cfe)] @@ -587,36 +608,36 @@ let rec cstm_of_act out out_env var_env obj_env act = let ccl = List.map (fun (c,act) -> cname_of_qn c, - cstm_of_act_list out out_env var_env obj_env act) cl in - [Cswitch (cexpr_of_exp out out_env var_env e, ccl)] + cstm_of_act_list si out out_env var_env obj_env act) cl in + [Cswitch (cexpr_of_exp si out out_env var_env e, ccl)] | Ablock b -> - cstm_of_act_list out out_env var_env obj_env b + cstm_of_act_list si out out_env var_env obj_env b (* For composition of statements, just recursively apply our translation function on sub-statements. *) | Afor ({ v_ident = x }, i1, i2, act) -> - [Cfor(name x, cexpr_of_exp out out_env var_env i1, - cexpr_of_exp out out_env var_env i2, - cstm_of_act_list out out_env var_env obj_env act)] + [Cfor(name x, cexpr_of_exp si out out_env var_env i1, + cexpr_of_exp si out out_env var_env i2, + cstm_of_act_list si out out_env var_env obj_env act)] (* Translate constant assignment *) | Aassgn (vn, { e_desc = Eextvalue { w_desc = Wconst c }; }) -> - let vn = clhs_of_pattern out out_env var_env vn in + let vn = clhs_of_pattern si out out_env var_env vn in create_affect_const var_env vn c (* Purely syntactic translation from an Obc local variable to a C local one, with recursive translation of the rhs expression. *) | Aassgn (vn, e) -> - let vn = clhs_of_pattern out out_env var_env vn in + let vn = clhs_of_pattern si out out_env var_env vn in let ty = assoc_type_lhs vn var_env in - let ce = cexpr_of_exp out out_env var_env e in + let ce = cexpr_of_exp si out out_env var_env e in create_affect_stm vn ce ty (* Our Aop marks an operator invocation that will perform side effects. Just translate to a simple C statement. *) | Aop (op_name, args) -> - [Csexpr (cop_of_op out out_env var_env op_name args)] + [Csexpr (cop_of_op si out out_env var_env op_name args)] (* Reinitialization of an object variable, extracting the reset function's name from our environment [obj_env]. *) @@ -636,7 +657,7 @@ let rec cstm_of_act out out_env var_env obj_env act = [Csexpr (Cfun_call (classn ^ "_reset", [Caddrof field]))] | p::pl -> mk_loop pl - (Carray (field, cexpr_of_pattern out out_env var_env p)) + (Carray (field, cexpr_of_pattern si out out_env var_env p)) in mk_loop pl field ) @@ -645,20 +666,20 @@ let rec cstm_of_act out out_env var_env obj_env act = local structure to hold the results, before allocating to our variables. *) | Acall (outvl, objn, Mstep, el) -> - let args = cexprs_of_exps out out_env var_env el in - let outvl = clhs_list_of_pattern_list out out_env var_env outvl in - generate_function_call out_env var_env obj_env outvl objn args + let args = cexprs_of_exps si out out_env var_env el in + let outvl = clhs_list_of_pattern_list si out out_env var_env outvl in + generate_function_call si out out_env var_env obj_env outvl objn args | Acall (outv1, objn, MstepAsync, e1) -> (* 1. Atomic copy of the inputs *) (* 2. Atomic copy of the outputs *) assert false -and cstm_of_act_list out out_env var_env obj_env b = +and cstm_of_act_list si out out_env var_env obj_env b = let l = List.map cvar_of_vd b.b_locals in let var_env = l @ var_env in let cstm = List.flatten - (List.map (cstm_of_act out out_env var_env obj_env) b.b_body) + (List.map (cstm_of_act si out out_env var_env obj_env) b.b_body) in match l with | [] -> cstm @@ -722,8 +743,9 @@ let fun_def_of_step_fun n obj_env mem objs md = IdentSet.empty md.m_outputs in + let si = mk_step_input md.m_inputs in let body = - cstm_of_act_list (Cderef (Cvar "_out")) out_env var_env obj_env md.m_body + cstm_of_act_list si (Cderef (Cvar "_out")) out_env var_env obj_env md.m_body in Cfundef { @@ -771,11 +793,12 @@ let async_fun_def_of_step_fun n obj_env mem objs md copy_in_name let local_in = Cvar "_local_in" in let local_out = Cvar "_local_out" in + let si = mk_step_input_packed local_in md.m_inputs in let copy_in = Cfun_call (copy_in_name, [Caddrof local_in; Cvar "_in"]) in (* FIXME(Arduino): rename input & output variables *) let body = - cstm_of_act_list local_out out_env var_env obj_env md.m_body + cstm_of_act_list si local_out out_env var_env obj_env md.m_body in let copy_out = Cfun_call (copy_out_name, [Cvar "_out"; Caddrof local_out]) in @@ -836,9 +859,10 @@ let reset_fun_def_of_class_def cd = let body = if cd.cd_stateful then let var_env = List.map cvar_of_vd cd.cd_mems in + let si = mk_step_input [] in let reset = find_reset_method cd in - cstm_of_act_list (Cderef (Cvar "_out")) IdentSet.empty var_env cd.cd_objs - reset.m_body + cstm_of_act_list si (Cderef (Cvar "_out")) IdentSet.empty var_env + cd.cd_objs reset.m_body else [] in