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

Better deal with memory less nodes

Browse source 
There are now 3 kinds of nodes: Eprim : primitive 
nodes, Enode: nodes with memory, Efun: nodes 
without memory.

Typing now sets correct eq_statefull and b_statefull
for equations and blocks. Resets are only added 
when a node with memory is called.

The calling convention is the generated code needs
to be modified so that we can remove the context 
for nodes without memory.
This commit is contained in:
Cédric Pasteur 2010-06-30 10:22:31 +02:00 committed by Cédric Pasteur
parent 2af3686af2
commit b4419a6760
17 changed files with 112 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
compiler/global/signature.ml
View file

@ -13,7 +13,7 @@ open Static
(** Warning: Whenever these types are modified, (** Warning: Whenever these types are modified,
interface_format_version should be incremented. *) interface_format_version should be incremented. *)
let interface_format_version = "6" let interface_format_version = "7"
(** Node argument *) (** Node argument *)
type arg = { a_name : name option; a_type : ty } type arg = { a_name : name option; a_type : ty }
@ -24,6 +24,7 @@ type param = { p_name : name }
type node = type node =
{ node_inputs : arg list; { node_inputs : arg list;
node_outputs : arg list; node_outputs : arg list;
node_statefull : bool;
node_params : param list; (** Static parameters *) node_params : param list; (** Static parameters *)
node_params_constraints : size_constr list } node_params_constraints : size_constr list }

4
compiler/heptagon/analysis/initialization.ml
View file

@ -234,8 +234,8 @@ and apply h op e_list =
let i2 = itype (typing h e2) in let i2 = itype (typing h e2) in
let i3 = itype (typing h e3) in let i3 = itype (typing h e3) in
max i1 (max i2 i3) max i1 (max i2 i3)
| Ecall ({ op_kind = Eop }, _), e_list -> (* | Ecall ({ op_kind = Efun }, _), e_list ->
List.fold_left (fun acc e -> itype (typing h e)) izero e_list List.fold_left (fun acc e -> itype (typing h e)) izero e_list *)
| (Ecall _ | Earray_op _| Efield_update _) , e_list -> | (Ecall _ | Earray_op _| Efield_update _) , e_list ->
List.iter (fun e -> initialized_exp h e) e_list; izero List.iter (fun e -> initialized_exp h e) e_list; izero

3
compiler/heptagon/analysis/interface.ml
View file

@ -19,11 +19,12 @@ open Types
module Type = module Type =
struct struct
let sigtype { sig_name = name; sig_inputs = i_list; let sigtype { sig_name = name; sig_inputs = i_list; sig_statefull = statefull;
sig_outputs = o_list; sig_params = params } = sig_outputs = o_list; sig_params = params } =
let check_arg a = { a with a_type = check_type a.a_type } in let check_arg a = { a with a_type = check_type a.a_type } in
name, { node_inputs = List.map check_arg i_list; name, { node_inputs = List.map check_arg i_list;
node_outputs = List.map check_arg o_list; node_outputs = List.map check_arg o_list;
node_statefull = statefull;
node_params = params; node_params = params;
node_params_constraints = []; } node_params_constraints = []; }

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

