Handle Easync in heptagon/*

Warning: The code still doesn't compile.

compiler/heptagon/analysis/causality.ml

@@ -167,7 +167,7 @@ and apply op e_list =
         let i2 = typing e2 in
         let i3 = typing e3 in
         ctuplelist [t1; i2; i3]
-    | ( Efun _| Enode _ | Econcat | Eselect_slice
+    | ( Efun _ | Easync _ | Enode _ | Econcat | Eselect_slice
       | Eselect_dyn | Eselect_trunc | Eselect | Earray_fill | Ereinit) ->
         ctuplelist (List.map typing e_list)
     | (Earray | Etuple) ->

compiler/heptagon/analysis/hept_clocking.ml

@@ -198,7 +198,8 @@ and typing_app h base pat op e_list = match op with
   | Efun { qual = Module "Iostream"; name = "fprintf" } ->
       List.iter (expect h pat (Ck base)) e_list;
       Cprod []
-  | (Efun f | Enode f) ->
+  (* FIXME(Arduino): voir si c'est correct *)
+  | (Efun f | Enode f | Easync (f, _)) ->
       let node = Modules.find_value f in
       let pat_id_list = ident_list_of_pat pat in
       let rec build_env a_l v_l env = match a_l, v_l with

compiler/heptagon/analysis/linear_typing.ml

@@ -525,7 +525,8 @@ and collect_app env op e_list = match op with
   | Efun { qual = Module "Iostream"; name = "fprintf" | "printf" } ->
       VarsCollection.prod []
 
-  | Efun f | Enode f ->
+  (* FIXME(Arduino): voir si c'est correct *)
+  | Efun f | Enode f | Easync (f, _) ->
     let ty_desc = Modules.find_value f in
     let inputs_lins = linearities_of_arg_list ty_desc.node_inputs in
     let outputs_lins = linearities_of_arg_list ty_desc.node_outputs in
@@ -590,7 +591,7 @@ and typing_app env op e_list = match op with
     let e = assert_1 e_list in
     let env = safe_expect env Ltop e in
       Ltop, env
-  | Eifthenelse | Efun _ | Enode _ | Etuple
+  | Eifthenelse | Efun _ | Enode _ | Easync _ | Etuple
   | Eupdate | Efield_update | Ereinit -> assert false (*already done in expect_app*)
 
 (** Check that the application of op to e_list can have the linearity
@@ -600,7 +601,8 @@ and expect_app env expected_lin op e_list = match op with
       let env = List.fold_left (fun env -> safe_expect env Ltop) env e_list in
         Ltuple [], env
 
-  | Efun f | Enode f ->
+  (* FIXME(Arduino): voir si c'est correct *)
+  | Efun f | Enode f | Easync (f, _) ->
     let ty_desc = Modules.find_value f in
     let inputs_lins = linearities_of_arg_list ty_desc.node_inputs in
     let outputs_lins = linearities_of_arg_list ty_desc.node_outputs in

compiler/heptagon/analysis/typing.ml

@@ -769,7 +769,8 @@ and typing_app cenv h app e_list =
         let typed_format_args = typing_format_args cenv h typed_e1 format_args in
         Tprod [], app, typed_e1::typed_e2::typed_format_args
 
-    | (Efun f | Enode f) ->
+    (* FIXME(Arduino): voir si c'est correct *)
+    | (Efun f | Enode f | Easync (f, _)) ->
         let ty_desc = find_value f in
         let op, expected_ty_list, result_ty_list = kind f ty_desc in
         let node_params = List.map (fun { p_name = n } -> local_qn n) ty_desc.node_params in

compiler/heptagon/hept_printer.ml

@@ -100,6 +100,9 @@ and print_node_params ff l =
 and print_exp_tuple ff l =
   fprintf ff "@[<2>(%a)@]" (print_list_r print_exp """,""") l
 
+and print_static_exp_tuple ff l =
+  fprintf ff "@[<2>(%a)@]" (print_list_r print_static_exp """,""") l
+
 and print_vd_tuple ff l =
   match l with
     | [] -> fprintf ff "()"
@@ -203,6 +206,13 @@ and print_app ff (app, args) =
         print_stateful ff true;
         fprintf ff "@[%a@,%a@,%a@]"
           print_qualname f print_params app.a_params  print_exp_tuple args
+    | Easync (f, ack) ->
+        fprintf ff "@[async@,%a@,%a@,%a@,on@,%s@,%a@]"
+          print_qualname f
+          print_params app.a_params
+          print_exp_tuple args
+          ack.ack_name
+          print_static_exp_tuple ack.ack_params
     | Eifthenelse ->
       let e1, e2, e3 = assert_3 args in
         fprintf ff "@[<hv>if %a@ then %a@ else %a@]"

compiler/heptagon/parsing/hept_scoping.ml

@@ -350,6 +350,11 @@ and translate_desc loc env = function
      let e1 = translate_exp env e1 in
        Heptagon.Esplit(x, e1)
 
+and translate_ack { ack_name = name; ack_params = params } =
+  let tr_params = List.map translate_static_exp params in
+  { Heptagon.ack_name = name;
+    Heptagon.ack_params = tr_params }
+
 and translate_op = function
   | Earrow -> Heptagon.Earrow
   | Eifthenelse -> Heptagon.Eifthenelse
@@ -366,7 +371,8 @@ and translate_op = function
   | Eselect_trunc -> Heptagon.Eselect_trunc
   | Efun ln -> Heptagon.Efun (qualify_value ln)
   | Enode ln -> Heptagon.Enode (qualify_value ln)
-  | Easync (ln, ack) -> Heptagon.Easync (qualify_value ln, ack)
+  | Easync (ln, ack) ->
+      Heptagon.Easync (qualify_value ln, translate_ack ack)
   | Ereinit -> Heptagon.Ereinit
 
 and translate_pat loc env = function