jeltz/heptagon
1
0
Fork 0
Code Issues Pull requests Releases Activity

Fix bug and generate MstepAsync call in MiniLS

Browse source 
Easync applications were not flowing throw some Heptagon passes.
This commit is contained in:
jeltz 2020-12-23 13:08:10 +01:00
parent e9a718a868
commit 73db32c6be
Signed by: jeltz
GPG key ID: 800882B66C0C3326
6 changed files with 51 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
compiler/heptagon/analysis/typing.ml
View file

@ -266,13 +266,17 @@ let flatten_ty_list l =
List.fold_right
(fun arg args -> match arg with Tprod l -> l@args | a -> a::args ) l []
let kind f ty_desc =
let kind f ty_desc ack =
let ty_of_arg v =
if Linearity.is_linear v.a_linearity && not !Compiler_options.do_linear_typing then
error Eenable_memalloc;
v.a_type
in
let op = if ty_desc.node_stateful then Enode f else Efun f in
let op = match ack with
| Some ack -> Easync (f, ack)
| _ when ty_desc.node_stateful -> Enode f
| _ -> Efun f
in
op, List.map ty_of_arg ty_desc.node_inputs,
List.map ty_of_arg ty_desc.node_outputs
@ -633,7 +637,8 @@ let rec typing cenv h e =
a_params = params } as app),
n_list, pe_list, e_list, reset) ->
let ty_desc = find_value f in
let op, expected_ty_list, result_ty_list = kind f ty_desc in
(* TODO(Arduino): iterator + async *)
let op, expected_ty_list, result_ty_list = kind f ty_desc None in
let node_params =
List.map (fun { p_name = n } -> local_qn n) ty_desc.node_params in
let m = build_subst node_params params in
@ -772,7 +777,11 @@ and typing_app cenv h app e_list =
(* 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 ack = match app.a_op with
| Easync (_, ack) -> Some ack
| _ -> None
in
let op, expected_ty_list, result_ty_list = kind f ty_desc ack in
let node_params = List.map (fun { p_name = n } -> local_qn n) ty_desc.node_params in
let m = build_subst node_params app.a_params in
let expected_ty_list = List.map (simplify_type m) expected_ty_list in

4
compiler/heptagon/parsing/hept_static_scoping.ml
View file

@ -68,9 +68,9 @@ let qualify_pervasive q =
op<a1,a2> (a3) == op <a1> (a2,a3) == op (a1,a2,a3) *)
let static_app_from_app app args =
match app.a_op with
(* TODO(Arduino): static? *)
| Efun q
| Enode q
| Easync (q, _) ->
| Enode q ->
let q = qualify_pervasive q in
q, (app.a_params @ args)
| _ -> raise Not_static

24
compiler/main/mls2obc.ml
View file