@ -222,14 +222,59 @@ let rec unify t1 t2 =
let unify t1 t2 = let unify t1 t2 =
try unify t1 t2 with Unify -> error (Etype_clash(t1, t2)) try unify t1 t2 with Unify -> error (Etype_clash(t1, t2))
let less_than statefull = (*if not statefull then error Estate_clash*) () let less_than statefull = if not statefull then error Estate_clash
let kind f statefull = function let rec is_statefull_exp e =
| { node_inputs = ty_list1; match e.e_desc with
node_outputs = ty_list2 } -> | Econst _ | Econstvar _ | Evar _-> false
| Elast _ -> true
| Etuple e_list -> List.exists is_statefull_exp e_list
| Eapp({ a_op = (Efby | Epre _ | Earrow) }, _) -> true
| Eapp({ a_op = Ecall ({ op_kind = Enode }, _)}, _) -> true
| Eapp(_, e_list) -> List.exists is_statefull_exp e_list
| Efield(e, _) -> is_statefull_exp e
| Estruct _ | Earray _ -> false
let rec is_statefull_eq_desc = function
| Eautomaton(handlers) ->
(List.exists is_statefull_state_handler handlers)
| Eswitch(e, handlers) ->
(is_statefull_exp e) or
(List.exists is_statefull_switch_handler handlers)
| Epresent(handlers, b) ->
(is_statefull_block b) or
(List.exists is_statefull_present_handler handlers)
| Ereset(eq_list, e) ->
(is_statefull_exp e) or
(List.exists (fun eq -> eq.eq_statefull) eq_list)
| Eeq(_, e) -> is_statefull_exp e
and is_statefull_block b =
b.b_statefull
and is_statefull_present_handler ph =
(is_statefull_exp ph.p_cond) or
(is_statefull_block ph.p_block)
and is_statefull_switch_handler sh =
is_statefull_block sh.w_block
and is_statefull_state_handler sh =
(is_statefull_block sh.s_block) or
(List.exists is_statefull_escape sh.s_until) or
(List.exists is_statefull_escape sh.s_unless)
and is_statefull_escape esc =
is_statefull_exp esc.e_cond
let kind f statefull k
{ node_inputs = ty_list1;
node_outputs = ty_list2;
node_statefull = n } =
let ty_of_arg v = v.a_type in let ty_of_arg v = v.a_type in
(*if n & not(statefull) then error (Eshould_be_a_node(f)) *) let k = if n then Enode else Efun in
(*else n,*) List.map ty_of_arg ty_list1, List.map ty_of_arg ty_list2 if n & not(statefull) then error (Eshould_be_a_node f)
else k, List.map ty_of_arg ty_list1, List.map ty_of_arg ty_list2
let prod = function let prod = function
| [] -> assert false | [] -> assert false
@ -386,7 +431,7 @@ let check_field_unicity l =
else else
S.add (shortname f) acc S.add (shortname f) acc
in in
List.fold_left add_field S.empty l ignore (List.fold_left add_field S.empty l)
(** @return the qualified name and list of fields of (** @return the qualified name and list of fields of
the type with name [n]. the type with name [n].
@ -520,9 +565,10 @@ and typing_app statefull h op e_list =
let typed_e2, t1 = typing statefull h e2 in let typed_e2, t1 = typing statefull h e2 in
let typed_e3 = expect statefull h t1 e3 in let typed_e3 = expect statefull h t1 e3 in
t1, op, [typed_e1; typed_e2; typed_e3] t1, op, [typed_e1; typed_e2; typed_e3]
| Ecall ( { op_name = f; op_params = params } as op_desc , reset), e_list -> | Ecall ( { op_name = f; op_params = params; op_kind = k } as op_desc
, reset), e_list ->
let { qualid = q; info = ty_desc } = find_value f in let { qualid = q; info = ty_desc } = find_value f in
let expected_ty_list, result_ty_list = kind f statefull ty_desc in let k, expected_ty_list, result_ty_list = kind f statefull k ty_desc in
let m = List.combine (List.map (fun p -> p.p_name) ty_desc.node_params) let m = List.combine (List.map (fun p -> p.p_name) ty_desc.node_params)
params in params in
let expected_ty_list = List.map (subst_type_vars m) expected_ty_list in let expected_ty_list = List.map (subst_type_vars m) expected_ty_list in
@ -532,7 +578,7 @@ and typing_app statefull h op e_list =
let result_ty_list = List.map (subst_type_vars m) result_ty_list in let result_ty_list = List.map (subst_type_vars m) result_ty_list in
List.iter add_size_constr size_constrs; List.iter add_size_constr size_constrs;
(prod result_ty_list, (prod result_ty_list,
Ecall ( { op_desc with op_name = Modname(q) }, reset), Ecall ( { op_desc with op_name = Modname q; op_kind = k }, reset),
typed_e_list) typed_e_list)
| Earray_op op, e_list -> | Earray_op op, e_list ->
let ty, op, e_list = typing_array_op statefull h op e_list in let ty, op, e_list = typing_array_op statefull h op e_list in
@ -596,11 +642,12 @@ and typing_array_op statefull h op e_list =
end; end;
let n = SOp (SPlus, size_exp t1, size_exp t2) in let n = SOp (SPlus, size_exp t1, size_exp t2) in
Tarray (element_type t1, n), op, [typed_e1; typed_e2] Tarray (element_type t1, n), op, [typed_e1; typed_e2]
| Eiterator (it, ({ op_name = f; op_params = params } as op_desc), reset), | Eiterator (it, ({ op_name = f; op_params = params;
op_kind = k } as op_desc), reset),
e::e_list -> e::e_list ->
let { qualid = q; info = ty_desc } = find_value f in let { qualid = q; info = ty_desc } = find_value f in
let f = Modname(q) in let f = Modname(q) in
let expected_ty_list, result_ty_list = kind f statefull ty_desc in let k, expected_ty_list, result_ty_list = kind f statefull k ty_desc in
let m = List.combine (List.map (fun p -> p.p_name) ty_desc.node_params) let m = List.combine (List.map (fun p -> p.p_name) ty_desc.node_params)
params in params in
let expected_ty_list = List.map (subst_type_vars m) expected_ty_list in let expected_ty_list = List.map (subst_type_vars m) expected_ty_list in
@ -613,7 +660,7 @@ and typing_array_op statefull h op e_list =
expected_ty_list result_ty_list e_list in expected_ty_list result_ty_list e_list in
add_size_constr (LEqual (SConst 1, e)); add_size_constr (LEqual (SConst 1, e));
List.iter add_size_constr size_constrs; List.iter add_size_constr size_constrs;
ty, Eiterator(it, { op_desc with op_name = f }, reset), ty, Eiterator(it, { op_desc with op_name = f; op_kind = k }, reset),
typed_e::typed_e_list typed_e::typed_e_list
(*Arity problems*) (*Arity problems*)
@ -740,7 +787,7 @@ let rec typing_eq statefull h acc eq =
Eeq(pat, typed_e), Eeq(pat, typed_e),
acc in acc in
{ eq with { eq with
eq_statefull = statefull; eq_statefull = is_statefull_eq_desc typed_desc;
eq_desc = typed_desc }, eq_desc = typed_desc },
acc acc
@ -831,7 +878,7 @@ and typing_block statefull h
typing_eq_list statefull h0 Env.empty eq_list in typing_eq_list statefull h0 Env.empty eq_list in
let defnames = diff_env defined_names local_names in let defnames = diff_env defined_names local_names in
{ b with { b with
b_statefull = statefull; b_statefull = List.exists (fun eq -> eq.eq_statefull) typed_eq_list;
b_defnames = defnames; b_defnames = defnames;
b_local = typed_l; b_local = typed_l;
b_equs = typed_eq_list }, b_equs = typed_eq_list },
@ -895,12 +942,13 @@ let typing_contract statefull h contract =
c_enforce = typed_e_g }, c_enforce = typed_e_g },
controllable_names, h controllable_names, h
let signature const_env inputs returns params constraints = let signature const_env statefull inputs returns params constraints =
let arg_dec_of_var_dec vd = let arg_dec_of_var_dec vd =
mk_arg (Some (name vd.v_ident)) (check_type vd.v_type) mk_arg (Some (name vd.v_ident)) (check_type vd.v_type)
in in
{ node_inputs = List.map arg_dec_of_var_dec inputs; { node_inputs = List.map arg_dec_of_var_dec inputs;
node_outputs = List.map arg_dec_of_var_dec returns; node_outputs = List.map arg_dec_of_var_dec returns;
node_statefull = statefull;
node_params = params; node_params = params;
node_params_constraints = constraints; } node_params_constraints = constraints; }
@ -910,7 +958,7 @@ let solve loc env cl =
with with
Solve_failed c -> message loc (Econstraint_solve_failed c) Solve_failed c -> message loc (Econstraint_solve_failed c)
let node const_env ({ n_name = f; let node const_env ({ n_name = f; n_statefull = statefull;
n_input = i_list; n_output = o_list; n_input = i_list; n_output = o_list;
n_contract = contract; n_contract = contract;
n_local = l_list; n_equs = eq_list; n_loc = loc; n_local = l_list; n_equs = eq_list; n_loc = loc;
@ -921,11 +969,11 @@ let node const_env ({ n_name = f;
(* typing contract *) (* typing contract *)
let typed_contract, controllable_names, h = let typed_contract, controllable_names, h =
typing_contract false h contract in typing_contract statefull h contract in
let typed_l_list, local_names, h = build h h l_list in let typed_l_list, local_names, h = build h h l_list in
let typed_eq_list, defined_names = let typed_eq_list, defined_names =
typing_eq_list false h Env.empty eq_list in typing_eq_list statefull h Env.empty eq_list in
(* if not (statefull) & (List.length o_list <> 1) (* if not (statefull) & (List.length o_list <> 1)
then error (Etoo_many_outputs);*) then error (Etoo_many_outputs);*)
let expected_names = add local_names output_names in let expected_names = add local_names output_names in
@ -934,7 +982,7 @@ let node const_env ({ n_name = f;
let cl = get_size_constr () in let cl = get_size_constr () in
let cl = solve loc const_env cl in let cl = solve loc const_env cl in
add_value f (signature const_env i_list o_list node_params cl); add_value f (signature const_env statefull i_list o_list node_params cl);
{ n with { n with
n_input = List.rev typed_i_list; n_input = List.rev typed_i_list;

6
compiler/heptagon/heptagon.ml
View file

@ -58,7 +58,7 @@ and array_op =
[exp option] reset *) [exp option] reset *)
and op_desc = { op_name : longname; op_params: size_exp list; op_kind: op_kind } and op_desc = { op_name : longname; op_params: size_exp list; op_kind: op_kind }
and op_kind = | Eop | Enode and op_kind = | Efun | Enode
and const = and const =
| Cint of int | Cint of int
@ -138,7 +138,7 @@ type program = {
} }
type signature = { type signature = {
sig_name : name; sig_inputs : arg list; sig_name : name; sig_inputs : arg list; sig_statefull : bool;
sig_outputs : arg list; sig_params : param list sig_outputs : arg list; sig_params : param list
} }
@ -190,7 +190,7 @@ let mk_switch_equation ?(statefull = true) e l =
(** @return a size exp operator from a Heptagon operator. *) (** @return a size exp operator from a Heptagon operator. *)
let op_from_app app = let op_from_app app =
match app.a_op with match app.a_op with
| Ecall ( { op_name = op; op_kind = Eop }, _) -> op_from_app_name op | Ecall ( { op_name = op; op_kind = Efun }, _) -> op_from_app_name op
| _ -> raise Not_static | _ -> raise Not_static
(** Translates a Heptagon exp into a static size exp. *) (** Translates a Heptagon exp into a static size exp. *)

1
compiler/heptagon/parsing/hept_parser.mly
View file

@ -554,6 +554,7 @@ interface_decl:
RETURNS LPAREN params_signature RPAREN RETURNS LPAREN params_signature RPAREN
{ mk_interface_decl (Isignature({ sig_name = $3; { mk_interface_decl (Isignature({ sig_name = $3;
sig_inputs = $6; sig_inputs = $6;
sig_statefull = $2;
sig_outputs = $10; sig_outputs = $10;
sig_params = $4; })) } sig_params = $4; })) }
; ;

5
compiler/heptagon/parsing/parsetree.ml
View file

@ -54,7 +54,7 @@ and array_op =
| Eiterator of iterator_type * op_desc | Eiterator of iterator_type * op_desc
and op_desc = { op_name : longname; op_params: exp list; op_kind: op_kind } and op_desc = { op_name : longname; op_params: exp list; op_kind: op_kind }
and op_kind = | Eop | Enode and op_kind = | Efun | Enode
and const = and const =
| Cint of int | Cint of int
@ -155,6 +155,7 @@ type arg = { a_type : ty; a_name : name option }
type signature = type signature =
{ sig_name : name; { sig_name : name;
sig_inputs : arg list; sig_inputs : arg list;
sig_statefull : bool;
sig_outputs : arg list; sig_outputs : arg list;
sig_params : name list; } sig_params : name list; }
@ -183,7 +184,7 @@ let mk_call desc exps =
Eapp (mk_app (Ecall desc), exps) Eapp (mk_app (Ecall desc), exps)
let mk_op_call s params exps = let mk_op_call s params exps =
mk_call (mk_op_desc (Name s) params Eop) exps mk_call (mk_op_desc (Name s) params Efun) exps
let mk_array_op_call op exps = let mk_array_op_call op exps =
Eapp (mk_app (Earray_op op), exps) Eapp (mk_app (Earray_op op), exps)

5
compiler/heptagon/parsing/scoping.ml
View file

@ -100,7 +100,7 @@ let translate_iterator_type = function
| Imapfold -> Heptagon.Imapfold | Imapfold -> Heptagon.Imapfold
let translate_op_kind = function let translate_op_kind = function
| Eop -> Heptagon.Eop | Efun -> Heptagon.Efun
| Enode -> Heptagon.Enode | Enode -> Heptagon.Enode
let translate_const = function let translate_const = function
@ -110,7 +110,7 @@ let translate_const = function
let op_from_app loc app = let op_from_app loc app =
match app.a_op with match app.a_op with
| Ecall { op_name = op; op_kind = Eop } -> op_from_app_name op | Ecall { op_name = op; op_kind = Efun } -> op_from_app_name op
| _ -> Error.message loc Error.Estatic_exp_expected | _ -> Error.message loc Error.Estatic_exp_expected
let check_const_vars = ref true let check_const_vars = ref true
@ -329,6 +329,7 @@ let translate_signature s =
{ Heptagon.sig_name = s.sig_name; { Heptagon.sig_name = s.sig_name;
Heptagon.sig_inputs = List.map (translate_arg const_env) s.sig_inputs; Heptagon.sig_inputs = List.map (translate_arg const_env) s.sig_inputs;
Heptagon.sig_outputs = List.map (translate_arg const_env) s.sig_outputs; Heptagon.sig_outputs = List.map (translate_arg const_env) s.sig_outputs;
Heptagon.sig_statefull = s.sig_statefull;
Heptagon.sig_params = List.map Signature.mk_param s.sig_params; } Heptagon.sig_params = List.map Signature.mk_param s.sig_params; }
let translate_interface_desc const_env = function let translate_interface_desc const_env = function

4
compiler/heptagon/transformations/reset.ml
View file

@ -46,7 +46,7 @@ let mk_bool_var n =
let mk_bool_param n = let mk_bool_param n =
mk_var_dec n (Tid Initial.pbool) mk_var_dec n (Tid Initial.pbool)
let or_op_call = mk_op ( Ecall(mk_op_desc Initial.por [] Eop, None) ) let or_op_call = mk_op ( Ecall(mk_op_desc Initial.por [] Efun, None) )
let pre_true e = { let pre_true e = {
e with e_desc = Eapp(mk_op (Epre (Some (Cconstr Initial.ptrue))), [e]) e with e_desc = Eapp(mk_op (Epre (Some (Cconstr Initial.ptrue))), [e])
@ -230,7 +230,7 @@ and translate res e =
(* create a new reset exp if necessary *) (* create a new reset exp if necessary *)
| Eapp({ a_op = Ecall(op_desc, None) } as op, e_list) -> | Eapp({ a_op = Ecall(op_desc, None) } as op, e_list) ->
let e_list = List.map (translate res) e_list in let e_list = List.map (translate res) e_list in
if true_reset res & op_desc.op_kind <> Eop then if true_reset res & op_desc.op_kind = Enode then
let op = { op with a_op = Ecall(op_desc, Some (exp_of_res res)) } in let op = { op with a_op = Ecall(op_desc, Some (exp_of_res res)) } in
{ e with e_desc = Eapp(op, e_list) } { e with e_desc = Eapp(op, e_list) }
else else

2
compiler/main/hept2mls.ml
View file

@ -189,7 +189,7 @@ let rec const = function
| Heptagon.Carray(n, c) -> Carray(n, const c) | Heptagon.Carray(n, c) -> Carray(n, const c)
let translate_op_kind = function let translate_op_kind = function
| Heptagon.Eop -> Eop | Heptagon.Efun -> Efun
| Heptagon.Enode -> Enode | Heptagon.Enode -> Enode
let translate_op_desc { Heptagon.op_name = n; Heptagon.op_params = p; let translate_op_desc { Heptagon.op_name = n; Heptagon.op_params = p;

2
compiler/minils/analysis/init.ml
View file

@ -214,7 +214,7 @@ let rec typing h e =
| Etuple e_list -> product (List.map (typing h) e_list) | Etuple e_list -> product (List.map (typing h) e_list)
(*TODO traitement singulier et empêche reset d'un 'op'*) (*TODO traitement singulier et empêche reset d'un 'op'*)
| Ecall (op, e_list, None) when op.op_kind = Eop -> | Ecall (op, e_list, None) when op.op_kind = Efun ->
let i = List.fold_left (fun acc e -> itype (typing h e)) izero e_list let i = List.fold_left (fun acc e -> itype (typing h e)) izero e_list
in skeleton i e.e_ty in skeleton i e.e_ty
| Ecall (op, e_list, reset) when op.op_kind = Enode -> | Ecall (op, e_list, reset) when op.op_kind = Enode ->

2
compiler/minils/minils.ml
View file

@ -73,7 +73,7 @@ and array_op =
optional reset condition *) optional reset condition *)
and op_desc = { op_name: longname; op_params: size_exp list; op_kind: op_kind } and op_desc = { op_name: longname; op_params: size_exp list; op_kind: op_kind }
and op_kind = | Eop | Enode and op_kind = | Efun | Enode
and ct = and ct =
| Ck of ck | Ck of ck

3
compiler/minils/mls_utils.ml
View file

@ -53,6 +53,9 @@ let is_record_type ty = match ty with
Not_found -> false) Not_found -> false)
| _ -> false | _ -> false
let is_op = function
| Modname { qual = "Pervasives"; id = _ } -> true | _ -> false
module Vars = module Vars =
struct struct
let add x acc = let add x acc =

4
compiler/minils/parsing/mls_parser.mly
View file

@ -170,9 +170,9 @@ exp:
| PRE exp { mk_exp (Efby(None,$2)) } | PRE exp { mk_exp (Efby(None,$2)) }
| op=node_app a=exps r=reset { mk_exp (Ecall(op, a, r)) } | op=node_app a=exps r=reset { mk_exp (Ecall(op, a, r)) }
| e1=exp i_op=infix e2=exp | e1=exp i_op=infix e2=exp
{ mk_exp (Ecall(mk_op ~op_kind:Eop i_op, [e1; e2], None)) } { mk_exp (Ecall(mk_op ~op_kind:Efun i_op, [e1; e2], None)) }
| p_op=prefix e=exp %prec prefixs | p_op=prefix e=exp %prec prefixs
{ mk_exp (Ecall(mk_op ~op_kind:Eop p_op, [e], None)) } { mk_exp (Ecall(mk_op ~op_kind:Efun p_op, [e], None)) }
| IF e1=exp THEN e2=exp ELSE e3=exp { mk_exp (Eifthenelse(e1, e2, e3)) } | IF e1=exp THEN e2=exp ELSE e3=exp { mk_exp (Eifthenelse(e1, e2, e3)) }
| e=simple_exp DOT m=longname { mk_exp (Efield(e, m)) } | e=simple_exp DOT m=longname { mk_exp (Efield(e, m)) }

25
compiler/minils/sequential/mls2obc.ml
View file

@ -25,9 +25,6 @@ let encode_longname_params n params = match n with
| Modname { qual = qual; id = id } -> | Modname { qual = qual; id = id } ->
Modname { qual = qual; id = encode_name_params id params; } Modname { qual = qual; id = encode_name_params id params; }
let is_op = function
| Modname { qual = "Pervasives"; id = _ } -> true | _ -> false
let op_from_string op = Modname { qual = "Pervasives"; id = op; } let op_from_string op = Modname { qual = "Pervasives"; id = op; }
let rec lhs_of_idx_list e = function let rec lhs_of_idx_list e = function
@ -82,8 +79,8 @@ let rec translate const_env map (m, si, j, s)
| Minils.Econst v -> Const (translate_const const_env v) | Minils.Econst v -> Const (translate_const const_env v)
| Minils.Evar n -> Lhs (var_from_name map n) | Minils.Evar n -> Lhs (var_from_name map n)
| Minils.Econstvar n -> Const (Cint (int_of_size_exp const_env (SVar n))) | Minils.Econstvar n -> Const (Cint (int_of_size_exp const_env (SVar n)))
| Minils.Ecall ({ Minils.op_name = n; Minils.op_kind = Minils.Eop }, | Minils.Ecall ({ Minils.op_name = n; Minils.op_kind = Minils.Efun },
e_list, _) -> e_list, _) when Mls_utils.is_op n ->
Op (n, List.map (translate const_env map (m, si, j, s)) e_list) Op (n, List.map (translate const_env map (m, si, j, s)) e_list)
| Minils.Ewhen (e, _, _) -> translate const_env map (m, si, j, s) e | Minils.Ewhen (e, _, _) -> translate const_env map (m, si, j, s) e
| Minils.Efield (e, field) -> | Minils.Efield (e, field) ->
@ -153,22 +150,26 @@ let rec translate_eq const_env map { Minils.eq_lhs = pat; Minils.eq_rhs = e }
m, si, j, (control map ck action) :: s m, si, j, (control map ck action) :: s
| pat, Minils.Ecall ({ Minils.op_name = n; Minils.op_params = params; | pat, Minils.Ecall ({ Minils.op_name = n; Minils.op_params = params;
Minils.op_kind = Minils.Enode }, Minils.op_kind = (Minils.Enode
| Minils.Efun) as op_kind },
e_list, r) -> e_list, r) ->
let name_list = translate_pat map pat in let name_list = translate_pat map pat in
let c_list = List.map (translate const_env map (m, si, j, s)) e_list in let c_list = List.map (translate const_env map (m, si, j, s)) e_list in
let o = gen_symbol () in let o = gen_symbol () in
let si = (Reinit o) :: si in let si =
(match op_kind with
| Minils.Enode -> (Reinit o) :: si
| Minils.Efun -> si) in
let params = List.map (int_of_size_exp const_env) params in let params = List.map (int_of_size_exp const_env) params in
let j = (o, (encode_longname_params n params), 1) :: j in let j = (o, (encode_longname_params n params), 1) :: j in
let action = Step_ap (name_list, Context o, c_list) in let action = Step_ap (name_list, Context o, c_list) in
let s = (match r with let s = (match r, op_kind with
| None -> (control map ck action) :: s | Some r, Minils.Enode ->
| Some r ->
let ra = let ra =
control map (Minils.Con (ck, Name "true", r)) control map (Minils.Con (ck, Name "true", r))
(Reinit o) in (Reinit o) in
ra :: (control map ck action) :: s ) in ra :: (control map ck action) :: s
| _, _ -> (control map ck action) :: s) in
m, si, j, s m, si, j, s
| Minils.Etuplepat p_list, Minils.Etuple act_list -> | Minils.Etuplepat p_list, Minils.Etuple act_list ->
@ -277,7 +278,7 @@ let rec translate_eq const_env map { Minils.eq_lhs = pat; Minils.eq_rhs = e }
let n = int_of_size_exp const_env n in let n = int_of_size_exp const_env n in
let si = let si =
(match k with (match k with
| Minils.Eop -> si | Minils.Efun -> si
| Minils.Enode -> (Reinit o) :: si) in | Minils.Enode -> (Reinit o) :: si) in
let params = List.map (int_of_size_exp const_env) params in let params = List.map (int_of_size_exp const_env) params in
let j = (o, (encode_longname_params f params), n) :: j in let j = (o, (encode_longname_params f params), n) :: j in

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

@ -54,9 +54,7 @@ let rec collect_exp nodes env e =
collect_exp nodes env e1; collect_exp nodes env e1;
collect_exp nodes env e2 collect_exp nodes env e2
(* Do the real work: call node *) (* Do the real work: call node *)
| Ecall( { op_name = ln; op_params = params; op_kind = Eop }, e_list, _) -> | Ecall( { op_name = ln; op_params = params; op_kind = _ },
List.iter (collect_exp nodes env) e_list
| Ecall( { op_name = ln; op_params = params; op_kind = Enode },
e_list, _) -> e_list, _) ->
List.iter (collect_exp nodes env) e_list; List.iter (collect_exp nodes env) e_list;
let params = List.map (int_of_size_exp env) params in let params = List.map (int_of_size_exp env) params in

3
compiler/minils/transformations/normalize.ml
View file

@ -114,7 +114,8 @@ let add context expected_kind ({ e_desc = de } as e) =
let up = match de, expected_kind with let up = match de, expected_kind with
| (Evar _ | Efield _ ) , VRef -> false | (Evar _ | Efield _ ) , VRef -> false
| _ , VRef -> true | _ , VRef -> true
| Ecall ({ op_kind = Eop }, _, _), (Exp|Act) -> false | Ecall ({ op_kind = Efun; op_name = n }, _, _),
(Exp|Act) when is_op n -> false
| ( Emerge _ | Etuple _ | ( Emerge _ | Etuple _
| Ecall _ | Efby _ | Earray_op _ ), Exp -> true | Ecall _ | Efby _ | Earray_op _ ), Exp -> true
| ( Ecall _ | Efby _ ), Act -> true | ( Ecall _ | Efby _ ), Act -> true