Add argument for out variable name
This commit is contained in:
parent
c36ab43ab1
commit
e0fd48562b
GPG key ID:
800882B66C0C3326
1 changed files with 62 additions and 55 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue