Remove MstepAsync and add stub function for calls

compiler/main/mls2obc.ml

@@ -601,11 +601,7 @@ and mk_node_call map call_context app loc (name_list : Obc.pattern list) args ty
           | Minils.Easync _ -> []
           | _ -> assert false
         in
-        let m = match app.Minils.a_op with
+        let s = [Acall (name_list, o, Mstep, args)] in
-          | Minils.Easync _ -> MstepAsync
-          | _ -> Mstep
-        in
-        let s = [Acall (name_list, o, m, args)] in
         [], si, [obj], s
     | _ -> assert false
 

compiler/obc/c/cgen.ml

@@ -77,23 +77,39 @@ struct
     raise Errors.Error
 end
 
-(* This type describes how of step functions' bodies must access
+type vars_rewriter =
- * their inputs. *)
+  { vr_vars : IdentSet.t;
-type step_input =
+    vr_rewrite : ident -> cexpr }
-  { struct_expr : cexpr option;
+
-    inputs : var_dec list }
+let vr_match vr var = IdentSet.mem var vr.vr_vars
-
+
-let cvar_step_input var si =
+let vr_direct vars =
-  let is_input = List.mem var (List.map (fun v -> v.v_ident) si.inputs) in
+  { vr_vars = vars;
-  match si.struct_expr with
+    vr_rewrite = fun var -> Cvar (name var) }
-  | Some sexp when is_input -> Cfield (sexp, local_qn (name var))
+
-  | _ -> Cvar (name var)
+let vr_field st_expr vars =
-
+  { vr_vars = vars;
-let mk_step_input inputs =
+    vr_rewrite = fun var -> Cfield (st_expr, local_qn (name var)) }
-  { struct_expr = None; inputs = inputs }
+
+let vr_rewrite vr var =
+  if vr_match vr var then
+    vr.vr_rewrite var
+  else
+    Cvar (name var)
+
+let vr_compose a b =
+  let rewrite var =
+    let vr = if vr_match a var then a else b in
+    vr_rewrite vr var
+  in
+  { vr_rewrite = rewrite;
+    vr_vars = IdentSet.union a.vr_vars b.vr_vars }
 
-let mk_step_input_packed sexp inputs =
+let ident_set_of_var_decs vds =
-  { struct_expr = Some sexp; inputs = inputs }
+  List.fold_left
+    (fun set vd -> IdentSet.add vd.v_ident set)
+    IdentSet.empty
+    vds
 
 let struct_name ty =
   match ty with
@@ -321,18 +337,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 si out out_env var_env exp =
+and cexpr_of_exp vr var_env exp =
   match exp.e_desc with
-    | Eextvalue w  -> cexpr_of_ext_value si out out_env var_env w
+    | Eextvalue w  -> cexpr_of_ext_value vr var_env w
     (* Operators *)
-    | Eop(op, exps) -> cop_of_op si out out_env var_env op exps
+    | Eop(op, exps) -> cop_of_op vr var_env op exps
     (* Structure literals. *)
     | Estruct (tyn, fl) ->
-        let cexpr = cexpr_of_exp si out out_env var_env in
+        let cexpr = cexpr_of_exp vr 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 si out out_env var_env e_list)
+        Carraylit (cexprs_of_exps vr var_env e_list)
 
 and cexpr_of_struct tyn cexps_assoc =
   let cexps = List.fold_left
@@ -341,8 +357,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 si out out_env var_env exps =
+and cexprs_of_exps vr var_env exps =
-  List.map (cexpr_of_exp si out out_env var_env) exps
+  List.map (cexpr_of_exp vr var_env) exps
 
 and cop_of_op_aux op_name cexps = match op_name with
     | { qual = Pervasives; name = op } ->
@@ -366,22 +382,15 @@ 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 si out out_env var_env op_name exps =
+and cop_of_op vr var_env op_name exps =
-  let cexps = cexprs_of_exps si out out_env var_env exps in
+  let cexps = cexprs_of_exps vr var_env exps in
   cop_of_op_aux op_name cexps
 
-and clhs_of_pattern si out out_env var_env l = match l.pat_desc with
+and clhs_of_pattern vr 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 =
+      let n_lhs = clhs_of_cexpr (vr_rewrite vr v) in
-        if IdentSet.mem v out_env
-        then CLfield (clhs_of_cexpr out, local_qn 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
         let ty = assoc_type n var_env in
         (match ty with
@@ -393,24 +402,19 @@ and clhs_of_pattern si 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 si out out_env var_env l, fn)
+  | Lfield (l, fn) -> CLfield(clhs_of_pattern vr var_env l, fn)
   | Larray (l, idx) ->
-      CLarray(clhs_of_pattern si out out_env var_env l,
+      CLarray(clhs_of_pattern vr var_env l,
-              cexpr_of_exp si out out_env var_env idx)
+              cexpr_of_exp vr var_env idx)
 
-and clhs_list_of_pattern_list si out out_env var_env lhss =
+and clhs_list_of_pattern_list vr var_env lhss =
-  List.map (clhs_of_pattern si out out_env var_env) lhss
+  List.map (clhs_of_pattern vr var_env) lhss
 
-and cexpr_of_pattern si out out_env var_env l = match l.pat_desc with
+and cexpr_of_pattern vr 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 =
+      let n_lhs = vr_rewrite vr v in
-        if IdentSet.mem v out_env
-        then Cfield (out, local_qn n)
-        else Cvar n
-      in
-
       if List.mem_assoc n var_env then
         let ty = assoc_type n var_env in
         (match ty with
@@ -422,22 +426,17 @@ and cexpr_of_pattern si 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 si out out_env var_env l, fn)
+  | Lfield (l, fn) -> Cfield(cexpr_of_pattern vr var_env l, fn)
   | Larray (l, idx) ->
-      Carray(cexpr_of_pattern si out out_env var_env l,
+      Carray(cexpr_of_pattern vr var_env l,
-             cexpr_of_exp si out out_env var_env idx)
+             cexpr_of_exp vr var_env idx)
 
-and cexpr_of_ext_value si out out_env var_env w = match w.w_desc with
+and cexpr_of_ext_value vr 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 =
+    let n_lhs = vr_rewrite vr v in
-      if IdentSet.mem v out_env
-      then Cfield (out, local_qn n)
-      else cvar_step_input v si
-    in
-
     if List.mem_assoc n var_env then
       let ty = assoc_type n var_env in
       (match ty with
@@ -448,10 +447,10 @@ and cexpr_of_ext_value si 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 si out out_env var_env l, fn)
+  | Wfield (l, fn) -> Cfield(cexpr_of_ext_value vr var_env l, fn)
   | Warray (l, idx) ->
-    Carray(cexpr_of_ext_value si out out_env var_env l,
+    Carray(cexpr_of_ext_value vr var_env l,
-           cexpr_of_exp si out out_env var_env idx)
+           cexpr_of_exp vr var_env idx)
 
 let rec assoc_obj instance obj_env =
   match obj_env with
@@ -474,7 +473,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 si out_v out_env var_env sig_info objn out args =
+let step_fun_call vr var_env sig_info objn out args =
   let rec add_targeting l ads = match l, ads with
     | [], [] -> []
     | e::l, ad::ads ->
@@ -493,7 +492,7 @@ let step_fun_call si out_v 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 si out_v out_env var_env p)
+                Carray (mk_idx pl, cexpr_of_pattern vr var_env p)
              in
              mk_idx l
       ) in
@@ -505,24 +504,30 @@ let step_fun_call si out_v 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 si out_v out_env var_env obj_env outvl objn args =
+let generate_function_call vr 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
   let sig_info = find_value classln in
   let out = Cvar (out_var_name_of_objn classn) in
