diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml index b465a64..8275149 100644 --- a/compiler/obc/c/cgen.ml +++ b/compiler/obc/c/cgen.ml @@ -224,6 +224,7 @@ let rec assoc_type_lhs lhs var_env = match lhs with | _ -> Error.message no_location Error.Ederef_not_pointer) | CLfield(CLderef (CLvar "self"), { name = x }) -> assoc_type x var_env | CLfield(CLderef (CLvar "_out"), { name = x }) -> assoc_type x var_env + (* FIXME(Arduino): do we have to do something here? *) | CLfield(x, f) -> let ty = assoc_type_lhs x var_env in let n = struct_name ty in @@ -300,18 +301,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_env var_env exp = +and cexpr_of_exp out out_env var_env exp = match exp.e_desc with - | Eextvalue w -> cexpr_of_ext_value out_env var_env w + | Eextvalue w -> cexpr_of_ext_value out out_env var_env w (* Operators *) - | Eop(op, exps) -> cop_of_op out_env var_env op exps + | Eop(op, exps) -> cop_of_op out out_env var_env op exps (* Structure literals. *) | Estruct (tyn, fl) -> - let cexpr = cexpr_of_exp out_env var_env in + let cexpr = cexpr_of_exp 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_env var_env e_list) + Carraylit (cexprs_of_exps out out_env var_env e_list) and cexpr_of_struct tyn cexps_assoc = let cexps = List.fold_left @@ -320,8 +321,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_env var_env exps = - List.map (cexpr_of_exp out_env var_env) exps +and cexprs_of_exps out out_env var_env exps = + List.map (cexpr_of_exp out out_env var_env) exps and cop_of_op_aux op_name cexps = match op_name with | { qual = Pervasives; name = op } -> @@ -345,17 +346,17 @@ 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_env var_env op_name exps = - let cexps = cexprs_of_exps out_env var_env exps in +and cop_of_op out out_env var_env op_name exps = + let cexps = cexprs_of_exps out out_env var_env exps in cop_of_op_aux op_name cexps -and clhs_of_pattern out_env var_env l = match l.pat_desc with +and clhs_of_pattern 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 (CLderef (CLvar "_out"), local_qn n) + then CLfield (CLderef (CLvar out), local_qn n) else CLvar n in @@ -370,21 +371,21 @@ and clhs_of_pattern 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_env var_env l, fn) + | Lfield (l, fn) -> CLfield(clhs_of_pattern out out_env var_env l, fn) | Larray (l, idx) -> - CLarray(clhs_of_pattern out_env var_env l, - cexpr_of_exp out_env var_env idx) + CLarray(clhs_of_pattern out out_env var_env l, + cexpr_of_exp out out_env var_env idx) -and clhs_list_of_pattern_list out_env var_env lhss = - List.map (clhs_of_pattern out_env var_env) lhss +and clhs_list_of_pattern_list out out_env var_env lhss = + List.map (clhs_of_pattern out out_env var_env) lhss -and cexpr_of_pattern out_env var_env l = match l.pat_desc with +and cexpr_of_pattern 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 Cfield (Cderef (Cvar "_out"), local_qn n) + then Cfield (Cderef (Cvar out), local_qn n) else Cvar n in @@ -399,19 +400,19 @@ and cexpr_of_pattern 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_env var_env l, fn) + | Lfield (l, fn) -> Cfield(cexpr_of_pattern out out_env var_env l, fn) | Larray (l, idx) -> - Carray(cexpr_of_pattern out_env var_env l, - cexpr_of_exp out_env var_env idx) + Carray(cexpr_of_pattern out out_env var_env l, + cexpr_of_exp out out_env var_env idx) -and cexpr_of_ext_value out_env var_env w = match w.w_desc with +and cexpr_of_ext_value 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 -> let n = name v in let n_lhs = if IdentSet.mem v out_env - then Cfield (Cderef (Cvar "_out"), local_qn n) + then Cfield (Cderef (Cvar out), local_qn n) else Cvar n in @@ -425,10 +426,10 @@ and cexpr_of_ext_value 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_env var_env l, fn) + | Wfield (l, fn) -> Cfield(cexpr_of_ext_value out out_env var_env l, fn) | Warray (l, idx) -> - Carray(cexpr_of_ext_value out_env var_env l, - cexpr_of_exp out_env var_env idx) + Carray(cexpr_of_ext_value out out_env var_env l, + cexpr_of_exp out out_env var_env idx) let rec assoc_obj instance obj_env = match obj_env with @@ -451,7 +452,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 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 -> @@ -469,7 +470,8 @@ let step_fun_call out_env var_env sig_info objn out args = let f = Cfield (Cderef (Cvar "self"), local_qn (name o)) in let rec mk_idx pl = match pl with | [] -> f - | p::pl -> Carray (mk_idx pl, cexpr_of_pattern out_env var_env p) + | p::pl -> + Carray (mk_idx pl, cexpr_of_pattern out_v out_env var_env p) in mk_idx l ) in @@ -494,7 +496,7 @@ 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 "_out" out_env var_env sig_info objn out args in (* Our C expression for the function call. *) Cfun_call (classn ^ "_step", args) in @@ -552,23 +554,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_env var_env obj_env act = +let rec cstm_of_act 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_env var_env c in - let cte = cstm_of_act_list out_env var_env obj_env te in - let cfe = cstm_of_act_list out_env var_env obj_env fe in + 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 [Cif (cc, cte, cfe)] | Acase (c, [({name = "true"}, te)]) -> - let cc = cexpr_of_exp out_env var_env c in - let cte = cstm_of_act_list out_env var_env obj_env te in + 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 = [] in [Cif (cc, cte, cfe)] | Acase (c, [({name = "false"}, fe)]) -> - let cc = Cuop ("!", (cexpr_of_exp out_env var_env c)) in - let cte = cstm_of_act_list out_env var_env obj_env fe in + 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 cfe = [] in [Cif (cc, cte, cfe)] @@ -582,36 +584,36 @@ let rec cstm_of_act out_env var_env obj_env act = let ccl = List.map (fun (c,act) -> cname_of_qn c, - cstm_of_act_list out_env var_env obj_env act) cl in - [Cswitch (cexpr_of_exp out_env var_env e, ccl)] + 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)] | Ablock b -> - cstm_of_act_list out_env var_env obj_env b + cstm_of_act_list 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_env var_env i1, - cexpr_of_exp out_env var_env i2, - cstm_of_act_list out_env var_env obj_env 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)] (* Translate constant assignment *) | Aassgn (vn, { e_desc = Eextvalue { w_desc = Wconst c }; }) -> - let vn = clhs_of_pattern out_env var_env vn in + let vn = clhs_of_pattern 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_env var_env vn in + let vn = clhs_of_pattern out out_env var_env vn in let ty = assoc_type_lhs vn var_env in - let ce = cexpr_of_exp out_env var_env e in + let ce = cexpr_of_exp 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_env var_env op_name args)] + [Csexpr (cop_of_op out out_env var_env op_name args)] (* Reinitialization of an object variable, extracting the reset function's name from our environment [obj_env]. *) @@ -630,7 +632,8 @@ let rec cstm_of_act 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_env var_env p)) + mk_loop pl + (Carray (field, cexpr_of_pattern out out_env var_env p)) in mk_loop pl field ) @@ -639,8 +642,8 @@ let rec cstm_of_act 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_env var_env el in - let outvl = clhs_list_of_pattern_list out_env var_env outvl in + 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 | Acall (outv1, objn, MstepAsync, e1) -> @@ -648,10 +651,12 @@ let rec cstm_of_act out_env var_env obj_env act = (* 2. Atomic copy of the outputs *) assert false -and cstm_of_act_list out_env var_env obj_env b = +and cstm_of_act_list 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_env var_env obj_env) b.b_body) in + let cstm = List.flatten + (List.map (cstm_of_act out out_env var_env obj_env) b.b_body) + in match l with | [] -> cstm | _ -> @@ -714,7 +719,7 @@ let fun_def_of_step_fun n obj_env mem objs md = IdentSet.empty md.m_outputs in - let body = cstm_of_act_list out_env var_env obj_env md.m_body in + let body = cstm_of_act_list "_out" out_env var_env obj_env md.m_body in Cfundef { C.f_name = fun_name; @@ -758,7 +763,9 @@ let async_fun_def_of_step_fun n obj_env mem objs md copy_in_name [Caddrof (Cvar "_local_in"); Cvar "_in"]) in (* FIXME(Arduino): rename input & output variables *) - let body = cstm_of_act_list out_env var_env obj_env md.m_body in + let body = + cstm_of_act_list "_out" out_env var_env obj_env md.m_body + in let copy_out = Cfun_call (copy_out_name, [Cvar "_out"; Caddrof (Cvar "_local_out")]) in @@ -821,7 +828,7 @@ let reset_fun_def_of_class_def cd = if cd.cd_stateful then let var_env = List.map cvar_of_vd cd.cd_mems in let reset = find_reset_method cd in - cstm_of_act_list IdentSet.empty var_env cd.cd_objs reset.m_body + cstm_of_act_list "_out" IdentSet.empty var_env cd.cd_objs reset.m_body else [] in