@ -489,12 +489,16 @@ let rec translate_eq map call_context
let action = Aop (q, List.map (translate_extvalue_to_exp map) args) in
v, si, j, (control map ck action) :: s
| pat, Minils.Eapp ({ Minils.a_op = Minils.Efun _ | Minils.Enode _ } as app, e_list, r) ->
| pat, Minils.Eapp
({ Minils.a_op =
Minils.Efun _ | Minils.Enode _ | Minils.Easync _ } as app,
e_list, r) ->
let name_list = translate_pat map e.Minils.e_ty pat in
let c_list = List.map (translate_extvalue_to_exp map) e_list in
let v', si', j', action = mk_node_call map call_context
app loc name_list c_list e.Minils.e_ty in
let action = List.map (control map ck) action in
(* TODO(Arduino): add Easync? *)
let s = (match r, app.Minils.a_op with
| Some r, Minils.Enode _ ->
let ck = Clocks.Con (ck, Initial.ptrue, r) in
@ -533,6 +537,9 @@ and translate_eq_list map call_context act_list =
let rev_act = List.rev act_list in
List.fold_left (translate_eq map call_context) ([], [], [], []) rev_act
and translate_ack { Minils.ack_name = name; Minils.ack_params = params } =
{ ack_name = name; ack_params = params }
and mk_node_call map call_context app loc (name_list : Obc.pattern list) args ty =
match app.Minils.a_op with
| Minils.Efun f when Mls_utils.is_op f ->
@ -572,22 +579,33 @@ and mk_node_call map call_context app loc (name_list : Obc.pattern list) args ty
let env = List.fold_left2 build Env.empty nd.Minils.n_input args in
v @ nd.Minils.n_local, si, j, subst_act_list env s
| Minils.Enode f | Minils.Efun f ->
| Minils.Enode f | Minils.Efun f | Minils.Easync (f, _) ->
let id = match app.Minils.a_id with
| None -> gen_obj_ident f
| Some id -> id
in
let o = mk_obj_call_from_context call_context id in
let ack = match app.Minils.a_op with
| Minils.Easync (_, ack) -> Some (translate_ack ack)
| _ -> None
in
let obj =
{ o_ident = obj_ref_name o; o_class = f;
o_params = app.Minils.a_params;
o_ack = ack;
o_size = size_from_call_context call_context; o_loc = loc } in
let si = match app.Minils.a_op with
| Minils.Efun _ -> []
| Minils.Enode _ -> [reinit o]
(* TODO(Arduino): is it correct? *)
| Minils.Easync _ -> []
| _ -> assert false
in
let s = [Acall (name_list, o, Mstep, args)] in
let m = match app.Minils.a_op with
| Minils.Easync _ -> MstepAsync
| _ -> Mstep
in
let s = [Acall (name_list, o, m, args)] in
[], si, [obj], s
| _ -> assert false

2
compiler/minils/mls_printer.ml
View file

@ -164,7 +164,7 @@ and print_app ff (app, args) =
fprintf ff "@[%a@,%a@,%a@]"
print_qualname f print_params app.a_params print_w_tuple args
| Easync (f, ack) ->
fprintf ff "@[async@,%a@,%a@,%a@,on@,%s@,%a@]"
fprintf ff "@[async %a@,%a@,%a on %s@,%a@]"
print_qualname f
print_params app.a_params
print_w_tuple args

14
compiler/minils/transformations/callgraph.ml
View file

@ -188,6 +188,12 @@ struct
| Eapp ({ a_op = Enode ln; a_params = params } as app, e_list, r) ->
let op = Enode (node_for_params_call ln (instantiate m params)) in
Eapp ({ app with a_op = op; a_params = [] }, e_list, r)
| Eapp ({ a_op = Easync (ln, ack);
a_params = params } as app, e_list, r) ->
let op =
Easync (node_for_params_call ln (instantiate m params), ack)
in
Eapp ({ app with a_op = op; a_params = [] }, e_list, r)
| Eiterator(it, ({ a_op = Efun ln; a_params = params } as app),
n, pe_list, e_list, r) ->
let op = Efun (node_for_params_call ln (instantiate m params)) in
@ -198,6 +204,7 @@ struct
let op = Enode (node_for_params_call ln (instantiate m params)) in
Eiterator(it,{app with a_op = op; a_params = [] },
n, pe_list, e_list, r)
(* TODO(Arduino): iterator *)
| _ -> ed
in ed, m
@ -313,10 +320,11 @@ let collect_node_calls ln =
else (ln, params)::acc
in
let edesc _ acc ed = match ed with
| Eapp ({ a_op = (Enode ln | Efun ln); a_params = params }, _, _) ->
| Eapp ({ a_op = (Enode ln | Efun ln | Easync (ln, _));
a_params = params }, _, _) ->
ed, add_called_node ln params acc
| Eiterator(_, { a_op = (Enode ln | Efun ln); a_params = params },
_, _, _, _) ->
| Eiterator(_, { a_op = (Enode ln | Efun ln | Easync (ln, _));
a_params = params }, _, _, _, _) ->
ed, add_called_node ln params acc
| _ -> raise Errors.Fallback
in

3
compiler/obc/obc.ml
View file

@ -114,10 +114,13 @@ and var_dec =
v_mutable : bool;
v_loc : location }
and ack = { ack_name : ack_name; ack_params : static_exp list }
type obj_dec =
{ o_ident : obj_ident;
o_class : class_name;
o_params : static_exp list;
o_ack : ack option;
(** size of the array if the declaration is an array of obj *)
o_size : static_exp list option;
o_loc : location }