+  let od = assoc_obj (obj_ref_name objn) obj_env in
 
   let fun_call =
     if is_op classln then
       cop_of_op_aux classln args
     else
-      (* The step function takes scalar arguments and its own internal memory
+      (* The step function takes scalar arguments and its own internal
-          holding structure. *)
+         memory holding structure. *)
       let args =
-        step_fun_call si out_v out_env var_env sig_info objn out args
+        step_fun_call vr var_env sig_info objn out args
       in
       (* Our C expression for the function call. *)
       Cfun_call (classn ^ "_step", args)
+      (* TODO(Arduino):
+         1. pack arguments in local variable
+         2. "send" arguments to global variable
+         3. "retrieve" outputs from global variable
+       *)
   in
 
   (* Act according to the length of our list. Step functions with
@@ -540,7 +545,7 @@ let generate_function_call si out_v out_env var_env obj_env outvl objn args =
           let ty = assoc_type_lhs outv var_env in
             create_affect_stm outv (Cfield (out, local_qn out_name)) ty
         in
-          (Csexpr fun_call)::(List.flatten (map2 create_affect outvl out_sig))
+          (Csexpr fun_call) :: (List.flatten (map2 create_affect outvl out_sig))
 
 (** Create the statement dest = c where c = v^n^m... *)
 let rec create_affect_const var_env (dest : clhs) c =
@@ -578,23 +583,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 si out out_env var_env obj_env act =
+let rec cstm_of_act vr 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 si out out_env var_env c in
+        let cc = cexpr_of_exp vr var_env c in
-        let cte = cstm_of_act_list si out out_env var_env obj_env te in
+        let cte = cstm_of_act_list vr var_env obj_env te in
-        let cfe = cstm_of_act_list si out out_env var_env obj_env fe in
+        let cfe = cstm_of_act_list vr var_env obj_env fe in
         [Cif (cc, cte, cfe)]
     | Acase (c, [({name = "true"}, te)]) ->
-        let cc = cexpr_of_exp si out out_env var_env c in
+        let cc = cexpr_of_exp vr var_env c in
-        let cte = cstm_of_act_list si out out_env var_env obj_env te in
+        let cte = cstm_of_act_list vr var_env obj_env te in
         let cfe = [] in
         [Cif (cc, cte, cfe)]
     | Acase (c, [({name = "false"}, fe)]) ->
-        let cc = Cuop ("!", (cexpr_of_exp si out out_env var_env c)) in
+        let cc = Cuop ("!", (cexpr_of_exp vr var_env c)) in
-        let cte = cstm_of_act_list si out out_env var_env obj_env fe in
+        let cte = cstm_of_act_list vr var_env obj_env fe in
         let cfe = [] in
         [Cif (cc, cte, cfe)]
 
@@ -608,36 +613,36 @@ let rec cstm_of_act si out out_env var_env obj_env act =
         let ccl =
           List.map
             (fun (c,act) -> cname_of_qn c,
-               cstm_of_act_list si out out_env var_env obj_env act) cl in
+               cstm_of_act_list vr var_env obj_env act) cl in
-        [Cswitch (cexpr_of_exp si out out_env var_env e, ccl)]
+        [Cswitch (cexpr_of_exp vr var_env e, ccl)]
 
     | Ablock b ->
-        cstm_of_act_list si out out_env var_env obj_env b
+        cstm_of_act_list vr 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 si out out_env var_env i1,
+        [Cfor(name x, cexpr_of_exp vr var_env i1,
-              cexpr_of_exp si out out_env var_env i2,
+              cexpr_of_exp vr var_env i2,
-              cstm_of_act_list si out out_env var_env obj_env act)]
+              cstm_of_act_list vr var_env obj_env act)]
 
     (* Translate constant assignment *)
     | Aassgn (vn, { e_desc = Eextvalue { w_desc = Wconst c }; }) ->
-        let vn = clhs_of_pattern si out out_env var_env vn in
+        let vn = clhs_of_pattern vr 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 si out out_env var_env vn in
+        let vn = clhs_of_pattern vr var_env vn in
         let ty = assoc_type_lhs vn var_env in
-        let ce = cexpr_of_exp si out out_env var_env e in
+        let ce = cexpr_of_exp vr 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 si out out_env var_env op_name args)]
+        [Csexpr (cop_of_op vr var_env op_name args)]
 
     (* Reinitialization of an object variable, extracting the reset
        function's name from our environment [obj_env]. *)
@@ -657,7 +662,7 @@ let rec cstm_of_act si 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 si out out_env var_env p))
+                      (Carray (field, cexpr_of_pattern vr var_env p))
               in
                  mk_loop pl field
         )
@@ -666,20 +671,18 @@ let rec cstm_of_act si 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 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
+        let args = cexprs_of_exps vr var_env el in
+        let outvl = clhs_list_of_pattern_list vr var_env outvl in
+        generate_function_call vr var_env obj_env outvl objn args
 
-and cstm_of_act_list si out out_env var_env obj_env b =
+
+and cstm_of_act_list vr 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 si out out_env var_env obj_env) b.b_body)
+    (List.map (cstm_of_act vr var_env obj_env) b.b_body)
   in
     match l with
       | [] -> cstm
@@ -697,24 +700,17 @@ let qn_append q suffix =
   { qual = q.qual; name = q.name ^ suffix }
 
 (** Builds the argument list of step function*)
-let step_fun_args n md pack_inputs =
+let step_fun_args n md add_mem =
-  let args =
+  let args = inputlist_of_ovarlist md.m_inputs in
-    if pack_inputs then
-      (* TODO(Arduino): add const qualifier *)
-      [("_in", Cty_ptr (Cty_id (qn_append n "_in")))]
-    else
-      inputlist_of_ovarlist md.m_inputs
-  in
   let out_arg = [("_out", Cty_ptr (Cty_id (qn_append n "_out")))] in
   let context_arg =
-    if is_stateful n then
+    if is_stateful n && add_mem then
       [("self", Cty_ptr (Cty_id (qn_append n "_mem")))]
     else
       []
   in
     args @ out_arg @ context_arg
 
-
 (** [fun_def_of_step_fun name obj_env mods sf] returns a C function definition
     [name ^ "_out"] corresponding to the Obc step function [sf]. The object name
     <-> class name mapping [obj_env] is needed to translate internal steps and
@@ -725,7 +721,7 @@ let fun_def_of_step_fun n obj_env mem objs md =
   let fun_name = (cname_of_qn n) ^ "_step" in
   (* Its arguments, translating Obc types to C types and adding our internal
       memory structure. *)
-  let args = step_fun_args n md false in
+  let args = step_fun_args n md true in
 
   (* Out vars for function calls *)
   let out_vars =
@@ -737,15 +733,12 @@ let fun_def_of_step_fun n obj_env mem objs md =
   (* The body *)
   let mems = List.map cvar_of_vd (mem@md.m_outputs) in
   let var_env = args @ mems @ out_vars in
-  let out_env =
+  let vr = vr_compose
-    List.fold_left
+    (vr_field (Cderef (Cvar "_out")) (ident_set_of_var_decs md.m_outputs))
-      (fun out_env vd -> IdentSet.add vd.v_ident out_env)
+    (vr_direct (ident_set_of_var_decs md.m_inputs))
-      IdentSet.empty
-      md.m_outputs
   in
-  let si = mk_step_input md.m_inputs in
   let body =
-    cstm_of_act_list si (Cderef (Cvar "_out")) out_env var_env obj_env md.m_body
+    cstm_of_act_list vr var_env obj_env md.m_body
   in
 
   Cfundef {
@@ -758,12 +751,42 @@ let fun_def_of_step_fun n obj_env mem objs md =
     }
   }
 
-let async_fun_def_of_step_fun n obj_env mem objs md copy_in_name
+let async_ty n =
-    copy_out_name =
+  Cty_ptr (Cty_id (qn_append n "_async"))
+
+let async_field_ptr name =
+  Caddrof (Cfield (Cderef (Cvar "_async"), local_qn name))
+
+let fun_stub_def_of_step_fun n md copy_in copy_out =
+  let fun_name = (cname_of_qn n) ^ "_step_async_stub" in
+  let args = (step_fun_args n md false) @ [("_async", async_ty n)] in
+  let out_vars = [("_in", Cty_id (qn_append n "_in"))] in
+
+  let prologue = List.flatten (List.map
+    (fun (src_name, ty) ->
+       let src = Cvar src_name in
+       let dest = CLfield (CLvar "_in", local_qn src_name) in
+       create_affect_stm dest src ty)
+    (inputlist_of_ovarlist md.m_inputs))
+  in
+  let body = [
+    Csexpr (Cfun_call (copy_in, [async_field_ptr "in"; Cvar "_in"]));
+    Csexpr (Cfun_call (copy_out, [Cvar "_out"; async_field_ptr "out"]))
+  ] in
+
+  Cfundef {
+    C.f_name = fun_name;
+    f_retty = Cty_void;
+    f_args = args;
+    f_body = {
+      var_decls = out_vars;
+      block_body = prologue @ body
+    }
+  }
+
+let async_fun_def_of_step_fun n obj_env mem objs md copy_in copy_out =
   let fun_name = (cname_of_qn n) ^ "_async_step" in
-  (* Its arguments, translating Obc types to C types and adding our internal
+  let args = [("_async", async_ty n)] in
-      memory structure. *)
-  let args = step_fun_args n md true in
 
   (* Out vars for function calls *)
   let out_vars =
@@ -779,28 +802,37 @@ let async_fun_def_of_step_fun n obj_env mem objs md copy_in_name
       ["_in"; "_out"]
   in
 
-  (* TODO(Arduino): Refactor with non-async version *)
+  (* FIXME(Arduino): it is probably easier to access to self directly from
+     _async struct pointer, but the string "self" is hardcoded in a large
+     number of places… *)
+  let out_vars =
+    ("self", Cty_ptr (Cty_id (qn_append n "_mem"))) :: out_vars
+  in
+
   (* The body *)
   let mems = List.map cvar_of_vd (mem@md.m_outputs) in
   let var_env = args @ mems @ out_vars in
-  let out_env =
-    List.fold_left
-      (fun out_env vd -> IdentSet.add vd.v_ident out_env)
-      IdentSet.empty
-      md.m_outputs
-  in
 
-  let local_in = Cvar "_local_in" in
+  let async_field_ptr name =
-  let local_out = Cvar "_local_out" in
+    Caddrof (Cfield (Cderef (Cvar "_async"), local_qn name))
+  in
 
-  let si = mk_step_input_packed local_in md.m_inputs in
+  let l_in = Cvar "_local_in" in
+  let l_out = Cvar "_local_out" in
 
-  let copy_in = Cfun_call (copy_in_name, [Caddrof local_in; Cvar "_in"]) in
+  let vr = vr_compose
-  (* FIXME(Arduino): rename input & output variables *)
+    (vr_field l_out (ident_set_of_var_decs md.m_outputs))
-  let body =
+    (vr_field l_in (ident_set_of_var_decs md.m_inputs))
-    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
+
+  let prologue = [
+    Caffect (CLvar "self", async_field_ptr "self");
+    Csexpr (Cfun_call (copy_in, [Caddrof l_in; async_field_ptr "in"]))
+  ] in
+  let body = cstm_of_act_list vr var_env obj_env md.m_body in
+  let epilogue = [
+    Csexpr (Cfun_call (copy_out, [async_field_ptr "out"; Caddrof l_out]))
+  ] in
 
   Cfundef {
     C.f_name = fun_name;
@@ -808,7 +840,7 @@ let async_fun_def_of_step_fun n obj_env mem objs md copy_in_name
     f_args = args;
     f_body = {
       var_decls = out_vars;
-      block_body = (Csexpr copy_in) :: body @ [Csexpr copy_out]
+      block_body = prologue @ body @ epilogue
     }
   }
 
@@ -853,16 +885,27 @@ let out_decl_of_class_def cd =
   let out_fields = List.map cvar_of_vd step_m.m_outputs in
     [Cdecl_struct ((cname_of_qn cd.cd_name) ^ "_out", out_fields)]
 
+let async_decl_of_class_def cd =
+  let struct_field suffix name =
+    let qn = qn_append cd.cd_name suffix in
+    (name, Cty_id qn)
+  in
+  let fields = [
+    struct_field "_in" "in";
+    struct_field "_out" "out";
+    struct_field "_mem" "self"
+  ] in
+  [Cdecl_struct ((cname_of_qn cd.cd_name) ^ "_async", fields)]
+
 (** [reset_fun_def_of_class_def cd] returns the defintion of the C function
     tasked to reset the class [cd]. *)
 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 vr = vr_direct IdentSet.empty in
       let reset = find_reset_method cd in
-      cstm_of_act_list si (Cderef (Cvar "_out")) IdentSet.empty var_env
+      cstm_of_act_list vr var_env cd.cd_objs reset.m_body
-        cd.cd_objs reset.m_body
     else
       []
   in
@@ -888,32 +931,34 @@ let cdefs_and_cdecls_of_class_def cd =
   let memory_struct_decl = mem_decl_of_class_def cd in
   let in_struct_decl = in_decl_of_class_def cd in
   let out_struct_decl = out_decl_of_class_def cd in
-  let step_fun_def = fun_def_of_step_fun cd.cd_name
+  let async_struct_decl = async_decl_of_class_def cd in
-    cd.cd_objs cd.cd_mems cd.cd_objs step_m in
+
+  let step = fun_def_of_step_fun cd.cd_name cd.cd_objs cd.cd_mems
+    cd.cd_objs step_m in
   (* TODO(Arduino): let the user choose the backend they want *)
-  let copy_in_def = AvrBackend.gen_copy_func_in cd in
+  let copy_in = AvrBackend.gen_copy_func_in cd in
-  let copy_out_def = AvrBackend.gen_copy_func_out cd in
+  let copy_out = AvrBackend.gen_copy_func_out cd in
-  let async_step_fun_def = async_fun_def_of_step_fun cd.cd_name
+  let async_stub =
-    cd.cd_objs cd.cd_mems cd.cd_objs step_m (cdef_name copy_in_def)
+    fun_stub_def_of_step_fun cd.cd_name step_m
-    (cdef_name copy_out_def) in
+      (cdef_name copy_in) (cdef_name copy_out)
+  in
+  let async_step =
+    async_fun_def_of_step_fun cd.cd_name cd.cd_objs cd.cd_mems
+      cd.cd_objs step_m (cdef_name copy_in) (cdef_name copy_out)
+  in
   (* C function for resetting our memory structure. *)
-  let reset_fun_def = reset_fun_def_of_class_def cd in
+  let reset = reset_fun_def_of_class_def cd in
-  let res_fun_decl = cdecl_of_cfundef reset_fun_def in
+
-  let step_fun_decl = cdecl_of_cfundef step_fun_def in
+  let defs =
-  let async_step_fun_decl = cdecl_of_cfundef async_step_fun_def in
-  let copy_in_decl = cdecl_of_cfundef copy_in_def in
-  let copy_out_decl = cdecl_of_cfundef copy_out_def in
-  let (decls, defs) =
     if is_stateful cd.cd_name then
-      ([res_fun_decl; step_fun_decl; copy_in_decl; copy_out_decl;
+        [reset; step; copy_in; copy_out; async_stub; async_step]
-        async_step_fun_decl],
-       [reset_fun_def; step_fun_def; copy_in_def; copy_out_def;
-        async_step_fun_def])
     else
-      ([step_fun_decl], [step_fun_def]) in
+        [step]
+  in
+  let decls = List.map cdecl_of_cfundef defs in
 
-  memory_struct_decl @ in_struct_decl @ out_struct_decl @ decls,
+  memory_struct_decl @ in_struct_decl @ out_struct_decl @ async_struct_decl
-  defs
+    @ decls, defs
 
 (** {2 Type translation} *)
 

compiler/obc/java/obc2java.ml

@@ -356,7 +356,6 @@ let rec act_list param_env act_l acts =
         in
         let copies = Misc.mapi copy_return_to_var p_l in
         assgn::(copies@acts)
-    | Obc.Acall (_, _, MstepAsync, _) -> assert false
     | Obc.Acall (_, obj, Mreset, _) ->
         let acall = Emethod_call (obj_ref param_env obj, "reset", []) in
         Aexp acall::acts

compiler/obc/java/obc2java14.ml

@@ -356,8 +356,6 @@ let rec act_list param_env act_l acts =
         in
         let copies = Misc.mapi copy_return_to_var p_l in
         assgn::(copies@acts)
-    (* TODO(Arduino): Java is not supported (yet?) *)
-    | Obc.Acall (_, _, MstepAsync, _) -> assert false
     | Obc.Acall (_, obj, Mreset, _) ->
         let acall = Emethod_call (obj_ref param_env obj, "reset", []) in
         Aexp acall::acts

compiler/obc/obc.ml

@@ -92,7 +92,6 @@ type obj_ref =
 type method_name =
   | Mreset
   | Mstep
-  | MstepAsync
 
 type act =
   | Aassgn of pattern * exp

compiler/obc/obc_printer.ml

@@ -41,6 +41,12 @@ let print_vd ff vd =
   print_type ff vd.v_type;
   fprintf ff "@]"
 
+let print_ack ff ack =
+  fprintf ff "@[%s@,%a@]"
+    ack.ack_name
+    (print_list_r print_static_exp "("","")")
+    ack.ack_params
+
 let print_obj ff o =
   fprintf ff "@[<v>"; print_ident ff o.o_ident;
   fprintf ff " : "; print_qualname ff o.o_class;
@@ -48,6 +54,9 @@ let print_obj ff o =
   (match o.o_size with
      | Some se -> fprintf ff "%a" (print_list_r print_static_exp "[" "][" "]") se
      | None -> ());
+  (match o.o_ack with
+     | Some ack -> fprintf ff " @[async[%a]@]" print_ack ack
+     | None -> ());
   fprintf ff "@]"
 
 let rec print_lhs ff e =
@@ -113,8 +122,6 @@ let print_obj_call ff = function
 let print_method_name ff = function
   | Mstep -> fprintf ff "step"
   | Mreset -> fprintf ff "reset"
-  | MstepAsync -> fprintf ff "step_async"
-
 
 let rec print_act ff a =
   let print_lhs_tuple ff var_list = match var_list with
@@ -166,7 +173,6 @@ and print_tag_act_list ff tag_act_list =
 let print_method_name ff = function
   | Mreset -> fprintf ff "reset"
   | Mstep -> fprintf ff "step"
-  | MstepAsync -> fprintf ff "step_async"
 
 let print_arg_list ff var_list =
   fprintf ff "(@[%a@])" (print_list_r print_vd "" "," "") var_list
@@ -200,7 +206,7 @@ let print_class_def ff
   end;
   if objs <> [] then begin
     fprintf ff "@[<hov 4>obj ";
-    print_list print_obj "" ";" "" ff objs;
+    print_list print_obj "" "; " "" ff objs;
     fprintf ff ";@]@,"
   end;
   if mem <> [] || objs <> [] then fprintf ff "@,";